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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9