[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 6929 - (download) (as text) (annotate)
Wed Jul 13 13:16:42 2011 UTC (8 years, 6 months ago) by gage
File size: 86304 byte(s)
added documentation for iframe macro


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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9