[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 6179 - (download) (as text) (annotate)
Thu Jan 7 18:02:53 2010 UTC (9 years, 11 months ago) by jj
File size: 80535 byte(s)
Added macros to make it easier to have underlined text in a problem:
BUL and EUL

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9