[system] / trunk / pg / macros / PGbasicmacros.pl Repository:
ViewVC logotype

View of /trunk/pg/macros/PGbasicmacros.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1267 - (download) (as text) (annotate)
Tue Jun 24 15:25:58 2003 UTC (16 years, 6 months ago) by gage
File size: 60345 byte(s)
Changes that allow these files to work with caching version
of Webwork2.0 -- optimized for speed
--Mike

    1 
    2 
    3 ####################################################################
    4 # Copyright @ 1995-1998 University of Rochester
    5 # All Rights Reserved
    6 ####################################################################
    7 
    8 =head1 NAME
    9 
   10     PGbasicmacros.pl --- located in the courseScripts directory
   11 
   12 =head1 SYNPOSIS
   13 
   14 
   15 
   16 =head1 DESCRIPTION
   17 
   18 
   19 
   20 =cut
   21 
   22 # this is equivalent to use strict, but can be used within the Safe compartment.
   23 BEGIN{
   24   be_strict;
   25 }
   26 
   27 
   28 my $displayMode;
   29 
   30 my ($PAR,
   31   $BR,
   32   $LQ,
   33   $RQ,
   34   $BM,
   35   $EM,
   36   $BDM,
   37   $EDM,
   38   $LTS,
   39   $GTS,
   40   $LTE,
   41   $GTE,
   42   $BEGIN_ONE_COLUMN,
   43   $END_ONE_COLUMN,
   44   $SOL,
   45   $SOLUTION,
   46   $HINT,
   47   $US,
   48   $SPACE,
   49   $BBOLD,
   50   $EBOLD,
   51   $BITALIC,
   52   $EITALIC,
   53   $BCENTER,
   54   $ECENTER,
   55   $HR,
   56   $LBRACE,
   57   $RBRACE,
   58   $LB,
   59   $RB,
   60   $DOLLAR,
   61   $PERCENT,
   62   $CARET,
   63   $PI,
   64   $E,
   65   @ALPHABET,
   66   $envir,
   67   $PG_random_generator,
   68   $inputs_ref,
   69   );
   70 
   71 sub _PGbasicmacros_init {
   72 
   73     # The big problem is that at compile time in the cached Safe compartment
   74     # main:: has one definition, probably Safe::Root1::
   75     # At runtime main has another definition Safe::Rootx:: where x is > 1
   76 
   77     # It is important to
   78     # initialize the my variable version of $displayMode from the "runtime" version
   79     # of main::displayMode
   80 
   81     $displayMode         =    main::PG_restricted_eval(q!$main::displayMode!);
   82 
   83 # This is initializes the remaining variables in the runtime main:: compartment.
   84 
   85 main::PG_restricted_eval( <<'EndOfFile');
   86     $displayMode            = $displayMode;
   87 
   88   $PAR        = PAR();
   89   $BR       = BR();
   90   $main::LQ       = LQ();
   91   $main::RQ       = RQ();
   92   $BM       = BM();
   93   $EM       = EM();
   94   $main::BDM        = BDM();
   95   $main::EDM        = EDM();
   96   $main::LTS        = LTS();
   97   $main::GTS        = GTS();
   98   $main::LTE        = LTE();
   99   $main::GTE        = GTE();
  100   $main::BEGIN_ONE_COLUMN = BEGIN_ONE_COLUMN();
  101   $main::END_ONE_COLUMN = END_ONE_COLUMN();
  102   $main::SOL        = SOLUTION_HEADING();
  103   $main::SOLUTION     = SOLUTION_HEADING();
  104   $main::HINT       = HINT_HEADING();
  105   $main::US       = US();
  106   $main::SPACE      = SPACE();
  107   $BBOLD      = BBOLD();
  108   $EBOLD      = EBOLD();
  109   $main::BITALIC      = BITALIC();
  110   $main::EITALIC          = EITALIC();
  111   $main::BCENTER          = BCENTER();
  112   $main::ECENTER          = ECENTER();
  113   $main::HR       = HR();
  114   $main::LBRACE     = LBRACE();
  115   $main::RBRACE     = RBRACE();
  116   $main::LB       = LB();
  117   $main::RB       = RB();
  118   $main::DOLLAR     = DOLLAR();
  119   $main::PERCENT      = PERCENT();
  120   $main::CARET      = CARET();
  121   $main::PI       = PI();
  122   $main::E        = E();
  123   @main::ALPHABET     = ('A'..'ZZ');
  124 
  125 
  126 
  127 EndOfFile
  128 
  129 # Next we transfer the correct definitions in the main:: compartment to the local my variables
  130 # This can't be done inside the eval above because my variables seem to be invisible inside the eval
  131 
  132 
  133     $PAR        = $PAR;
  134   $BR           = $BR;
  135   $LQ           = $main::LQ;
  136   $RQ           = $main::RQ;
  137   $BM           = $BM;
  138   $EM           = $EM;
  139   $BDM        = $main::BDM;
  140   $EDM        = $main::EDM;
  141   $LTS        = $main::LTS;
  142   $GTS        = $main::GTS;
  143   $LTE        = $main::LTE;
  144   $GTE        = $main::GTE;
  145   $BEGIN_ONE_COLUMN = $main::BEGIN_ONE_COLUMN;
  146   $END_ONE_COLUMN     = $main::END_ONE_COLUMN;
  147   $SOL        = $main::SOLUTION_HEADING;
  148   $SOLUTION     = $main::SOLUTION_HEADING;
  149   $HINT       = $main::HINT_HEADING;
  150   $US           = $main::US;
  151   $SPACE          = $main::SPACE;
  152   $BBOLD          = $BBOLD;
  153   $EBOLD          = $EBOLD;
  154   $HR           = $main::HR;
  155   $LBRACE         = $main::LBRACE;
  156   $RBRACE         = $main::RBRACE;
  157   $LB           = $main::LB;
  158   $RB           = $main::RB;
  159   $DOLLAR         = $main::DOLLAR;
  160   $PERCENT      = $main::PERCENT;
  161   $CARET          = $main::CARET;
  162   $PI           = $main::PI;
  163   $E            = $main::E;
  164   @ALPHABET     = ('A'..'ZZ');
  165 
  166 #  We initialize a local reference to the environment hash rather than transfer the entire hash
  167 #  This way is slightly more efficient.
  168 
  169    $envir               = PG_restricted_eval(q!\%main::envir!);
  170    $PG_random_generator = PG_restricted_eval(q!$main::PG_random_generator!);
  171    $inputs_ref          = $envir{inputs_ref};
  172 
  173 }
  174 
  175 =head2  Answer blank macros:
  176 
  177 These produce answer blanks of various sizes or pop up lists or radio answer buttons.
  178 The names for the answer blanks are
  179 generated implicitly.
  180 
  181   ans_rule( width )
  182   tex_ans_rule( width )
  183   ans_radio_buttons(value1=>label1, value2,label2 => value3,label3=>...)
  184   pop_up_list(@list)  # list consists of (value => label,  PR => "Product rule",...)
  185 
  186 To indicate the checked position of radio buttons put a '%' in front of the value: C<ans_radio_buttons(1, 'Yes','%2','No')>
  187 will have 'No' checked.  C<tex_ans_rule> works inside math equations in C<HTML_tth> mode.  It does not work in C<Latex2HTML> mode
  188 since this mode produces gif pictures.
  189 
  190 
  191 The following method is defined in F<PG.pl> for entering the answer evaluators corresponding
  192 to answer rules with automatically generated names.  The answer evaluators are matched with the
  193 answer rules in the order in which they appear on the page.
  194 
  195   ANS(ans_evaluator1, ans_evaluator2,...);
  196 
  197 These are more primitive macros which produce answer blanks for specialized cases when complete
  198 control over the matching of answers blanks and answer evaluators is desired.
  199 The names of the answer blanks must be generated manually, and it is best if they do NOT begin
  200 with the default answer prefix (currently AnSwEr).
  201 
  202   labeled_ans_rule(name, width)  # an alias for NAMED_ANS_RULE where width defaults to 20 if omitted.
  203 
  204   NAMED_ANS_RULE(name, width)
  205   NAMED_ANS_BOX(name, rows, cols)
  206   NAMED_ANS_RADIO(name, value,label,)
  207   NAMED_ANS_RADIO_EXTENSION(name, value,label)
  208   NAMED_ANS_RADIO_BUTTONS(name,value1,label1,value2,label2,...)
  209   check_box('-name' =>answer5,'-value' =>'statement3','-label' =>'I loved this course!'   )
  210   NAMED_POP_UP_LIST($name, @list) # list consists of (value => tag,  PR => "Product rule",...)
  211 
  212 (Name is the name of the variable, value is the value given to the variable when this option is selected,
  213 and label is the text printed next to the button or check box.    Check box variables can have multiple values.)
  214 
  215 NAMED_ANS_RADIO_BUTTONS creates a sequence of NAMED_ANS_RADIO and NAMED_ANS_RADIO_EXTENSION  items which
  216 are  output either as an array or, in scalar context, as the array glued together with spaces.  It is
  217 usually easier to use this than to manually construct the radio buttons by hand.  However, sometimes
  218  extra flexibility is desiredin which case:
  219 
  220 When entering radio buttons using the "NAMED" format, you should use NAMED_ANS_RADIO button for the first button
  221 and then use NAMED_ANS_RADIO_EXTENSION for the remaining buttons.  NAMED_ANS_RADIO requires a matching answer evalutor,
  222 while NAMED_ANS_RADIO_EXTENSION does not. The name used for NAMED_ANS_RADIO_EXTENSION should match the name
  223 used for NAMED_ANS_RADIO (and the associated answer evaluator).
  224 
  225 
  226 The following method is defined in  F<PG.pl> for entering the answer evaluators corresponding
  227 to answer rules with automatically generated names.  The answer evaluators are matched with the
  228 answer rules in the order in which they appear on the page.
  229 
  230       NAMED_ANS(name1 => ans_evaluator1, name2 => ans_evaluator2,...);
  231 
  232 These auxiliary macros are defined in PG.pl
  233 
  234 
  235   NEW_ANS_NAME( number );   # produces a new answer blank name from a number by adding a prefix (AnSwEr)
  236                             # and registers this name as an implicitly labeled answer
  237                             # Its use is paired with each answer evaluator being entered using ANS()
  238 
  239     ANS_NUM_TO_NAME(number);  # adds the prefix (AnSwEr) to the number, but does nothing else.
  240 
  241   RECORD_ANS_NAME( name );  # records the order in which the answer blank  is rendered
  242                             # This is called by all of the constructs above, but must
  243                             # be called explicitly if an input blank is constructed explictly
  244                             # using HTML code.
  245 
  246 These are legacy macros:
  247 
  248   ANS_RULE( number, width );                  # equivalent to NAMED_ANS_RULE( NEW_ANS_NAME(number), width)
  249   ANS_BOX( question_number,height, width );       # equivalent to NAMED_ANS_BOX( NEW_ANS_NAME(number), height, width)
  250   ANS_RADIO( question_number, value,tag );        # equivalent to NAMED_ANS_RADIO( NEW_ANS_NAME(number), value,tag)
  251   ANS_RADIO_OPTION( question_number, value,tag );   # equivalent to NAMED_ANS_RADIO_EXTENSION( ANS_NUM_TO_NAME(number), value,tag)
  252 
  253 
  254 =cut
  255 
  256 
  257 
  258 sub labeled_ans_rule {   # syntactic sugar for NAMED_ANS_RULE
  259   my($name,$col) = @_;
  260   $col = 20 unless defined($col);
  261   NAMED_ANS_RULE($name,$col);
  262 }
  263 
  264 sub NAMED_ANS_RULE {
  265   my($name,$col) = @_;
  266   my $len = 0.07*$col;
  267   my $answer_value = '';
  268   $answer_value = ${$inputs_ref}{$name} if    defined(${$inputs_ref}{$name});
  269     if ($answer_value =~ /\0/ ) {
  270       my @answers = split("\0", $answer_value);
  271       $answer_value = shift(@answers);  # use up the first answer
  272       PG_restricted_eval(q!$main::rh_sticky_answers{$name}=\@answers;!);
  273       # store the rest -- beacuse this stores to a main:; variable
  274       # it must be evaluated at run time
  275       $answer_value= '' unless defined($answer_value);
  276   } elsif (ref($answer_value) eq 'ARRAY') {
  277     my @answers = @{ $answer_value};
  278       $answer_value = shift(@answers);  # use up the first answer
  279       PG_restricted_eval(q!$main::rh_sticky_answers{$name}=\@answers;!);
  280       # store the rest -- beacuse this stores to a main:; variable
  281       # it must be evaluated at run time
  282       $answer_value= '' unless defined($answer_value);
  283   }
  284 
  285   $answer_value =~ tr/$@`//d;   ## make sure student answers can not be interpolated by e.g. EV3
  286   $name = RECORD_ANS_NAME($name);
  287   MODES(
  288     TeX => "\\mbox{\\parbox[t]{10pt}{\\hrulefill}}\\hrulefill\\quad ",
  289     Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=TEXT SIZE=$col NAME=\"$name\" VALUE = \"\">\n\\end{rawhtml}\n!,
  290     HTML => "<INPUT TYPE=TEXT SIZE=$col NAME=\"$name\" VALUE = \"$answer_value\">\n"
  291   );
  292 }
  293 
  294 sub NAMED_ANS_RULE_OPTION {   # deprecated
  295   &NAMED_ANS_RULE_EXTENSION;
  296 }
  297 
  298 sub NAMED_ANS_RULE_EXTENSION {
  299   my($name,$col) = @_;
  300   my $len = 0.07*$col;
  301   my $answer_value = '';
  302   $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name});
  303   if ( defined(PG_restricted_eval(q!$main::rh_sticky_answers{$name}!)) ) {
  304     $answer_value = shift( @{PG_restricted_eval(q!$main::rh_sticky_answers{$name}!)});
  305     $answer_value = '' unless defined($answer_value);
  306   }
  307   $answer_value =~ tr/$@//d;   ## make sure student answers can not be interpolated by e.g. EV3
  308   MODES(
  309     TeX => '\\hrulefill\\quad ',
  310     Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=TEXT SIZE=$col NAME=\"$name\" VALUE = \"\">\n\\end{rawhtml}\n!,
  311     HTML => qq!<INPUT TYPE=TEXT SIZE=$col NAME = "$name" VALUE = "$answer_value">\n!
  312   );
  313 }
  314 
  315 sub ANS_RULE {  #deprecated
  316   my($number,$col) = @_;
  317   my $name = NEW_ANS_NAME($number);
  318     NAMED_ANS_RULE($name,$col);
  319 }
  320 
  321 
  322 sub  NAMED_ANS_BOX {
  323   my($name,$row,$col) = @_;
  324   $row = 10 unless defined($row);
  325   $col = 80 unless defined($col);
  326   $name = RECORD_ANS_NAME($name);
  327   my $len = 0.07*$col;
  328   my $height = .07*$row;
  329   my $answer_value = '';
  330   $answer_value = $inputs_ref->{$name} if defined( $inputs_ref->{$name} );
  331   $answer_value =~ tr/$@//d;   ## make sure student answers can not be interpolated by e.g. EV3
  332   my $out = M3(
  333        qq!\\vskip $height in \\hrulefill\\quad !,
  334        qq!\\begin{rawhtml}<TEXTAREA NAME="$name" ROWS="$row" COLS="$col"
  335                WRAP="VIRTUAL">$answer_value</TEXTAREA>\\end{rawhtml}!,
  336          qq!<TEXTAREA NAME="$name" ROWS="$row" COLS="$col"
  337                WRAP="VIRTUAL">$answer_value</TEXTAREA>!
  338          );
  339   $out;
  340 }
  341 
  342 sub  ANS_BOX { #deprecated
  343   my($number,$row,$col) = @_;
  344   my $name = NEW_ANS_NAME($number);
  345     NAMED_ANS_BOX($name,$row,$col);
  346 }
  347 
  348 sub NAMED_ANS_RADIO {
  349   my $name = shift;
  350   my $value = shift;
  351     my $tag =shift;
  352     $name = RECORD_ANS_NAME($name);
  353     my $checked = '';
  354     if ($value =~/^\%/) {
  355       $value =~ s/^\%//;
  356       $checked = 'CHECKED'
  357     }
  358   if (defined($inputs_ref->{$name}) ) {
  359     if ($inputs_ref->{$name} eq $value) {
  360       $checked = 'CHECKED'
  361     } else {
  362       $checked = '';
  363     }
  364 
  365     }
  366 
  367   MODES(
  368     TeX => qq!\\item{$tag}\n!,
  369     Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=RADIO NAME="$name" VALUE="$value" $checked>\\end{rawhtml}$tag!,
  370     HTML => qq!<INPUT TYPE=RADIO NAME="$name" VALUE="$value" $checked>$tag!
  371   );
  372 
  373 }
  374 
  375 sub NAMED_ANS_RADIO_OPTION { #deprecated
  376   &NAMED_ANS_RADIO_EXTENSION;
  377 }
  378 
  379 sub NAMED_ANS_RADIO_EXTENSION {
  380   my $name = shift;
  381   my $value = shift;
  382   my $tag =shift;
  383 
  384 
  385     my $checked = '';
  386     if ($value =~/^\%/) {
  387       $value =~ s/^\%//;
  388       $checked = 'CHECKED'
  389     }
  390   if (defined($inputs_ref->{$name}) ) {
  391     if ($inputs_ref->{$name} eq $value) {
  392       $checked = 'CHECKED'
  393     } else {
  394       $checked = '';
  395     }
  396 
  397     }
  398 
  399   MODES(
  400     TeX => qq!\\item{$tag}\n!,
  401     Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=RADIO NAME="$name" VALUE="$value" $checked>\\end{rawhtml}$tag!,
  402     HTML => qq!<INPUT TYPE=RADIO NAME="$name" VALUE="$value" $checked>$tag!
  403   );
  404 
  405 }
  406 
  407 sub NAMED_ANS_RADIO_BUTTONS {
  408     my $name  =shift;
  409     my $value = shift;
  410     my $tag = shift;
  411 
  412 
  413   my @out = ();
  414   push(@out, NAMED_ANS_RADIO($name, $value,$tag));
  415   my @buttons = @_;
  416   while (@buttons) {
  417     $value = shift @buttons;  $tag = shift @buttons;
  418     push(@out, NAMED_ANS_RADIO_OPTION($name, $value,$tag));
  419   }
  420   (wantarray) ? @out : join(" ",@out);
  421 }
  422 sub ANS_RADIO {
  423   my $number = shift;
  424   my $value = shift;
  425   my $tag =shift;
  426     my $name = NEW_ANS_NAME($number);
  427   NAMED_ANS_RADIO($name,$value,$tag);
  428 }
  429 
  430 sub ANS_RADIO_OPTION {
  431   my $number = shift;
  432   my $value = shift;
  433   my $tag =shift;
  434 
  435 
  436     my $name = ANS_NUM_TO_NAME($number);
  437   NAMED_ANS_RADIO_OPTION($name,$value,$tag);
  438 }
  439 sub ANS_RADIO_BUTTONS {
  440     my $number  =shift;
  441     my $value = shift;
  442     my $tag = shift;
  443 
  444 
  445   my @out = ();
  446   push(@out, ANS_RADIO($number, $value,$tag));
  447   my @buttons = @_;
  448   while (@buttons) {
  449       $value = shift @buttons; $tag = shift @buttons;
  450     push(@out, ANS_RADIO_OPTION($number, $value,$tag));
  451   }
  452   (wantarray) ? @out : join(" ",@out);
  453 }
  454 
  455 sub NAMED_ANS_CHECKBOX {
  456   my $name = shift;
  457   my $value = shift;
  458     my $tag =shift;
  459     $name = RECORD_ANS_NAME($name);
  460 
  461     my $checked = '';
  462     if ($value =~/^\%/) {
  463       $value =~ s/^\%//;
  464       $checked = 'CHECKED'
  465     }
  466 
  467   if (defined($inputs_ref->{$name}) ) {
  468     if ($inputs_ref->{$name} eq $value) {
  469       $checked = 'CHECKED'
  470     }
  471     else {
  472       $checked = '';
  473     }
  474 
  475     }
  476 
  477   MODES(
  478     TeX => qq!\\item{$tag}\n!,
  479     Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=CHECKBOX NAME="$name" VALUE="$value" $checked>\\end{rawhtml}$tag!,
  480     HTML => qq!<INPUT TYPE=CHECKBOX NAME="$name" VALUE="$value" $checked>$tag!
  481   );
  482 
  483 }
  484 
  485 sub NAMED_ANS_CHECKBOX_OPTION {
  486   my $name = shift;
  487   my $value = shift;
  488   my $tag =shift;
  489 
  490     my $checked = '';
  491     if ($value =~/^\%/) {
  492       $value =~ s/^\%//;
  493       $checked = 'CHECKED'
  494     }
  495 
  496   if (defined($inputs_ref->{$name}) ) {
  497     if ($inputs_ref->{$name} eq $value) {
  498       $checked = 'CHECKED'
  499     }
  500     else {
  501       $checked = '';
  502     }
  503 
  504     }
  505 
  506   MODES(
  507     TeX => qq!\\item{$tag}\n!,
  508     Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=CHECKBOX NAME="$name" VALUE="$value" $checked>\\end{rawhtml}$tag!,
  509     HTML => qq!<INPUT TYPE=CHECKBOX NAME="$name" VALUE="$value" $checked>$tag!
  510   );
  511 
  512 }
  513 
  514 sub NAMED_ANS_CHECKBOX_BUTTONS {
  515     my $name  =shift;
  516     my $value = shift;
  517     my $tag = shift;
  518 
  519   my @out = ();
  520   push(@out, NAMED_ANS_CHECKBOX($name, $value,$tag));
  521 
  522   my @buttons = @_;
  523   while (@buttons) {
  524     $value = shift @buttons;  $tag = shift @buttons;
  525     push(@out, NAMED_ANS_CHECKBOX_OPTION($name, $value,$tag));
  526   }
  527 
  528   (wantarray) ? @out : join(" ",@out);
  529 }
  530 
  531 sub ANS_CHECKBOX {
  532   my $number = shift;
  533   my $value = shift;
  534   my $tag =shift;
  535     my $name = NEW_ANS_NAME($number);
  536 
  537   NAMED_ANS_CHECKBOX($name,$value,$tag);
  538 }
  539 
  540 sub ANS_CHECKBOX_OPTION {
  541   my $number = shift;
  542   my $value = shift;
  543   my $tag =shift;
  544     my $name = ANS_NUM_TO_NAME($number);
  545 
  546   NAMED_ANS_CHECKBOX_OPTION($name,$value,$tag);
  547 }
  548 
  549 sub ANS_CHECKBOX_BUTTONS {
  550     my $number  =shift;
  551     my $value = shift;
  552     my $tag = shift;
  553 
  554   my @out = ();
  555   push(@out, ANS_CHECKBOX($number, $value, $tag));
  556 
  557   my @buttons = @_;
  558   while (@buttons) {
  559     $value = shift @buttons;  $tag = shift @buttons;
  560     push(@out, ANS_CHECKBOX_OPTION($number, $value,$tag));
  561   }
  562 
  563   (wantarray) ? @out : join(" ",@out);
  564 }
  565 
  566 sub ans_rule {
  567   my $len = shift;     # gives the optional length of the answer blank
  568   $len    = 20 unless $len ;
  569   my $name = NEW_ANS_NAME(inc_ans_rule_count());
  570   NAMED_ANS_RULE($name ,$len);
  571 }
  572 sub ans_rule_extension {
  573   my $len = shift;
  574     $len    = 20 unless $len ;
  575   my $name = NEW_ANS_NAME(PG_restricted_eval(q!$main::ans_rule_count!));  # don't update the answer name
  576   NAMED_ANS_RULE($name ,$len);
  577 }
  578 sub ans_radio_buttons {
  579   my $name  = NEW_ANS_NAME(inc_ans_rule_count());
  580   my @radio_buttons = NAMED_ANS_RADIO_BUTTONS($name, @_);
  581 
  582   if ($displayMode eq 'TeX') {
  583     $radio_buttons[0] = "\n\\begin{itemize}\n" . $radio_buttons[0];
  584     $radio_buttons[$#radio_buttons] .= "\n\\end{itemize}\n";
  585   }
  586 
  587   (wantarray) ? @radio_buttons: join(" ", @radio_buttons);
  588 }
  589 
  590 #added 6/14/2000 by David Etlinger
  591 sub ans_checkbox {
  592   my $name = NEW_ANS_NAME( inc_ans_rule_count() );
  593   my @checkboxes = NAMED_ANS_CHECKBOX_BUTTONS( $name, @_ );
  594 
  595   if ($displayMode eq 'TeX') {
  596     $checkboxes[0] = "\n\\begin{itemize}\n" . $checkboxes[0];
  597     $checkboxes[$#checkboxes] .= "\n\\end{itemize}\n";
  598   }
  599 
  600   (wantarray) ? @checkboxes: join(" ", @checkboxes);
  601 }
  602 
  603 
  604 ## define a version of ans_rule which will work inside TeX math mode or display math mode -- at least for tth mode.
  605 ## This is great for displayed fractions.
  606 ## This will not work with latex2HTML mode since it creates gif equations.
  607 
  608 sub tex_ans_rule {
  609   my $len = shift;
  610   $len    = 20 unless $len ;
  611     my $name = NEW_ANS_NAME(inc_ans_rule_count());
  612     my $answer_rule = NAMED_ANS_RULE($name ,$len);  # we don't want to create three answer rules in different modes.
  613     my $out = MODES(
  614                      'TeX' => $answer_rule,
  615                      'Latex2HTML' => '\\fbox{Answer boxes cannot be placed inside typeset equations}',
  616                      'HTML_tth' => '\\begin{rawhtml} '. $answer_rule.'\\end{rawhtml}',
  617                      'HTML_dpng' => '\\fbox{Answer boxes cannot be placed inside typeset equations}',
  618                      'HTML'     => $answer_rule
  619                    );
  620 
  621     $out;
  622 }
  623 sub tex_ans_rule_extension {
  624   my $len = shift;
  625   $len    = 20 unless $len ;
  626     my $name = NEW_ANS_NAME(PG_restricted_eval(q!$main::ans_rule_count!));
  627     my $answer_rule = NAMED_ANS_RULE($name ,$len);  # we don't want to create three answer rules in different modes.
  628     my $out = MODES(
  629                      'TeX' => $answer_rule,
  630                      'Latex2HTML' => '\fbox{Answer boxes cannot be placed inside typeset equations}',
  631                      'HTML_tth' => '\\begin{rawhtml} '. $answer_rule.'\\end{rawhtml}',
  632                      'HTML_dpng' => '\fbox{Answer boxes cannot be placed inside typeset equations}',
  633                      'HTML'     => $answer_rule
  634                    );
  635 
  636     $out;
  637 }
  638 # still needs some cleanup.
  639 sub NAMED_TEX_ANS_RULE {
  640     my $name = shift;
  641   my $len = shift;
  642   $len    = 20 unless $len ;
  643     my $answer_rule = NAMED_ANS_RULE($name ,$len);  # we don't want to create three answer rules in different modes.
  644     my $out = MODES(
  645                      'TeX' => $answer_rule,
  646                      'Latex2HTML' => '\\fbox{Answer boxes cannot be placed inside typeset equations}',
  647                      'HTML_tth' => '\\begin{rawhtml} '. $answer_rule.'\\end{rawhtml}',
  648                      'HTML_dpng' => '\\fbox{Answer boxes cannot be placed inside typeset equations}',
  649                      'HTML'     => $answer_rule
  650                    );
  651 
  652     $out;
  653 }
  654 sub NAMED_TEX_ANS_RULE_EXTENSION {
  655   my $name = shift;
  656   my $len = shift;
  657   $len    = 20 unless $len ;
  658     my $answer_rule = NAMED_ANS_RULE_EXTENSION($name ,$len);  # we don't want to create three answer rules in different modes.
  659     my $out = MODES(
  660                      'TeX' => $answer_rule,
  661                      'Latex2HTML' => '\fbox{Answer boxes cannot be placed inside typeset equations}',
  662                      'HTML_tth' => '\\begin{rawhtml} '. $answer_rule.'\\end{rawhtml}',
  663                      'HTML_dpng' => '\fbox{Answer boxes cannot be placed inside typeset equations}',
  664                      'HTML'     => $answer_rule
  665                    );
  666 
  667     $out;
  668 }
  669 sub ans_box {
  670   my $row = shift;
  671   my $col =shift;
  672   $row = 5 unless $row;
  673   $col = 80 unless $col;
  674   my $name = NEW_ANS_NAME(inc_ans_rule_count());
  675   NAMED_ANS_BOX($name ,$row,$col);
  676 }
  677 
  678 #this is legacy code; use ans_checkbox instead
  679 sub checkbox {
  680   my %options = @_;
  681   qq!<INPUT TYPE="checkbox" NAME="$options{'-name'}" VALUE="$options{'-value'}">$options{'-label'}!
  682 }
  683 
  684 
  685 sub NAMED_POP_UP_LIST {
  686     my $name = shift;
  687   my @list = @_;
  688   $name = RECORD_ANS_NAME($name);   # record answer name
  689     my $answer_value = '';
  690   $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name});
  691   my $out = "";
  692   if ($displayMode eq 'HTML' or $displayMode eq 'HTML_tth' or
  693             $displayMode eq 'HTML_dpng' or $displayMode eq 'HTML_img') {
  694     $out = qq!<SELECT NAME = "$name" SIZE=1> \n!;
  695     my $i;
  696     foreach ($i=0; $i< @list; $i=$i+2) {
  697       my $select_flag = ($list[$i] eq $answer_value) ? "SELECTED" : "";
  698       $out .= qq!<OPTION $select_flag VALUE ="$list[$i]" > $list[$i+1]  </OPTION>\n!;
  699     };
  700     $out .= " </SELECT>\n";
  701   } elsif ( $displayMode eq "Latex2HTML") {
  702     $out = qq! \\begin{rawhtml}<SELECT NAME = "$name" SIZE=1> \\end{rawhtml} \n !;
  703     my $i;
  704     foreach ($i=0; $i< @list; $i=$i+2) {
  705       my $select_flag = ($list[$i] eq $answer_value) ? "SELECTED" : "";
  706       $out .= qq!\\begin{rawhtml}<OPTION $select_flag VALUE ="$list[$i]" > $list[$i+1]  </OPTION>\\end{rawhtml}\n!;
  707     };
  708     $out .= " \\begin{rawhtml}</SELECT>\\end{rawhtml}\n";
  709   } elsif ( $displayMode eq "TeX") {
  710       $out .= "\\fbox{?}";
  711   }
  712 
  713 }
  714 
  715 sub pop_up_list {
  716   my @list = @_;
  717   my $name = NEW_ANS_NAME(inc_ans_rule_count());  # get new answer name
  718   NAMED_POP_UP_LIST($name, @list);
  719 }
  720 
  721 
  722 
  723 =head5  answer_matrix
  724 
  725     Usage   \[ \{   answer_matrix(rows,columns,width_of_ans_rule, @options) \} \]
  726 
  727     Creates an array of answer blanks and passes it to display_matrix which returns
  728     text which represents the matrix in TeX format used in math display mode. Answers
  729     are then passed back to whatever answer evaluators you write at the end of the problem.
  730     (note, if you have an m x n matrix, you will need mn answer evaluators, and they will be
  731     returned to the evaluaters starting in the top left hand corner and proceed to the left
  732     and then at the end moving down one row, just as you would read them.)
  733 
  734     The options are passed on to display_matrix.
  735 
  736 
  737 =cut
  738 
  739 
  740 sub answer_matrix{
  741   my $m = shift;
  742   my $n = shift;
  743   my $width = shift;
  744   my @options = @_;
  745   my @array=();
  746   for( my $i = 0; $i < $m; $i+=1)
  747   {
  748     my @row_array = ();
  749 
  750     for( my $i = 0; $i < $n; $i+=1)
  751     {
  752       push @row_array,  ans_rule($width);
  753     }
  754     my $r_row_array = \@row_array;
  755     push @array,  $r_row_array;
  756   }
  757   # display_matrix hasn't been loaded into the cache safe compartment
  758   # so we need to refer to the subroutine in this way to make
  759   # sure that main is defined correctly.
  760   my $ra_local_display_matrix=PG_restricted_eval(q!\&main::display_matrix!);
  761   &$ra_local_display_matrix( \@array, @options );
  762 
  763 }
  764 
  765 sub NAMED_ANS_ARRAY_EXTENSION{
  766 
  767   my $name = shift;
  768   my $col = shift;
  769   $col = 20 unless $col;
  770   my $answer_value = '';
  771 
  772   $answer_value = ${$inputs_ref}{$name} if    defined(${$inputs_ref}{$name});
  773   if ($answer_value =~ /\0/ ) {
  774     my @answers = split("\0", $answer_value);
  775     $answer_value = shift(@answers);
  776     $answer_value= '' unless defined($answer_value);
  777   } elsif (ref($answer_value) eq 'ARRAY') {
  778     my @answers = @{ $answer_value};
  779       $answer_value = shift(@answers);
  780         $answer_value= '' unless defined($answer_value);
  781   }
  782 
  783   $answer_value =~ tr/$@`//d;   ## make sure student answers can not be interpolated by e.g. EV3
  784   MODES(
  785     TeX => "\\mbox{\\parbox[t]{10pt}{\\hrulefill}}\\hrulefill\\quad ",
  786     Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=TEXT SIZE=$col NAME=\"$name\" VALUE = \"\">\n\\end{rawhtml}\n!,
  787     HTML => "<INPUT TYPE=TEXT SIZE=$col NAME=\"$name\" VALUE = \"$answer_value\">\n"
  788   );
  789 }
  790 
  791 sub ans_array{
  792   my $m = shift;
  793   my $n = shift;
  794   my $col = shift;
  795   $col = 20 unless $col;
  796   my $num = inc_ans_rule_count() ;
  797   my $name = NEW_ANS_ARRAY_NAME($num,0,0);
  798   my @options = @_;
  799   my @array=();
  800   my $string;
  801   my $answer_value = "";
  802 
  803   $array[0][0] =   NAMED_ANS_RULE($name,$col);
  804 
  805   for( my $i = 1; $i < $n; $i+=1)
  806   {
  807     $name = NEW_ANS_ARRAY_NAME_EXTENSION($num,0,$i);
  808     $array[0][$i] =   NAMED_ANS_ARRAY_EXTENSION($name,$col);
  809 
  810   }
  811 
  812   for( my $j = 1; $j < $m; $j+=1 ){
  813 
  814     for( my $i = 0; $i < $n; $i+=1)
  815     {
  816       $name = NEW_ANS_ARRAY_NAME_EXTENSION($num,$j,$i);
  817       $array[$j][$i] =  NAMED_ANS_ARRAY_EXTENSION($name,$col);
  818 
  819     }
  820 
  821   }
  822   my $ra_local_display_matrix=PG_restricted_eval(q!\&main::display_matrix!);
  823   &$ra_local_display_matrix( \@array, @options );
  824 
  825 }
  826 
  827 sub ans_array_extension{
  828   my $m = shift;
  829   my $n = shift;
  830   my $col = shift;
  831   $col = 20 unless $col;
  832   my $num = PG_restricted_eval(q!$main::ans_rule_count!);
  833   my @options = @_;
  834   my $name;
  835   my @array=();
  836   my $string;
  837   my $answer_value = "";
  838 
  839   for( my $j = 0; $j < $m; $j+=1 ){
  840 
  841     for( my $i = 0; $i < $n; $i+=1)
  842     {
  843       $name = NEW_ANS_ARRAY_NAME_EXTENSION($num,$j,$i);
  844       $array[$j][$i] =  NAMED_ANS_ARRAY_EXTENSION($name,$col);
  845 
  846     }
  847 
  848   }
  849   my $ra_local_display_matrix=PG_restricted_eval(q!\&main::display_matrix!);
  850   &$ra_local_display_matrix( \@array, @options );
  851 
  852 }
  853 
  854 
  855 # end answer blank macros
  856 
  857 =head2 Hints and solutions macros
  858 
  859   solution('text','text2',...);
  860   SOLUTION('text','text2',...);   # equivalent to TEXT(solution(...));
  861 
  862   hint('text', 'text2', ...);
  863   HINT('text', 'text2',...);      # equivalent to TEXT("$BR$HINT" . hint(@_) . "$BR") if hint(@_);
  864 
  865 Solution prints its concatenated input when the check box named 'ShowSol' is set and
  866 the time is after the answer date.  The check box 'ShowSol' is visible only after the
  867 answer date or when the problem is viewed by a professor.
  868 
  869 $main::envir{'displaySolutionsQ'} is set to 1 when a solution is to be displayed.
  870 
  871 Hints are shown only after the number of attempts is greater than $:showHint
  872 ($main::showHint defaults to 1) and the check box named 'ShowHint' is set. The check box
  873 'ShowHint' is visible only after the number of attempts is greater than $main::showHint.
  874 
  875 $main::envir{'displayHintsQ'} is set to 1 when a hint is to be displayed.
  876 
  877 
  878 =cut
  879 
  880 
  881 
  882 #   solution prints its input when $displaySolutionsQ is set.
  883 #   use as TEXT(solution("blah, blah");
  884 #   \$solutionExists
  885 #   is passed to processProblem which displays a "show Solution" button
  886 #   when a solution is available for viewing
  887 
  888 
  889 sub solution {
  890   my @in = @_;
  891   my $out = '';
  892   PG_restricted_eval(q!$main::solutionExists =1!);
  893   if (PG_restricted_eval(q!$main::envir{'displaySolutionsQ'}!)) {$out = join(' ',@in);}
  894     $out;
  895 }
  896 
  897 
  898 sub SOLUTION {
  899   TEXT( solution(@_)) ;
  900 }
  901 
  902 
  903 
  904 sub hint {
  905     my @in = @_;
  906   my $out = '';
  907 
  908   PG_restricted_eval(q!$main::hintExists =1;
  909                          $main::numOfAttempts = 0 unless defined($main::numOfAttempts);
  910     !);
  911 
  912   if ($displayMode eq 'TeX')   {
  913     $out = '';  # do nothing since hints are not available for download
  914   } elsif (($envir->{'displayHintsQ'}) and
  915           PG_restricted_eval(q!($main::numOfAttempts >= $main::showHint)!))
  916 
  917    ## the second test above prevents a hint being shown if a doctored form is submitted
  918 
  919   {$out = join(' ',@in);}    # show hint
  920 
  921   $out ;
  922 }
  923 
  924 
  925 sub HINT {
  926     TEXT("$BR" . hint(@_) . "$BR") if hint(@_);
  927 }
  928 
  929 
  930 
  931 # End hints and solutions macros
  932 #################################
  933 
  934 # Produces a random number between $begin and $end with increment 1.
  935 # You do not have to worry about integer or floating point types.
  936 
  937 =head2 Pseudo-random number generator
  938 
  939   Usage:
  940   random(0,5,.1)      # produces a random number between 0 and 5 in increments of .1
  941   non_zero_random(0,5,.1) # gives a non-zero random number
  942 
  943   list_random(2,3,5,6,7,8,10) # produces random value from the list
  944   list_random(2,3, (5..8),10) # does the same thing
  945 
  946   SRAND(seed)     # resets the main random generator -- use very cautiously
  947 
  948 
  949 SRAND(time) will create a different problem everytime it is called.  This makes it difficult
  950 to check the answers :-).
  951 
  952 SRAND($envir->{'inputs_ref'}->{'key'} ) will create a different problem for each login session.
  953 This is probably what is desired.
  954 
  955 =cut
  956 
  957 
  958 sub random  {
  959   my ($begin, $end, $incr) = @_;
  960   $PG_random_generator->random($begin,$end,$incr);
  961 }
  962 
  963 
  964 sub non_zero_random { ##gives a non-zero random number
  965   my (@arguments)=@_;
  966   my $a=0;
  967   my $i=100; #safety counter
  968   while ($a==0 && ( 0 < $i-- ) ) {
  969     $a=random(@arguments);
  970   }
  971   $a;
  972 }
  973 
  974 sub list_random {
  975         my(@li) = @_;
  976         return $li[random(1,scalar(@li))-1];
  977 }
  978 
  979 sub SRAND { # resets the main random generator -- use cautiously
  980     my $seed = shift;
  981   PG_random_generator -> srand($seed);
  982 }
  983 
  984 # display macros
  985 
  986 =head2 Display Macros
  987 
  988 These macros produce different output depending on the display mode being used to show
  989 the problem on the screen, or whether the problem is being converted to TeX to produce
  990 a hard copy output.
  991 
  992   MODES   ( TeX =>        "Output this in TeX mode",
  993             HTML =>       "output this in HTML mode",
  994             HTML_tth =>   "output this in HTML_tth mode",
  995             HTML_dpng =>   "output this in HTML_dpng mode",
  996             Latex2HTML => "output this in Latex2HTML mode",
  997            )
  998 
  999   TEX     (tex_version, html_version) #obsolete
 1000 
 1001   M3      (tex_version, latex2html_version, html_version) #obsolete
 1002 
 1003 
 1004 
 1005 =cut
 1006 
 1007 
 1008 sub TEX {
 1009   my ($tex, $html ) = @_;
 1010   MODES(TeX => $tex, HTML => $html, HTML_tth => $html, HTML_dpng => $html);
 1011 }
 1012 
 1013 
 1014 sub M3 {
 1015   my($tex,$l2h,$html) = @_;
 1016   MODES(TeX => $tex, Latex2HTML => $l2h, HTML => $html, HTML_tth => $html, HTML_dpng => $html);
 1017 }
 1018 
 1019 # This replaces M3.  You can add new modes at will to this one.
 1020 
 1021 sub MODES {
 1022   my %options = @_;
 1023   return $options{$displayMode}
 1024              if defined( $options{$displayMode} );
 1025 
 1026   # default searches.
 1027   if ($displayMode eq "Latex2HTML") {
 1028     return $options{TeX}
 1029              if defined( $options{TeX} );
 1030       return $options{HTML}
 1031              if defined( $options{HTML} );
 1032       die " ERROR in using MODES: 'HTML' and 'TeX' options not defined for 'Latex2HTML'";
 1033   }
 1034 
 1035   if ($displayMode eq "HTML_tth") {
 1036     return $options{HTML}
 1037              if defined( $options{HTML} );
 1038       die " ERROR in using MODES: 'HTML' option not defined for HTML_tth";
 1039 
 1040   }
 1041 
 1042   if ($displayMode eq "HTML_img") {
 1043     return $options{HTML_dpng} if defined $options{HTML_dpng};
 1044     return $options{HTML_tth} if defined $options{HTML_tth};
 1045     return $options{HTML}     if defined $options{HTML};
 1046     die " ERROR in using MODES: 'HTML' option not defined for HTML_img";
 1047   }
 1048 
 1049   if ($displayMode eq "HTML_dpng") {
 1050     return $options{HTML_tth}
 1051              if defined( $options{HTML_tth} );
 1052     return $options{HTML}
 1053              if defined( $options{HTML} );
 1054       die " ERROR in using MODES: 'HTML' option not defined for HTML_dpng";
 1055 
 1056   }
 1057 
 1058   # trap undefined errors
 1059   die "ERROR in defining MODES:  Can't find |$displayMode| among
 1060            available options:" . join(" ", keys(%options) )
 1061            . " file " . __FILE__ ." line " . __LINE__."\n\n";
 1062 
 1063 }
 1064 
 1065 
 1066 # end display macros
 1067 
 1068 
 1069 =head2  Display constants
 1070 
 1071   @ALPHABET       ALPHABET()      capital letter alphabet -- ALPHABET[0] = 'A'
 1072   $PAR        PAR()       paragraph character (\par or <p>)
 1073   $BR             BR()        line break character
 1074   $LQ         LQ()        left double quote
 1075   $RQ         RQ()        right double quote
 1076   $BM         BM()        begin math
 1077   $EM         EM()        end math
 1078   $BDM        BDM()       begin display math
 1079   $EDM        EDM()       end display math
 1080   $LTS        LTS()       strictly less than
 1081   $GTS        GTS()       strictly greater than
 1082   $LTE        LTE()       less than or equal
 1083   $GTE        GTE()       greater than or equal
 1084   $BEGIN_ONE_COLUMN BEGIN_ONE_COLUMN()  begin one-column mode
 1085   $END_ONE_COLUMN   END_ONE_COLUMN()  end one-column mode
 1086   $SOL        SOLUTION_HEADING()  solution headline
 1087   $SOLUTION     SOLUTION_HEADING()  solution headline
 1088   $HINT       HINT_HEADING()    hint headline
 1089   $US         US()        underscore character
 1090   $SPACE        SPACE()       space character (tex and latex only)
 1091   $BBOLD        BBOLD()       begin bold typeface
 1092   $EBOLD        EBOLD()       end bold typeface
 1093   $BITALIC        BITALIC()       begin italic typeface
 1094   $EITALIC        EITALIC()       end italic typeface
 1095   $BCENTER        BCENTER()       begin centered environment
 1096   $ECENTER        ECENTER()       end centered environment
 1097   $HR         HR()        horizontal rule
 1098   $LBRACE       LBRACE()      left brace
 1099   $LB         LB ()       left brace
 1100   $RBRACE       RBRACE()      right brace
 1101   $RB         RB ()       right brace
 1102   $DOLLAR       DOLLAR()      a dollar sign
 1103   $PERCENT      PERCENT()     a percent sign
 1104   $CARET        CARET()       a caret sign
 1105   $PI         PI()        the number pi
 1106   $E          E()         the number e
 1107 
 1108 =cut
 1109 
 1110 
 1111 
 1112 
 1113 
 1114 # A utility variable.  Notice that "B"=$ALPHABET[1] and
 1115 # "ABCD"=@ALPHABET[0..3].
 1116 
 1117 sub ALPHABET  {
 1118   ('A'..'ZZ')[@_];
 1119 }
 1120 
 1121 ###############################################################
 1122 # Some constants which are different in tex and in HTML
 1123 # The order of arguments is TeX, Latex2HTML, HTML
 1124 sub PAR { MODES( TeX => '\\par ',Latex2HTML => '\\par ',HTML => '<P>' ); };
 1125 sub BR { MODES( TeX => '\\par\\noindent ',Latex2HTML => '\\par\\noindent ',HTML => '<BR>'); };
 1126 sub LQ { MODES( TeX => "``", Latex2HTML =>   '"',  HTML =>  '&quot;' ); };
 1127 sub RQ { MODES( TeX => "''", Latex2HTML =>   '"',   HTML =>  '&quot;' ); };
 1128 sub BM { MODES(TeX => '\\(', Latex2HTML => '\\(', HTML =>  ''); };  # begin math mode
 1129 sub EM { MODES(TeX => '\\)', Latex2HTML => '\\)', HTML => ''); };  # end math mode
 1130 sub BDM { MODES(TeX => '\\[', Latex2HTML =>   '\\[', HTML =>   '<P ALIGN=CENTER>'); };  #begin displayMath mode
 1131 sub EDM { MODES(TeX => '\\]',  Latex2HTML =>  '\\]', HTML => '</P>'); };              #end displayMath mode
 1132 sub LTS { MODES(TeX => ' < ', Latex2HTML => ' \\lt ',  HTML =>   '&lt;'); };
 1133 sub GTS {MODES(TeX => ' > ', Latex2HTML => ' \\gt ',  HTML =>    '&gt;'); };
 1134 sub LTE { MODES(TeX => ' \\le ', Latex2HTML =>  ' \\le ',  HTML => '&lt;=' ); };
 1135 sub GTE { MODES(TeX => ' \\ge ',  Latex2HTML => ' \\ge ',  HTML =>  '&gt;'); };
 1136 sub BEGIN_ONE_COLUMN { MODES(TeX => " \\end{multicols}\n",  Latex2HTML => " ", HTML =>   " "); };
 1137 sub END_ONE_COLUMN { MODES(TeX =>
 1138               " \\begin{multicols}{2}\n\\columnwidth=\\linewidth\n",
 1139                             Latex2HTML => ' ', HTML => ' ');
 1140 
 1141 };
 1142 sub SOLUTION_HEADING { MODES( TeX => '\\par {\\bf Solution:}',
 1143                  Latex2HTML => '\\par {\\bf Solution:}',
 1144                HTML =>  '<P><B>Solution:</B>');
 1145               };
 1146 sub HINT_HEADING { MODES( TeX => "\\par {\\bf Hint:}", Latex2HTML => "\\par {\\bf Hint:}", HTML => "<P><B>Hint:</B>"); };
 1147 sub US { MODES(TeX => '\\_', Latex2HTML => '\\_', HTML => '_');};  # underscore, e.g. file${US}name
 1148 sub SPACE { MODES(TeX => '\\ ',  Latex2HTML => '\\ ', HTML => '&nbsp;');};  # force a space in latex, doesn't force extra space in html
 1149 sub BBOLD { MODES(TeX => '{\\bf ',  Latex2HTML => '{\\bf ', HTML => '<B>'); };
 1150 sub EBOLD { MODES( TeX => '}', Latex2HTML =>  '}',HTML =>  '</B>'); };
 1151 sub BITALIC { MODES(TeX => '{\\it ',  Latex2HTML => '{\\it ', HTML => '<I>'); };
 1152 sub EITALIC { MODES(TeX => '} ',  Latex2HTML => '} ', HTML => '</I>'); };
 1153 sub BCENTER { MODES(TeX => '\\begin{center} ',  Latex2HTML => ' \\begin{rawhtml} <div align="center"> \\end{rawhtml} ', HTML => '<div align="center">'); };
 1154 sub ECENTER { MODES(TeX => '\\end{center} ',  Latex2HTML => ' \\begin{rawhtml} </div> \\end{rawhtml} ', HTML => '</div>'); };
 1155 sub HR { MODES(TeX => '\\par\\hrulefill\\par ', Latex2HTML => '\\begin{rawhtml} <HR> \\end{rawhtml}', HTML =>  '<HR>'); };
 1156 sub LBRACE { MODES( TeX => '\{', Latex2HTML =>   '\\lbrace',  HTML =>  '\{' , HTML_tth=> '\\lbrace' ); };
 1157 sub RBRACE { MODES( TeX => '\}', Latex2HTML =>   '\\rbrace',  HTML =>  '\}' , HTML_tth=> '\\rbrace',); };
 1158 sub LB { MODES( TeX => '\{', Latex2HTML =>   '\\lbrace',  HTML =>  '\{' , HTML_tth=> '\\lbrace' ); };
 1159 sub RB { MODES( TeX => '\}', Latex2HTML =>   '\\rbrace',  HTML =>  '\}' , HTML_tth=> '\\rbrace',); };
 1160 sub DOLLAR { MODES( TeX => '\\$', Latex2HTML => '\\$', HTML => '$' ); };
 1161 sub PERCENT { MODES( TeX => '\\%', Latex2HTML => '\\%', HTML => '%' ); };
 1162 sub CARET { MODES( TeX => '\\verb+^+', Latex2HTML => '\\verb+^+', HTML => '^' ); };
 1163 sub PI {4*atan2(1,1);};
 1164 sub E {exp(1);};
 1165 
 1166 ###############################################################
 1167 ## Evaluation macros
 1168 
 1169 
 1170 =head2 TEXT macros
 1171 
 1172   Usage:
 1173     TEXT(@text);
 1174 
 1175 This is the simplest way to print text from a problem.  The strings in the array C<@text> are concatenated
 1176 with spaces between them and printed out in the text of the problem.  The text is not processed in any other way.
 1177 C<TEXT> is defined in PG.pl.
 1178 
 1179   Usage:
 1180     BEGIN_TEXT
 1181       text.....
 1182     END_TEXT
 1183 
 1184 This is the most common way to enter text into the problem.  All of the text between BEGIN_TEXT and END_TEXT
 1185 is processed by the C<EV3> macro described below and then printed using the C<TEXT> command.  The two key words
 1186 must appear on lines by themselves.  The preprocessing that makes this construction work is done in F<PGtranslator.pm>.
 1187 See C<EV3> below for details on the processing.
 1188 
 1189 
 1190 =cut
 1191 
 1192 =head2 Evaluation macros
 1193 
 1194 =head3 EV3
 1195 
 1196         TEXT(EV3("This is a formulat \( \int_0^5 x^2 \, dx \) ");
 1197         TEXT(EV3(@text));
 1198 
 1199     TEXT(EV3(<<'END_TEXT'));
 1200       text stuff...
 1201     END_TEXT
 1202 
 1203 
 1204 The BEGIN_TEXT/END_TEXT construction is translated into the construction above by PGtranslator.pm.  END_TEXT must appear
 1205 on a line by itself and be left justified.  (The << construction is known as a "here document" in UNIX and in PERL.)
 1206 
 1207 The single quotes around END_TEXT mean that no automatic interpolation of variables takes place in the text.
 1208 Using EV3 with strings which have been evaluated by double quotes may lead to unexpected results.
 1209 
 1210 
 1211 The evaluation macro E3 first evaluates perl code inside the braces:  C<\{  code \}>.
 1212 Any perl statment can be put inside the braces.  The
 1213 result of the evaluation (i.e. the last statement evaluated) replaces the C<\{ code \}> construction.
 1214 
 1215 Next interpolation of all variables (e.g. C<$var or @array> ) is performed.
 1216 
 1217 Then mathematical formulas in TeX are evaluated within the
 1218 C<\(  tex math mode \)> and
 1219 C<\[ tex display math mode \] >
 1220 constructions, in that order:
 1221 
 1222 =head3 FEQ
 1223 
 1224   FEQ($string);   # processes and outputs the string
 1225 
 1226 
 1227 The mathematical formulas are run through the macro C<FEQ> (Format EQuations) which performs
 1228 several substitutions (see below).
 1229 In C<HTML_tth> mode the resulting code is processed by tth to obtain an HTML version
 1230 of the formula. (In the future processing by WebEQ may be added here as another option.)
 1231 The Latex2HTML mode does nothing
 1232 at this stage; it creates the entire problem before running it through
 1233 TeX and creating the GIF images of the equations.
 1234 
 1235 The resulting string is output (and usually fed into TEXT to be printed in the problem).
 1236 
 1237   Usage:
 1238 
 1239     $string2 = FEQ($string1);
 1240 
 1241 This is a filter which is used to format equations by C<EV2> and C<EV3>, but can also be used on its own.  It is best
 1242 understood with an example.
 1243 
 1244     $string1 = "${a}x^2 + ${b}x + {$c:%.1f}"; $a = 3;, $b = -2; $c = -7.345;
 1245 
 1246 when interpolated becomes:
 1247 
 1248     $string1 = '3x^2 + -2x + {-7.345:%0.1f}
 1249 
 1250 FEQ first changes the number of decimal places displayed, so that the last term becomes -7.3 Then it removes the
 1251 extraneous plus and minus signs, so that the final result is what you want:
 1252 
 1253     $string2 = '3x^2 - 2x -7.3';
 1254 
 1255 (The %0.1f construction
 1256 is the same formatting convention used by Perl and nearly identical to the one used by the C printf statement. Some common
 1257 usage:  %0.3f 3 decimal places, fixed notation; %0.3e 3 significant figures exponential notation; %0.3g uses either fixed
 1258 or exponential notation depending on the size of the number.)
 1259 
 1260 Two additional legacy formatting constructions are also supported:
 1261 
 1262 C<?{$c:%0.3f} > will give a number with 3 decimal places and a negative
 1263 sign if the number is negative, no sign if the number is positive.
 1264 
 1265 C<!{$c:%0.3f}> determines the sign and prints it
 1266 whether the number is positive or negative.
 1267 
 1268 =head3 EV2
 1269 
 1270     TEXT(EV2(@text));
 1271 
 1272     TEXT(EV2(<<END_OF_TEXT));
 1273       text stuff...
 1274     END_OF_TEXT
 1275 
 1276 This is a precursor to EV3.  In this case the constants are interpolated first, before the evaluation of the \{ ...code...\}
 1277 construct. This can lead to unexpected results.  For example C<\{ join(" ", @text) \}> with C<@text = ("Hello","World");> becomes,
 1278 after interpolation, C<\{ join(" ",Hello World) \}> which then causes an error when evaluated because Hello is a bare word.
 1279 C<EV2> can still be useful if you allow for this, and in particular it works on double quoted strings, which lead to
 1280 unexpected results with C<EV3>. Using single quoted strings with C<EV2> may lead to unexpected results.
 1281 
 1282 The unexpected results have to do with the number of times backslashed constructions have to be escaped. It is quite messy.  For
 1283 more details get a good Perl book and then read the code. :-)
 1284 
 1285 
 1286 
 1287 
 1288 =cut
 1289 
 1290 
 1291 sub ev_substring {
 1292     my $string      = shift;
 1293   my $start_delim = shift;
 1294   my $end_delim   = shift;
 1295   my $actionRef   = shift;
 1296   my ($eval_out,$PG_eval_errors,$PG_full_error_report)=();
 1297     my $out = "";
 1298     while ($string) {
 1299         if ($string =~ /\Q$start_delim\E/s) {
 1300        #print "$start_delim $end_delim evaluating_substring=$string<BR>";
 1301         $string =~ s/^(.*?)\Q$start_delim\E//s;  # get string up to next \{ ---treats string as a single line, ignoring returns
 1302         $out .= $1;
 1303        #print "$start_delim $end_delim substring_out=$out<BR>";
 1304         $string =~ s/^(.*?)\Q$end_delim\E//s;  # get perl code up to \} ---treats string as a single line,  ignoring returns
 1305            #print "$start_delim $end_delim evaluate_string=$1<BR>";
 1306         ($eval_out,$PG_eval_errors,$PG_full_error_report) = &$actionRef($1);
 1307         $eval_out = "$start_delim $eval_out $end_delim" if $PG_full_error_report;
 1308         $out = $out . $eval_out;
 1309        #print "$start_delim $end_delim new substring_out=$out<BR><p><BR>";
 1310         $out .="$PAR ERROR $0 in ev_substring, PGbasicmacros.pl:$PAR <PRE>  $@ </PRE>$PAR" if $@;
 1311         }
 1312       else {
 1313         $out .= $string;  # flush the last part of the string
 1314         last;
 1315         }
 1316 
 1317       }
 1318   $out;
 1319 }
 1320 sub  safe_ev {
 1321     my ($out,$PG_eval_errors,$PG_full_error_report) = &old_safe_ev;   # process input by old_safe_ev first
 1322     $out =~s/\\/\\\\/g;   # protect any new backslashes introduced.
 1323   ($out,$PG_eval_errors,$PG_full_error_report)
 1324 }
 1325 
 1326 sub  old_safe_ev {
 1327     my $in = shift;
 1328     my   ($out,$PG_eval_errors,$PG_full_error_report) = PG_restricted_eval("$in;");
 1329     # the addition of the ; seems to provide better error reporting
 1330     if ($PG_eval_errors) {
 1331       my @errorLines = split("\n",$PG_eval_errors);
 1332     #$out = "<PRE>$PAR % ERROR in $0:old_safe_ev, PGbasicmacros.pl: $PAR % There is an error occuring inside evaluation brackets \\{ ...code... \\} $BR % somewhere in an EV2 or EV3 or BEGIN_TEXT block. $BR % Code evaluated:$BR $in $BR % $BR % $errorLines[0]\n % $errorLines[1]$BR % $BR % $BR </PRE> ";
 1333     warn " ERROR in old_safe_ev, PGbasicmacros.pl: <PRE>
 1334      ## There is an error occuring inside evaluation brackets \\{ ...code... \\}
 1335      ## somewhere in an EV2 or EV3 or BEGIN_TEXT block.
 1336      ## Code evaluated:
 1337      ## $in
 1338      ##" .join("\n     ", @errorLines). "
 1339      ##</PRE>$BR
 1340      ";
 1341      $out ="$PAR $BBOLD  $in $EBOLD $PAR";
 1342 
 1343 
 1344   }
 1345 
 1346   ($out,$PG_eval_errors,$PG_full_error_report);
 1347 }
 1348 
 1349 sub FEQ   {    # Format EQuations
 1350   my $in = shift;
 1351    # formatting numbers -- the ?{} and !{} constructions
 1352   $in =~s/\?\s*\{([.\-\$\w\d]+):?([%.\da-z]*)\}/${ \( &sspf($1,$2) )}/g;
 1353   $in =~s/\!\s*\{([.\-\$\w\d]+):?([%.\da-z]*)\}/${ \( &spf($1,$2) )}/g;
 1354 
 1355   # more formatting numbers -- {number:format} constructions
 1356   $in =~ s/\{(\s*[\+\-\d\.]+[eE]*[\+\-]*\d*):(\%\d*.\d*\w)}/${ \( &spf($1,$2) )}/g;
 1357   $in =~ s/\+\s*\-/ - /g;
 1358   $in =~ s/\-\s*\+/ - /g;
 1359   $in =~ s/\+\s*\+/ + /g;
 1360   $in =~ s/\-\s*\-/ + /g;
 1361   $in;
 1362 }
 1363 
 1364 #sub math_ev3 {
 1365 # my $in = shift; #print "in=$in<BR>";
 1366 # my ($out,$PG_eval_errors,$PG_full_error_report);
 1367 # $in = FEQ($in);
 1368 # $in =~ s/%/\\%/g;   #  % causes trouble in TeX and HTML_tth it usually (always?) indicates an error, not comment
 1369 # return("$BM $in $EM") unless ($displayMode eq 'HTML_tth');
 1370 # $in = "\\(" . $in . "\\)";
 1371 # $out = tth($in);
 1372 # ($out,$PG_eval_errors,$PG_full_error_report);
 1373 #
 1374 #}
 1375 #
 1376 #sub display_math_ev3 {
 1377 # my $in = shift; #print "in=$in<BR>";
 1378 # my ($out,$PG_eval_errors,$PG_full_error_report);
 1379 # $in = FEQ($in);
 1380 # $in =~ s/%/\\%/g;
 1381 # return("$main::BDM $in $main::EDM") unless $displayMode eq 'HTML_tth' ;
 1382 # $in = "\\[" . $in . "\\]";
 1383 # $out =tth($in);
 1384 # ($out,$PG_eval_errors,$PG_full_error_report);
 1385 #}
 1386 
 1387 sub math_ev3 {
 1388   my $in = shift;
 1389   return general_math_ev3($in, "inline");
 1390 }
 1391 
 1392 sub display_math_ev3 {
 1393   my $in = shift;
 1394   return general_math_ev3($in, "display");
 1395 }
 1396 
 1397 sub general_math_ev3 {
 1398   my $in = shift;
 1399   my $mode = shift || "inline";
 1400 
 1401   $in = FEQ($in); # Format EQuations
 1402   $in =~ s/%/\\%/g; # avoid % becoming TeX comments
 1403 
 1404   # some modes want the delimiters, some don't
 1405   my $in_delim = $mode eq "inline"
 1406     ? "\\($in\\)"
 1407     : "\\[$in\\]";
 1408 
 1409   my $out;
 1410   if($displayMode eq "HTML_tth") {
 1411     $out = tth($in_delim);
 1412   } elsif ($displayMode eq "HTML_dpng") {
 1413     # for jj's version of ImageGenerator
 1414     $out = $envir->{'imagegen'}->add($in_delim);
 1415     # for my version of ImageGenerator
 1416     #$out = $envir->{'imagegen'}->add($in, $mode);
 1417   } elsif ($displayMode eq "HTML_img") {
 1418     $out = math2img($in, $mode);
 1419   } else {
 1420     $out = "\\($in\\)" if $mode eq "inline";
 1421     $out = "\\[$in\\]" if $mode eq "display";
 1422   }
 1423   return $out;
 1424 }
 1425 
 1426 sub EV2 {
 1427   my $string = join(" ",@_);
 1428   # evaluate code inside of \{  \}  (no nesting allowed)
 1429     $string = ev_substring($string,"\\{","\\}",\&old_safe_ev);
 1430     $string = ev_substring($string,"\\<","\\>",\&old_safe_ev);
 1431   $string = ev_substring($string,"\\(","\\)",\&math_ev3);
 1432   $string = ev_substring($string,"\\[","\\]",\&display_math_ev3);
 1433   # macros for displaying math
 1434   $string =~ s/\\\(/$BM/g;
 1435   $string =~ s/\\\)/$EM/g;
 1436   $string =~ s/\\\[/$BDM/g;
 1437   $string =~ s/\\\]/$EDM/g;
 1438   $string;
 1439 }
 1440 
 1441 sub EV3{
 1442   my $string = join(" ",@_);
 1443   # evaluate code inside of \{  \}  (no nesting allowed)
 1444     $string = ev_substring($string,"\\\\{","\\\\}",\&safe_ev);  # handles \{ \} in single quoted strings of PG files
 1445   # interpolate variables
 1446   my ($evaluated_string,$PG_eval_errors,$PG_full_errors) = PG_restricted_eval("<<END_OF_EVALUATION_STRING\n$string\nEND_OF_EVALUATION_STRING\n");
 1447   if ($PG_eval_errors) {
 1448       my @errorLines = split("\n",$PG_eval_errors);
 1449       $string =~ s/</&lt;/g; $string =~ s/>/&gt;/g;
 1450     $evaluated_string = "<PRE>$PAR % ERROR in $0:EV3, PGbasicmacros.pl: $PAR % There is an error occuring in the following code:$BR $string $BR % $BR % $errorLines[0]\n % $errorLines[1]$BR % $BR % $BR </PRE> ";
 1451     $@="";
 1452   }
 1453   $string = $evaluated_string;
 1454   $string = ev_substring($string,"\\(","\\)",\&math_ev3);
 1455     $string = ev_substring($string,"\\[","\\]",\&display_math_ev3);
 1456   $string;
 1457 }
 1458 
 1459 =head2 Formatting macros
 1460 
 1461   beginproblem()  # generates text listing number and the point value of
 1462                   # the problem. It will also print the file name containing
 1463                   # the problem for users listed in the PRINT_FILE_NAMES_FOR PG_environment
 1464                   # variable.
 1465   OL(@array)      # formats the array as an Ordered List ( <OL> </OL> ) enumerated by letters.
 1466 
 1467   htmlLink($url, $text)
 1468                   # Places a reference to the URL with the specified text in the problem.
 1469                   # A common usage is \{ htmlLink(alias('prob1_help.html') \}, 'for help')
 1470                   # where alias finds the full address of the prob1_help.html file in the same directory
 1471                   # as the problem file
 1472   appletLink($url, $parameters)
 1473                   # For example
 1474                   # appletLink(q!  archive="http: //webwork.math.rochester.edu/gage/xFunctions/xFunctions.zip"
 1475                                   code="xFunctionsLauncher.class"  width=100 height=14!,
 1476                   " parameter text goes here")
 1477                   # will link to xFunctions.
 1478 
 1479   low level:
 1480 
 1481   spf($number, $format)   # prints the number with the given format
 1482   sspf($number, $format)  # prints the number with the given format, always including a sign.
 1483   protect_underbar($string) # protects the underbar (class_name) in strings which may have to pass through TeX.
 1484 
 1485 =cut
 1486 
 1487 sub beginproblem {
 1488   my $out = "";
 1489   my $problemValue = $envir->{problemValue};
 1490   my $fileName     = $envir->{problemValue};
 1491   my $probNum      = $envir->{probNum};
 1492     my $TeXFileName = protect_underbar($envir->{fileName});
 1493     my $l2hFileName = protect_underbar($envir->{fileName});
 1494   my %inlist;
 1495   my $points ='pts';
 1496 
 1497   $points = 'pt' if $problemValue == 1;
 1498   ##    Prepare header for the problem
 1499   grep($inlist{$_}++,@{ $envir->{'PRINT_FILE_NAMES_FOR'} });
 1500   if ( defined($inlist{$envir->{studentLogin}}) and ($inlist{$envir->{studentLogin}} > 0) ) {
 1501     $out = &M3("\n\n\\medskip\\hrule\\smallskip\\par{\\bf ${probNum}.{\\footnotesize ($problemValue $points) $TeXFileName}}\\newline ",
 1502     " \\begin{rawhtml} ($problemValue $points) <B>$l2hFileName</B><BR>\\end{rawhtml}",
 1503      "($problemValue $points) <B>$fileName</B><BR>"
 1504        );
 1505   } else {
 1506     $out = &M3("\n\n\\smallskip\\hrule\\smallskip\\par{\\bf ${probNum}.}($problemValue $points) ",
 1507     "($problemValue $points) ",
 1508      "($problemValue $points) "
 1509        );
 1510   }
 1511   $out;
 1512 
 1513 }
 1514 
 1515 # kludge to clean up path names
 1516             ## allow underscore character in set and section names and also allows line breaks at /
 1517 sub protect_underbar {
 1518     my $in = shift;
 1519     if ($displayMode eq 'TeX')  {
 1520 
 1521         $in =~ s|_|\\\_|g;
 1522         $in =~ s|/|\\\-/|g;  # allows an optional hyphenation of the path (in tex)
 1523     }
 1524     $in;
 1525 }
 1526 
 1527 
 1528 # An example of a macro which prints out a list (with letters)
 1529 sub OL {
 1530   my(@array) = @_;
 1531   my $i = 0;
 1532   my  $out=   &M3(
 1533           "\\begin{enumerate}\n",
 1534           " \\begin{rawhtml} <OL TYPE=\"A\" VALUE=\"1\"> \\end{rawhtml} ",
 1535           "<OL TYPE=\"A\" VALUE=\"1\">\n"
 1536           ) ;
 1537   my $elem;
 1538   foreach $elem (@array) {
 1539                 $out .= MODES(
 1540                         TeX=>   "\\item[$ALPHABET[$i].] $elem\n",
 1541                         Latex2HTML=>    " \\begin{rawhtml} <LI> \\end{rawhtml} $elem  ",
 1542                         HTML=>  "<LI> $elem\n",
 1543                         HTML_dpng=>     "<LI> $elem <br /> <br /> \n"
 1544                                         );
 1545     $i++;
 1546   }
 1547   $out .= &M3(
 1548         "\\end{enumerate}\n",
 1549         " \\begin{rawhtml} </OL>\n \\end{rawhtml} ",
 1550         "</OL>\n"
 1551         ) ;
 1552 }
 1553 
 1554 sub htmlLink {
 1555   my $url = shift;
 1556   my $text = shift;
 1557   my $options = shift;
 1558   $options = "" unless defined($options);
 1559   return "$BBOLD\[ broken link:  $text \] $EBOLD" unless defined($url);
 1560   M3( "{\\bf \\underline{$text}  }",
 1561       "\\begin{rawhtml} <A HREF=\"$url\" $options> $text </A>\\end{rawhtml}",
 1562       "<A HREF=\"$url\" $options> $text </A>"
 1563       );
 1564 }
 1565 
 1566 sub appletLink {
 1567   my $url = shift;
 1568   my $options = shift;
 1569   $options = "" unless defined($options);
 1570   M3( "{\\bf \\underline{APPLET}  }",
 1571       "\\begin{rawhtml} <APPLET $url> $options </APPLET>\\end{rawhtml}",
 1572       "<APPLET $url> $options </APPLET>"
 1573       );
 1574 }
 1575 sub spf {
 1576   my($number,$format) = @_;  # attention, the order of format and number are reversed
 1577   $format = "%4.3g" unless $format;   # default value for format
 1578   sprintf($format, $number);
 1579   }
 1580 sub sspf {
 1581   my($number,$format) = @_;  # attention, the order of format and number are reversed
 1582   $format = "%4.3g" unless $format;   # default value for format
 1583   my $sign = $number>=0 ? " + " : " - ";
 1584   $number = $number>=0 ? $number : -$number;
 1585   $sign .sprintf($format, $number);
 1586   }
 1587 
 1588 =head2  Sorting and other list macros
 1589 
 1590 
 1591 
 1592   Usage:
 1593   lex_sort(@list);   # outputs list in lexigraphic (alphabetical) order
 1594   num_sort(@list);   # outputs list in numerical order
 1595   uniq( @list);      # outputs a list with no duplicates.  Order is unspecified.
 1596 
 1597   PGsort( \&sort_subroutine, @list);
 1598   # &sort_subroutine defines order. It's output must be -1,0 or 1.
 1599 
 1600 =cut
 1601 
 1602 #  uniq gives unique elements of a list:
 1603  sub uniq {
 1604    my (@in) =@_;
 1605    my %temp = ();
 1606    while (@in) {
 1607           $temp{shift(@in)}++;
 1608       }
 1609    my @out =  keys %temp;  # sort is causing trouble with Safe.??
 1610    @out;
 1611 }
 1612 
 1613 sub lex_sort {
 1614   PGsort sub {$_[0] cmp $_[1]}, @_;
 1615 }
 1616 sub num_sort {
 1617   PGsort sub {$_[0] <=> $_[1]}, @_;
 1618 }
 1619 
 1620 
 1621 =head2 Macros for handling tables
 1622 
 1623   Usage:
 1624   begintable( number_of_columns_in_table)
 1625   row(@dataelements)
 1626   endtable()
 1627 
 1628 Example of useage:
 1629 
 1630   BEGIN_TEXT
 1631     This problem tests calculating new functions from old ones:$BR
 1632     From the table below calculate the quantities asked for:$BR
 1633     \{begintable(scalar(@firstrow)+1)\}
 1634     \{row(" \(x\) ",@firstrow)\}
 1635     \{row(" \(f(x)\) ", @secondrow)\}
 1636     \{row(" \(g(x)\) ", @thirdrow)\}
 1637     \{row(" \(f'(x)\) ", @fourthrow)\}
 1638     \{row(" \(g'(x)\) ", @fifthrow)\}
 1639     \{endtable()\}
 1640 
 1641    (The arrays contain numbers which are placed in the table.)
 1642 
 1643   END_TEXT
 1644 
 1645 =cut
 1646 
 1647 sub begintable {
 1648   my ($number)=shift;   #number of columns in table
 1649   my %options = @_;
 1650   warn "begintable(cols) requires a number indicating the number of columns" unless defined($number);
 1651   my $out = "";
 1652   if ($displayMode eq 'TeX') {
 1653     $out .= "\n\\par\\smallskip\\begin{center}\\begin{tabular}{"  .  "|c" x $number .  "|} \\hline\n";
 1654     }
 1655   elsif ($displayMode eq 'Latex2HTML') {
 1656     $out .= "\n\\begin{rawhtml} <TABLE , BORDER=1>\n\\end{rawhtml}";
 1657     }
 1658   elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng' || $displayMode eq 'HTML_img') {
 1659     $out .= "<TABLE BORDER=1>\n"
 1660   }
 1661   else {
 1662     $out = "Error: PGchoicemacros: begintable: Unknown displayMode: $displayMode.\n";
 1663     }
 1664   $out;
 1665   }
 1666 
 1667 sub endtable {
 1668   my $out = "";
 1669   if ($displayMode eq 'TeX') {
 1670     $out .= "\n\\end {tabular}\\end{center}\\par\\smallskip\n";
 1671     }
 1672   elsif ($displayMode eq 'Latex2HTML') {
 1673     $out .= "\n\\begin{rawhtml} </TABLE >\n\\end{rawhtml}";
 1674     }
 1675   elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng' ||$displayMode eq 'HTML_img') {
 1676     $out .= "</TABLE>\n";
 1677     }
 1678   else {
 1679     $out = "Error: PGchoicemacros: endtable: Unknown displayMode: $displayMode.\n";
 1680     }
 1681   $out;
 1682   }
 1683 
 1684 
 1685 sub row {
 1686   my @elements = @_;
 1687   my $out = "";
 1688   if ($displayMode eq 'TeX') {
 1689     while (@elements) {
 1690       $out .= shift(@elements) . " &";
 1691       }
 1692      chop($out); # remove last &
 1693      $out .= "\\\\ \\hline \n";
 1694      # carriage returns must be added manually for tex
 1695     }
 1696   elsif ($displayMode eq 'Latex2HTML') {
 1697     $out .= "\n\\begin{rawhtml}\n<TR>\n\\end{rawhtml}\n";
 1698     while (@elements) {
 1699       $out .= " \n\\begin{rawhtml}\n<TD> \n\\end{rawhtml}\n" . shift(@elements) . " \n\\begin{rawhtml}\n</TD> \n\\end{rawhtml}\n";
 1700       }
 1701     $out .= " \n\\begin{rawhtml}\n</TR> \n\\end{rawhtml}\n";
 1702   }
 1703   elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng'||$displayMode eq 'HTML_img') {
 1704     $out .= "<TR>\n";
 1705     while (@elements) {
 1706       $out .= "<TD>" . shift(@elements) . "</TD>";
 1707       }
 1708     $out .= "\n</TR>\n";
 1709   }
 1710   else {
 1711     $out = "Error: PGchoicemacros: row: Unknown displayMode: $displayMode.\n";
 1712     }
 1713   $out;
 1714 }
 1715 
 1716 =head2 Macros for displaying static images
 1717 
 1718   Usage:
 1719   $string = image($image, width => 100, height => 100, tex_size => 800)
 1720   $string = image([$image1, $image2], width => 100, height => 100, tex_size => 800)
 1721   $string = caption($string);
 1722   $string = imageRow([$image1, $image2 ], [$caption1, $caption2]);
 1723            # produces a complete table with rows of pictures.
 1724 
 1725 
 1726 =cut
 1727 
 1728 #   More advanced macros
 1729 sub image {
 1730   my $image_ref  = shift;
 1731   my @opt = @_;
 1732   unless (scalar(@opt) % 2 == 0 ) {
 1733     warn "ERROR in image macro.  A list of macros must be inclosed in square brackets.";
 1734   }
 1735   my %in_options = @opt;
 1736   my %known_options = (
 1737     width    => 100,
 1738     height   => 100,
 1739     tex_size => 800,
 1740   );
 1741   # handle options
 1742   my %out_options = %known_options;
 1743   foreach my $opt_name (keys %in_options) {
 1744     if ( exists( $known_options{$opt_name} ) ) {
 1745       $out_options{$opt_name} = $in_options{$opt_name} if exists( $in_options{$opt_name} ) ;
 1746     } else {
 1747       die "Option $opt_name not defined for image. " .
 1748           "Default options are:<BR> ", display_options2(%known_options);
 1749     }
 1750   }
 1751   my $width       = $out_options{width};
 1752   my $height      = $out_options{height};
 1753   my $tex_size    = $out_options{tex_size};
 1754   my $width_ratio = $tex_size*(.001);
 1755   my @image_list  = ();
 1756 
 1757   if (ref($image_ref) =~ /ARRAY/ ) {
 1758     @image_list = @{$image_ref};
 1759   } else {
 1760     push(@image_list,$image_ref);
 1761   }
 1762 
 1763   my @output_list = ();
 1764     while(@image_list) {
 1765     my $imageURL = alias(shift @image_list);
 1766     my $out="";
 1767 
 1768     if ($displayMode eq 'TeX') {
 1769       my $imagePath = $imageURL; # in TeX mode, alias gives us a path, not a URL
 1770       if ($envir->{texDisposition} eq "pdf") {
 1771         # We're going to create PDF files with our TeX (using pdflatex), so
 1772         # alias should have given us the path to a PNG image. What we need
 1773         # to do is find out the dimmensions of this image, since pdflatex
 1774         # is too dumb to live.
 1775 
 1776         #my ($height, $width) = getImageDimmensions($imagePath);
 1777         ##warn "&image: $imagePath $height $width\n";
 1778         #unless ($height and $width) {
 1779         # warn "Couldn't get the dimmensions of image $imagePath.\n"
 1780         #}
 1781         #$out = "\\includegraphics[bb=0 0 $height $width,width=$width_ratio\\linewidth]{$imagePath}\n";
 1782         $out = "\\includegraphics[width=$width_ratio\\linewidth]{$imagePath}\n";
 1783       } else {
 1784         # Since we're not creating PDF files, alias should have given us the
 1785         # path to an EPS file. latex can get its dimmensions no problem!
 1786 
 1787         $out = "\\includegraphics[width=$width_ratio\\linewidth]{$imagePath}\n";
 1788       }
 1789     } elsif ($displayMode eq 'Latex2HTML') {
 1790       $out = qq!\\begin{rawhtml}\n<A HREF= "$imageURL" TARGET="ZOOM"><IMG SRC="$imageURL"  WIDTH="$width" HEIGHT="$height"></A>\n
 1791       \\end{rawhtml}\n !
 1792     } elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng' || $displayMode eq 'HTML_img') {
 1793       $out = qq!<A HREF= "$imageURL" TARGET="ZOOM"><IMG SRC="$imageURL"  WIDTH="$width" HEIGHT="$height"></A>
 1794       !
 1795     } else {
 1796       $out = "Error: PGchoicemacros: image: Unknown displayMode: $displayMode.\n";
 1797     }
 1798     push(@output_list, $out);
 1799   }
 1800   return wantarray ? @output_list : $output_list[0];
 1801 }
 1802 
 1803 # This is legacy code.
 1804 sub images {
 1805   my @in = @_;
 1806   my @outlist = ();
 1807   while (@in) {
 1808      push(@outlist,&image( shift(@in) ) );
 1809    }
 1810   @outlist;
 1811 }
 1812 
 1813 
 1814 sub caption {
 1815   my ($out) = @_;
 1816   $out = " $out \n" if $displayMode eq 'TeX';
 1817   $out = " $out  " if $displayMode eq 'HTML';
 1818   $out = " $out  " if $displayMode eq 'HTML_tth';
 1819   $out = " $out  " if $displayMode eq 'HTML_dpng';
 1820   $out = " $out  " if $displayMode eq 'HTML_img';
 1821   $out = " $out  " if $displayMode eq 'Latex2HTML';
 1822     $out;
 1823 }
 1824 
 1825 sub captions {
 1826   my @in = @_;
 1827   my @outlist = ();
 1828   while (@in) {
 1829      push(@outlist,&caption( shift(@in) ) );
 1830   }
 1831   @outlist;
 1832 }
 1833 
 1834 sub imageRow {
 1835 
 1836   my $pImages = shift;
 1837   my $pCaptions=shift;
 1838   my $out = "";
 1839   my @images = @$pImages;
 1840   my @captions = @$pCaptions;
 1841   my $number = @images;
 1842   # standard options
 1843   my %options = ( 'tex_size' => 200,  # width for fitting 4 across
 1844                   'height' => 100,
 1845                   'width' => 100,
 1846                   @_            # overwrite any default options
 1847                 );
 1848 
 1849   if ($displayMode eq 'TeX') {
 1850     $out .= "\n\\par\\smallskip\\begin{center}\\begin{tabular}{"  .  "|c" x $number .  "|} \\hline\n";
 1851     while (@images) {
 1852       $out .= &image( shift(@images),%options ) . '&';
 1853     }
 1854     chop($out);
 1855     $out .= "\\\\ \\hline \n";
 1856     while (@captions) {
 1857       $out .= &caption( shift(@captions) ) . '&';
 1858     }
 1859     chop($out);
 1860     $out .= "\\\\ \\hline \n\\end {tabular}\\end{center}\\par\\smallskip\n";
 1861   } elsif ($displayMode eq 'Latex2HTML'){
 1862 
 1863     $out .= "\n\\begin{rawhtml} <TABLE  BORDER=1><TR>\n\\end{rawhtml}\n";
 1864     while (@images) {
 1865       $out .= "\n\\begin{rawhtml} <TD>\n\\end{rawhtml}\n" . &image( shift(@images),%options )
 1866               . "\n\\begin{rawhtml} </TD>\n\\end{rawhtml}\n" ;
 1867     }
 1868 
 1869     $out .= "\n\\begin{rawhtml}</TR><TR>\\end{rawhtml}\n";
 1870     while (@captions) {
 1871       $out .= "\n\\begin{rawhtml} <TH>\n\\end{rawhtml}\n".&caption( shift(@captions) )
 1872               . "\n\\begin{rawhtml} </TH>\n\\end{rawhtml}\n" ;
 1873     }
 1874 
 1875     $out .= "\n\\begin{rawhtml} </TR> </TABLE >\n\\end{rawhtml}";
 1876   } elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng'|| $displayMode eq 'HTML_img'){
 1877     $out .= "<P>\n <TABLE BORDER=2 CELLPADDING=3 CELLSPACING=2 ><TR ALIGN=CENTER    VALIGN=MIDDLE>\n";
 1878     while (@images) {
 1879       $out .= " \n<TD>". &image( shift(@images),%options ) ."</TD>";
 1880     }
 1881     $out .= "</TR>\n<TR>";
 1882     while (@captions) {
 1883       $out .= " <TH>". &caption( shift(@captions) ) ."</TH>";
 1884     }
 1885     $out .= "\n</TR></TABLE></P>\n"
 1886   }
 1887   else {
 1888     $out = "Error: PGchoicemacros: imageRow: Unknown languageMode: $displayMode.\n";
 1889     warn $out;
 1890   }
 1891   $out;
 1892 }
 1893 
 1894 
 1895 ###########
 1896 # Auxiliary macros
 1897 
 1898 sub display_options2{
 1899   my %options = @_;
 1900   my $out_string = "";
 1901   foreach my $key (keys %options) {
 1902     $out_string .= " $key => $options{$key},<BR>";
 1903   }
 1904   $out_string;
 1905 }
 1906 
 1907 
 1908 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9