[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 6085 - (download) (as text) (annotate)
Sat Jul 18 02:50:50 2009 UTC (10 years, 6 months ago) by gage
File size: 80146 byte(s)
added effectivePermissionLevel to the PG environment
 -- the permission level of the effectiveUser, the user to which the question has been assigned.

Changed the printing of the path to files in beginproblem
so that it is shown if the effectivePermissionLevel is higher than
the "PRINT_FILE_NAMES_PERMISSION_LEVEL" value.  This responds to user requests that make it easier for an
instructor to print hardcopy for the student.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9