[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 6051 - (download) (as text) (annotate)
Thu Jun 25 14:49:16 2009 UTC (10 years, 6 months ago) by gage
File size: 79104 byte(s)
Update information to instructor about hints in the problem.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9