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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9