[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 6852 - (download) (as text) (annotate)
Sat Jun 11 18:45:59 2011 UTC (8 years, 7 months ago) by gage
File size: 83851 byte(s)
More modifications to addToTeXPreamble()

This now modifies only the behavior of images for creating equations.

You can add tex commands to the setHeader.pl file that will affect the typesetting
of an entire problem set.  There are additional notes in the POD documentation.



    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         }
 1457 #         else {
 1458 #                 TEXT($str."\n");
 1459 #         }
 1460 
 1461 }
 1462 
 1463 
 1464 =head3 FEQ
 1465 
 1466   FEQ($string);   # processes and outputs the string
 1467 
 1468 
 1469 The mathematical formulas are run through the macro C<FEQ> (Format EQuations) which performs
 1470 several substitutions (see below).
 1471 In C<HTML_tth> mode the resulting code is processed by tth to obtain an HTML version
 1472 of the formula. (In the future processing by WebEQ may be added here as another option.)
 1473 The Latex2HTML mode does nothing
 1474 at this stage; it creates the entire problem before running it through
 1475 TeX and creating the GIF images of the equations.
 1476 
 1477 The resulting string is output (and usually fed into TEXT to be printed in the problem).
 1478 
 1479   Usage:
 1480 
 1481     $string2 = FEQ($string1);
 1482 
 1483 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
 1484 understood with an example.
 1485 
 1486     $string1 = "${a}x^2 + ${b}x + {$c:%.1f}"; $a = 3;, $b = -2; $c = -7.345;
 1487 
 1488 when interpolated becomes:
 1489 
 1490     $string1 = '3x^2 + -2x + {-7.345:%0.1f}
 1491 
 1492 FEQ first changes the number of decimal places displayed, so that the last term becomes -7.3 Then it removes the
 1493 extraneous plus and minus signs, so that the final result is what you want:
 1494 
 1495     $string2 = '3x^2 - 2x -7.3';
 1496 
 1497 (The %0.1f construction
 1498 is the same formatting convention used by Perl and nearly identical to the one used by the C printf statement. Some common
 1499 usage:  %0.3f 3 decimal places, fixed notation; %0.3e 3 significant figures exponential notation; %0.3g uses either fixed
 1500 or exponential notation depending on the size of the number.)
 1501 
 1502 Two additional legacy formatting constructions are also supported:
 1503 
 1504 C<!{$c:%0.3f} > will give a number with 3 decimal places and a negative
 1505 sign if the number is negative, no sign if the number is positive.  Since this is
 1506 identical to the behavior of C<{$c:%0.3f}> the use of this syntax is depricated.
 1507 
 1508 C<?{$c:%0.3f}> determines the sign and prints it
 1509 whether the number is positive or negative.  You can use this
 1510 to force an expression such as C<+5.456>.
 1511 
 1512 =head3 EV2
 1513 
 1514     TEXT(EV2(@text));
 1515 
 1516     TEXT(EV2(<<END_OF_TEXT));
 1517       text stuff...
 1518     END_OF_TEXT
 1519 
 1520 This is a precursor to EV3.  In this case the constants are interpolated first, before the evaluation of the \{ ...code...\}
 1521 construct. This can lead to unexpected results.  For example C<\{ join(" ", @text) \}> with C<@text = ("Hello","World");> becomes,
 1522 after interpolation, C<\{ join(" ",Hello World) \}> which then causes an error when evaluated because Hello is a bare word.
 1523 C<EV2> can still be useful if you allow for this, and in particular it works on double quoted strings, which lead to
 1524 unexpected results with C<EV3>. Using single quoted strings with C<EV2> may lead to unexpected results.
 1525 
 1526 The unexpected results have to do with the number of times backslashed constructions have to be escaped. It is quite messy.  For
 1527 more details get a good Perl book and then read the code. :-)
 1528 
 1529 
 1530 
 1531 
 1532 =cut
 1533 
 1534 
 1535 sub ev_substring {
 1536     my $string      = shift;
 1537   my $start_delim = shift;
 1538   my $end_delim   = shift;
 1539   my $actionRef   = shift;
 1540   my ($eval_out,$PG_eval_errors,$PG_full_error_report)=();
 1541     my $out = "";
 1542                 #
 1543                 #  DPVC -- 2001/12/07
 1544                 #     original "while ($string)" fails to process the string "0" correctly
 1545                 #
 1546     while ($string ne "") {
 1547                 #
 1548                 #  end DPVC
 1549                 #
 1550         if ($string =~ /\Q$start_delim\E/s) {
 1551        #print "$start_delim $end_delim evaluating_substring=$string<BR>";
 1552         $string =~ s/^(.*?)\Q$start_delim\E//s;  # get string up to next \{ ---treats string as a single line, ignoring returns
 1553         $out .= $1;
 1554        #print "$start_delim $end_delim substring_out=$out<BR>";
 1555         $string =~ s/^(.*?)\Q$end_delim\E//s;  # get perl code up to \} ---treats string as a single line,  ignoring returns
 1556            #print "$start_delim $end_delim evaluate_string=$1<BR>";
 1557         ($eval_out,$PG_eval_errors,$PG_full_error_report) = &$actionRef($1);
 1558         $eval_out = "$start_delim $eval_out $end_delim" if $PG_full_error_report;
 1559         $out = $out . $eval_out;
 1560        #print "$start_delim $end_delim new substring_out=$out<BR><p><BR>";
 1561         $out .="$PAR ERROR $0 in ev_substring, PGbasicmacros.pl:$PAR <PRE>  $@ </PRE>$PAR" if $@;
 1562         }
 1563       else {
 1564         $out .= $string;  # flush the last part of the string
 1565         last;
 1566         }
 1567 
 1568       }
 1569   $out;
 1570 }
 1571 sub  safe_ev {
 1572     my ($out,$PG_eval_errors,$PG_full_error_report) = &old_safe_ev;   # process input by old_safe_ev first
 1573     $out = "" unless defined($out) and $out =~/\S/;
 1574     $out =~s/\\/\\\\/g;   # protect any new backslashes introduced.
 1575   ($out,$PG_eval_errors,$PG_full_error_report)
 1576 }
 1577 
 1578 sub  old_safe_ev {
 1579     my $in = shift;
 1580     my   ($out,$PG_eval_errors,$PG_full_error_report) = PG_restricted_eval("$in;");
 1581     # the addition of the ; seems to provide better error reporting
 1582     if ($PG_eval_errors) {
 1583       my @errorLines = split("\n",$PG_eval_errors);
 1584     #$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> ";
 1585     warn " ERROR in old_safe_ev, PGbasicmacros.pl: <PRE>
 1586      ## There is an error occuring inside evaluation brackets \\{ ...code... \\}
 1587      ## somewhere in an EV2 or EV3 or BEGIN_TEXT block.
 1588      ## Code evaluated:
 1589      ## $in
 1590      ##" .join("\n     ", @errorLines). "
 1591      ##</PRE>$BR
 1592      ";
 1593      $out ="$PAR $BBOLD  $in $EBOLD $PAR";
 1594 
 1595 
 1596   }
 1597 
 1598   ($out,$PG_eval_errors,$PG_full_error_report);
 1599 }
 1600 
 1601 sub FEQ   {    # Format EQuations
 1602   my $in = shift;
 1603    # formatting numbers -- the ?{} and !{} constructions
 1604   $in =~s/\?\s*\{([.\-\$\w\d]+):?([%.\da-z]*)\}/${ \( &sspf($1,$2) )}/g;
 1605   $in =~s/\!\s*\{([.\-\$\w\d]+):?([%.\da-z]*)\}/${ \( &spf($1,$2) )}/g;
 1606 
 1607   # more formatting numbers -- {number:format} constructions
 1608   $in =~ s/\{(\s*[\+\-\d\.]+[eE]*[\+\-]*\d*):(\%\d*.\d*\w)}/${ \( &spf($1,$2) )}/g;
 1609   $in =~ s/\+\s*\-/ - /g;
 1610   $in =~ s/\-\s*\+/ - /g;
 1611   $in =~ s/\+\s*\+/ + /g;
 1612   $in =~ s/\-\s*\-/ + /g;
 1613   $in;
 1614 }
 1615 
 1616 
 1617 sub math_ev3 {
 1618   my $in = shift;
 1619   return general_math_ev3($in, "inline");
 1620 }
 1621 
 1622 sub display_math_ev3 {
 1623   my $in = shift;
 1624   return general_math_ev3($in, "display");
 1625 }
 1626 
 1627 sub general_math_ev3 {
 1628   my $in = shift;
 1629   my $mode = shift || "inline";
 1630 
 1631   $in = FEQ($in); # Format EQuations
 1632   $in =~ s/%/\\%/g; # avoid % becoming TeX comments
 1633 
 1634   ## remove leading and trailing spaces so that HTML mode will
 1635   ## not include unwanted spaces as per Davide Cervone.
 1636   $in =~ s/^\s+//;
 1637   $in =~ s/\s+$//;
 1638   ## If it ends with a backslash, there should be another space
 1639   ## at the end
 1640   if($in =~ /\\$/) { $in .= ' ';}
 1641 
 1642   # some modes want the delimiters, some don't
 1643   my $in_delim = $mode eq "inline"
 1644     ? "\\($in\\)"
 1645     : "\\[$in\\]";
 1646 
 1647   my $out;
 1648   if($displayMode eq "HTML_MathJax") {
 1649      $out = '<span class="MathJax_Preview">[math]</span><script type="math/tex">'.$in.'</script>' if $mode eq "inline";
 1650      $out = '<span class="MathJax_Preview">[math]</span><script type="math/tex; mode=display">'.$in.'</script>' if $mode eq "display";
 1651   } elsif ($displayMode eq "HTML_dpng") {
 1652     # for jj's version of ImageGenerator
 1653     #$out = $envir->{'imagegen'}->add($in_delim);
 1654     # for my version of ImageGenerator
 1655     $out = $envir->{'imagegen'}->add($in, $mode);
 1656   } elsif ($displayMode eq "HTML_tth") {
 1657     $out = tth($in_delim);
 1658     ## remove leading and trailing spaces as per Davide Cervone.
 1659     $out =~ s/^\s+//;
 1660     $out =~ s/\s+$//;
 1661   } elsif ($displayMode eq "HTML_img") {
 1662     $out = math2img($in, $mode);
 1663   } elsif ($displayMode eq "HTML_jsMath") {
 1664     $in =~ s/&/&amp;/g; $in =~ s/</&lt;/g; $in =~ s/>/&gt;/g;
 1665     $out = '<SPAN CLASS="math">'.$in.'</SPAN>' if $mode eq "inline";
 1666     $out = '<DIV CLASS="math">'.$in.'</DIV>' if $mode eq "display";
 1667   } elsif ($displayMode eq "HTML_asciimath") {
 1668     $out = "`$in`" if $mode eq "inline";
 1669     $out = '<DIV ALIGN="CENTER">`'.$in.'`</DIV>' if $mode eq "display";
 1670   } elsif ($displayMode eq "HTML_LaTeXMathML") {
 1671     $in = '{'.$in.'}';
 1672     $in =~ s/</\\lt/g; $in =~ s/>/\\gt/g;
 1673     $in =~ s/\{\s*(\\(display|text|script|scriptscript)style)/$1\{/g;
 1674     $out = '$$'.$in.'$$' if $mode eq "inline";
 1675     $out = '<DIV ALIGN="CENTER">$$\displaystyle{'.$in.'}$$</DIV>' if $mode eq "display";
 1676   } else {
 1677     $out = "\\($in\\)" if $mode eq "inline";
 1678     $out = "\\[$in\\]" if $mode eq "display";
 1679   }
 1680   return $out;
 1681 }
 1682 
 1683 sub EV2 {
 1684   my $string = join(" ",@_);
 1685   # evaluate code inside of \{  \}  (no nesting allowed)
 1686     $string = ev_substring($string,"\\{","\\}",\&old_safe_ev);
 1687     $string = ev_substring($string,"\\<","\\>",\&old_safe_ev);
 1688   $string = ev_substring($string,"\\(","\\)",\&math_ev3);
 1689   $string = ev_substring($string,"\\[","\\]",\&display_math_ev3);
 1690   # macros for displaying math
 1691   $string =~ s/\\\(/$BM/g;
 1692   $string =~ s/\\\)/$EM/g;
 1693   $string =~ s/\\\[/$BDM/g;
 1694   $string =~ s/\\\]/$EDM/g;
 1695   $string;
 1696 }
 1697 
 1698 sub EV3{
 1699   my $string = join(" ",@_);
 1700   # evaluate code inside of \{  \}  (no nesting allowed)
 1701     $string = ev_substring($string,"\\\\{","\\\\}",\&safe_ev);  # handles \{ \} in single quoted strings of PG files
 1702   # interpolate variables
 1703   my ($evaluated_string,$PG_eval_errors,$PG_full_errors) = PG_restricted_eval("<<END_OF_EVALUATION_STRING\n$string\nEND_OF_EVALUATION_STRING\n");
 1704   if ($PG_eval_errors) {
 1705       my @errorLines = split("\n",$PG_eval_errors);
 1706       $string =~ s/</&lt;/g; $string =~ s/>/&gt;/g;
 1707     $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> ";
 1708     $@="";
 1709   }
 1710   $string = $evaluated_string;
 1711   $string = ev_substring($string,"\\(","\\)",\&math_ev3);
 1712     $string = ev_substring($string,"\\[","\\]",\&display_math_ev3);
 1713   $string;
 1714 }
 1715 
 1716 sub EV4{
 1717     if ($displayMode eq "HTML_dpng") {
 1718         my $string = join(" ",@_);
 1719         my ($evaluated_string,$PG_eval_errors,$PG_full_errors) = PG_restricted_eval("<<END_OF_EVALUATION_STRING\n$string\nEND_OF_EVALUATION_STRING\n");
 1720         if ($PG_eval_errors) {
 1721             my @errorLines = split("\n",$PG_eval_errors);
 1722             $string =~ s/</&lt;/g; $string =~ s/>/&gt;/g;
 1723             $evaluated_string = "<PRE>$PAR % ERROR in $0:EV3, PGbasicmacros.pl:".
 1724       "$PAR % There is an error occuring in the following code:$BR ".
 1725       "$string $BR % $BR % $errorLines[0]\n % $errorLines[1]$BR ".
 1726       "% $BR % $BR </PRE> ";
 1727         }
 1728         $string = $evaluated_string;
 1729         $string = $envir{'imagegen'}->add($string);
 1730         $string;
 1731     } else {
 1732       EV3(@_);
 1733     }
 1734 }
 1735 
 1736 =head3 EV3P
 1737 
 1738   ######################################################################
 1739   #
 1740   #  New version of EV3 that allows `...` and ``...`` to insert TeX produced
 1741   #  by the new Parser (in math and display modes).
 1742   #
 1743   #  Format:  EV3P(string,...);
 1744   #           EV3P({options},string,...);
 1745   #
 1746   #           `x^2/5` will become \(\frac{x^2}{5}\) and then rendered for hardcopy or screen output
 1747   #
 1748   #  where options can include:
 1749   #
 1750   #    processCommands => 0 or 1     Indicates if the student's answer will
 1751   #                                  be allowed to process \{...\}.
 1752   #                                    Default: 1
 1753   #
 1754   #    processVariables => 0 1       Indicates whether variable substitution
 1755   #                                  should be performed on the student's
 1756   #                                  answer.
 1757   #                                    Default: 1
 1758   #
 1759   #    processMath => 0 or 1         Indicates whether \(...\), \[...\],
 1760   #                                  `...` and ``...`` will be processed
 1761   #                                  in the student's answer.
 1762   #                                    Default: 1
 1763   #
 1764   #    processParser => 0 or 1       Indicates if `...` and ``...`` should
 1765   #                                  be processed when math is being
 1766   #                                  processed.
 1767   #                                    Default: 1
 1768   #
 1769   #    fixDollars => 0 or 1          Specifies whether dollar signs not followed
 1770   #                                  by a letter should be replaced by ${DOLLAR}
 1771   #                                  prior to variable substitution (to prevent
 1772   #                                  accidental substitution of strange Perl
 1773   #                                  values).
 1774   #                                    Default: 1
 1775   #
 1776 
 1777 =cut
 1778 
 1779 sub EV3P {
 1780   my $option_ref = {}; $option_ref = shift if ref($_[0]) eq 'HASH';
 1781   my %options = (
 1782     processCommands => 1,
 1783     processVariables => 1,
 1784     processParser => 1,
 1785     processMath => 1,
 1786     fixDollars => 1,
 1787     %{$option_ref},
 1788   );
 1789   my $string = join(" ",@_);
 1790   $string = ev_substring($string,"\\\\{","\\\\}",\&safe_ev) if $options{processCommands};
 1791   if ($options{processVariables}) {
 1792     my $eval_string = $string;
 1793     $eval_string =~ s/\$(?![a-z\{])/\${DOLLAR}/gi if $options{fixDollars};
 1794     my ($evaluated_string,$PG_eval_errors,$PG_full_errors) =
 1795       PG_restricted_eval("<<END_OF_EVALUATION_STRING\n$eval_string\nEND_OF_EVALUATION_STRING\n");
 1796     if ($PG_eval_errors) {
 1797       my $error = (split("\n",$PG_eval_errors))[0]; $error =~ s/at \(eval.*//gs;
 1798       $string =~ s/&/&amp;/g; $string =~ s/</&lt;/g; $string =~ s/>/&gt;/g;
 1799       $evaluated_string = $BBOLD."(Error: $error in '$string')".$EBOLD;
 1800     }
 1801     $string = $evaluated_string;
 1802   }
 1803   if ($options{processMath}) {
 1804     $string = EV3P_parser($string) if $options{processParser};
 1805     $string = ev_substring($string,"\\(","\\)",\&math_ev3);
 1806     $string = ev_substring($string,"\\[","\\]",\&display_math_ev3);
 1807   }
 1808   return $string;
 1809 }
 1810 
 1811 #
 1812 #  Look through a string for ``...`` or `...` and use
 1813 #  the parser to produce TeX code for the specified mathematics.
 1814 #  ``...`` does display math, `...` does in-line math.  They
 1815 #  can also be used within math mode already, in which case they
 1816 #  use whatever mode is already in effect.
 1817 #
 1818 sub EV3P_parser {
 1819   my $string = shift;
 1820   return $string unless $string =~ m/`/;
 1821   my $start = ''; my %end = ('\('=>'\)','\['=>'\]');
 1822   my @parts = split(/(``.*?``\*?|`.+?`\*?|(?:\\[()\[\]]))/s,$string);
 1823   foreach my $part (@parts) {
 1824     if ($part =~ m/^(``?)(.*)\1(\*?)$/s) {
 1825       my ($delim,$math,$star) = ($1,$2,$3);
 1826       my $f = Parser::Formula($math);
 1827       if (defined($f)) {
 1828         $f = $f->reduce if $star;
 1829   $part = $f->TeX;
 1830   $part = ($delim eq '`' ? '\('.$part.'\)': '\['.$part.'\]') if (!$start);
 1831       } else {
 1832   ## FIXME:  use context->{error}{ref} to highlight error in $math.
 1833   $part = $BBOLD."(Error: $$Value::context->{error}{message} '$math')".$EBOLD;
 1834   $part = $end{$start}." ".$part." ".$start if $start;
 1835       }
 1836     }
 1837     elsif ($start) {$start = '' if $part eq $end{$start}}
 1838     elsif ($end{$part}) {$start = $part}
 1839   }
 1840   return join('',@parts);
 1841 }
 1842 
 1843 
 1844 =head2 Formatting macros
 1845 
 1846   beginproblem()  # generates text listing number and the point value of
 1847                   # the problem. It will also print the file name containing
 1848                   # the problem for users listed in the PRINT_FILE_NAMES_FOR PG_environment
 1849                   # variable.
 1850   OL(@array)      # formats the array as an Ordered List ( <OL> </OL> ) enumerated by letters.
 1851 
 1852   htmlLink($url, $text)
 1853                   # Places a reference to the URL with the specified text in the problem.
 1854                   # A common usage is \{ htmlLink(alias('prob1_help.html') \}, 'for help')
 1855                   # where alias finds the full address of the prob1_help.html file in the same directory
 1856                   # as the problem file
 1857   appletLink( { name => "xFunctions",
 1858                 codebase => '',    # use this to specify the complete url
 1859                                    # otherwise libraries specified in global.conf are searched
 1860                 archive  => 'xFunctions.zip', # name the archive containing code (.jar files go here also)
 1861                 code     => 'xFunctionsLauncher.class',
 1862                 width    => 100,
 1863                 height   => 14,
 1864                 params   => { param1 =>value1, param2 => value2},
 1865               }
 1866             );
 1867   helpLink()     allows site specific help specified in global.conf or course.conf
 1868                  the parameter localHelpURL  must be defined in the environment
 1869                  currently works only for 'interval notation' and 'units'
 1870                  NEEDS REFINEMENT
 1871 
 1872   ########################
 1873                 deprecated coding method
 1874           appletLink  ($url, $parameters)
 1875                   # For example
 1876                   # appletLink(q!  archive="http: //webwork.math.rochester.edu/gage/xFunctions/xFunctions.zip"
 1877                                   code="xFunctionsLauncher.class"  width=100 height=14!,
 1878                   " parameter text goes here")
 1879                   # will link to xFunctions.
 1880 
 1881   low level:
 1882 
 1883   spf($number, $format)   # prints the number with the given format
 1884   sspf($number, $format)  # prints the number with the given format, always including a sign.
 1885   nicestring($coefficients, $terms) # print a linear combinations of terms using coefficients
 1886   nicestring($coefficients) # uses the coefficients to make a polynomial
 1887       # For example
 1888       # nicestring([1,-2, 0]) produces 'x^2-2x'
 1889       # nicestring([2,0,-1],['', 't', 't^2']) produces '2-t^2'
 1890   protect_underbar($string) # protects the underbar (class_name) in strings which may have to pass through TeX.
 1891 
 1892 =cut
 1893 
 1894 sub beginproblem {
 1895   my $out = "";
 1896   my $problemValue = $envir->{problemValue} || 0;
 1897   my $fileName     = $envir->{fileName};
 1898   my $probNum      = $envir->{probNum};
 1899     my $TeXFileName = protect_underbar($envir->{fileName});
 1900     my $l2hFileName = protect_underbar($envir->{fileName});
 1901   my %inlist;
 1902   my $points ='pts';
 1903 
 1904   $points = 'pt' if $problemValue == 1;
 1905   ##    Prepare header for the problem
 1906   grep($inlist{$_}++,@{ $envir->{'PRINT_FILE_NAMES_FOR'} });
 1907   my $effectivePermissionLevel = $envir->{effectivePermissionLevel}; # permission level of user assigned to question
 1908   my $PRINT_FILE_NAMES_PERMISSION_LEVEL = $envir->{'PRINT_FILE_NAMES_PERMISSION_LEVEL'};
 1909   my $studentLogin = $envir->{studentLogin};
 1910   my $print_path_name_flag =
 1911       (defined($effectivePermissionLevel) && defined($PRINT_FILE_NAMES_PERMISSION_LEVEL) && $effectivePermissionLevel >= $PRINT_FILE_NAMES_PERMISSION_LEVEL)
 1912        || ( defined($inlist{ $studentLogin }) and ( $inlist{ $studentLogin }>0 )  ) ;
 1913 
 1914   if ( $print_path_name_flag ) {
 1915     $out = &M3("{\\bf ${probNum}. {\\footnotesize ($problemValue $points) $TeXFileName}}\\newline ",
 1916     " \\begin{rawhtml} ($problemValue $points) <B>$l2hFileName</B><BR>\\end{rawhtml}",
 1917      "($problemValue $points) <B>$fileName</B><BR>"
 1918        ) if ($problemValue ne "");
 1919   } else {
 1920     $out = &M3("{\\bf ${probNum}.} ($problemValue $points) ",
 1921     "($problemValue $points) ",
 1922      "($problemValue $points) "
 1923        ) if ($problemValue ne "");
 1924   }
 1925   $out .= MODES(%{main::PG_restricted_eval(q!$main::problemPreamble!)});
 1926   $out;
 1927 
 1928 }
 1929 
 1930 sub nicestring {
 1931     my($thingy) = shift;
 1932     my(@coefs) = @{$thingy};
 1933     my $n = scalar(@coefs);
 1934     $thingy = shift;
 1935     my(@others);
 1936     if(defined($thingy)) {
 1937   @others = @{$thingy};
 1938     } else {
 1939   my($j);
 1940   for $j (1..($n-2)) {
 1941       $others[$j-1] = "x^".($n-$j);
 1942   }
 1943   if($n>=2) { $others[$n-2] = "x";}
 1944   $others[$n-1] = "";
 1945     }
 1946     my($j, $k)=(0,0);
 1947     while(($k<$n) && ($coefs[$k]==0)) {$k++;}
 1948     if($k==$n) {return("0");}
 1949     my $ans;
 1950     if($coefs[$k]==1) {$ans = ($others[$k]) ? "$others[$k]" : "1";}
 1951     elsif($coefs[$k]== -1) {$ans =  ($others[$k]) ? "- $others[$k]" : "-1"}
 1952     else { $ans = "$coefs[$k] $others[$k]";}
 1953     $k++;
 1954     for $j ($k..($n-1)) {
 1955   if($coefs[$j] != 0) {
 1956       if($coefs[$j] == 1) {
 1957     $ans .= ($others[$j]) ? "+ $others[$j]" : "+ 1";
 1958       } elsif($coefs[$j] == -1) {
 1959     $ans .= ($others[$j]) ? "- $others[$j]" : "-1";
 1960       } else {
 1961     $ans .= "+ $coefs[$j] $others[$j]";
 1962       }
 1963   }
 1964     }
 1965     return($ans);
 1966 }
 1967 
 1968 # kludge to clean up path names
 1969             ## allow underscore character in set and section names and also allows line breaks at /
 1970 sub protect_underbar {
 1971     my $in = shift;
 1972     if ($displayMode eq 'TeX')  {
 1973 
 1974         $in =~ s|_|\\\_|g;
 1975         $in =~ s|/|\\\-/|g;  # allows an optional hyphenation of the path (in tex)
 1976     }
 1977     $in;
 1978 }
 1979 
 1980 
 1981 # An example of a macro which prints out a list (with letters)
 1982 sub OL {
 1983   my(@array) = @_;
 1984   my $i = 0;
 1985   my @alpha = ('A'..'Z', 'AA'..'ZZ');
 1986   my $letter;
 1987   my  $out=   &M3(
 1988           "\\begin{enumerate}\n",
 1989           " \\begin{rawhtml} <OL TYPE=\"A\" VALUE=\"1\"> \\end{rawhtml} ",
 1990           # kludge to fix IE/CSS problem
 1991           #"<OL TYPE=\"A\" VALUE=\"1\">\n"
 1992           "<BLOCKQUOTE>\n"
 1993           ) ;
 1994   my $elem;
 1995   foreach $elem (@array) {
 1996     $letter = shift @alpha;
 1997                 $out .= MODES(
 1998                         TeX=>   "\\item[$ALPHABET[$i].] $elem\n",
 1999                         Latex2HTML=>    " \\begin{rawhtml} <LI> \\end{rawhtml} $elem  ",
 2000                         #HTML=>  "<LI> $elem\n",
 2001                         HTML=>  "<br /> <b>$letter.</b> $elem\n",
 2002                         #HTML_dpng=>     "<LI> $elem <br /> <br /> \n"
 2003                         HTML_dpng=>     "<br /> <b>$letter.</b> $elem \n"
 2004                                         );
 2005     $i++;
 2006   }
 2007   $out .= &M3(
 2008         "\\end{enumerate}\n",
 2009         " \\begin{rawhtml} </OL>\n \\end{rawhtml} ",
 2010         #"</OL>\n"
 2011         "</BLOCKQUOTE>\n"
 2012         ) ;
 2013 }
 2014 
 2015 sub htmlLink {
 2016   my $url = shift;
 2017   my $text = shift;
 2018   my $options = shift;
 2019   $options = "" unless defined($options);
 2020   return "$BBOLD\[ broken link:  $text \] $EBOLD" unless defined($url);
 2021   M3( "{\\bf \\underline{$text}}",
 2022       "\\begin{rawhtml}<A HREF=\"$url\" $options>$text</A>\\end{rawhtml}",
 2023       "<A HREF=\"$url\" $options>$text</A>"
 2024       );
 2025 }
 2026 
 2027 
 2028 sub helpLink {
 2029   my $type1 = shift;
 2030   return "" if(not defined($envir{'localHelpURL'}));
 2031   my $type = lc($type1);
 2032   my %typeHash = (
 2033     'interval notation' => 'IntervalNotation.html',
 2034     'units' => 'Units.html',
 2035     'syntax' => 'Syntax.html',
 2036     );
 2037 
 2038   my $infoRef = $typeHash{$type};
 2039   return htmlLink( $envir{'localHelpURL'}.$infoRef, $type1,
 2040 'target="ww_help" onclick="window.open(this.href,this.target,\'width=550,height=350,scrollbars=yes,resizable=on\'); return false;"');
 2041 }
 2042 
 2043 sub appletLink {
 2044   my $url  = $_[0];
 2045   return oldAppletLink(@_) unless ref($url) ; # handle legacy where applet link completely defined
 2046   # search for applet
 2047   # get fileName of applet
 2048   my $applet       = shift;
 2049   my $options      = shift;
 2050   my $archive      = $applet ->{archive};
 2051   my $codebase     = $applet ->{codebase};
 2052   my $code         = $applet ->{code};
 2053   my $appletHeader = '';
 2054   # find location of applet
 2055     if (defined($codebase) and $codebase =~/\S/) {
 2056       # do nothing
 2057     } elsif(defined($archive) and $archive =~/\S/) {
 2058       $codebase = findAppletCodebase($archive )
 2059     } elsif (defined($code) and $code =~/\S/) {
 2060       $codebase =  findAppletCodebase($code )
 2061     } else {
 2062       warn "Must define the achive (.jar file) or code (.class file) where the applet code is to be found";
 2063       return;
 2064     }
 2065 
 2066   if ( $codebase =~/^Error/) {
 2067     warn $codebase;
 2068     return;
 2069   } else {
 2070      # we are set to include the applet
 2071   }
 2072   $appletHeader  =  qq! archive = "$archive " codebase = "$codebase" !;
 2073   foreach my $key ('name', 'code','width','height', ) {
 2074     if ( defined($applet->{$key})   ) {
 2075       $appletHeader .= qq! $key = "!.$applet->{$key}.q!" ! ;
 2076     } else {
 2077       warn " $key is not defined for applet ".$applet->{name};
 2078       # technically name is not required, but all of the other parameters are
 2079     }
 2080   }
 2081   # add parameters to options
 2082   if (defined($applet->{params}) ) {
 2083     foreach my $key (keys %{ $applet->{params} }) {
 2084       my $value = $applet->{params}->{$key};
 2085       $options .=  qq{<PARAM NAME = "$key" VALUE = "$value" >\n};
 2086     }
 2087 
 2088 
 2089   }
 2090   MODES( TeX        => "{\\bf \\underline{APPLET}  }".$applet->{name},
 2091          Latex2HTML => "\\begin{rawhtml} <APPLET $appletHeader> $options </APPLET>\\end{rawhtml}",
 2092          HTML       => "<APPLET\n $appletHeader> \n $options \n </APPLET>",
 2093          #HTML       => qq!<OBJECT $appletHeader codetype="application/java"> $options </OBJECT>!
 2094   );
 2095 }
 2096 
 2097 sub oldAppletLink {
 2098   my $url = shift;
 2099   my $options = shift;
 2100   $options = "" unless defined($options);
 2101   MODES( TeX        => "{\\bf \\underline{APPLET}  }",
 2102          Latex2HTML => "\\begin{rawhtml} <APPLET $url> $options </APPLET>\\end{rawhtml}",
 2103          HTML       => "<APPLET $url> $options </APPLET>"
 2104       );
 2105 }
 2106 sub spf {
 2107   my($number,$format) = @_;  # attention, the order of format and number are reversed
 2108   $format = "%4.3g" unless $format;   # default value for format
 2109   sprintf($format, $number);
 2110   }
 2111 sub sspf {
 2112   my($number,$format) = @_;  # attention, the order of format and number are reversed
 2113   $format = "%4.3g" unless $format;   # default value for format
 2114   my $sign = $number>=0 ? " + " : " - ";
 2115   $number = $number>=0 ? $number : -$number;
 2116   $sign .sprintf($format, $number);
 2117   }
 2118 
 2119 =head2  Sorting and other list macros
 2120 
 2121 
 2122 
 2123   Usage:
 2124   lex_sort(@list);   # outputs list in lexigraphic (alphabetical) order
 2125   num_sort(@list);   # outputs list in numerical order
 2126   uniq( @list);      # outputs a list with no duplicates.  Order is unspecified.
 2127 
 2128   PGsort( \&sort_subroutine, @list);
 2129   # &sort_subroutine defines order. It's output must be 1 or 0 (true or false)
 2130 
 2131 =cut
 2132 
 2133 #  uniq gives unique elements of a list:
 2134  sub uniq {
 2135    my (@in) =@_;
 2136    my %temp = ();
 2137    while (@in) {
 2138           $temp{shift(@in)}++;
 2139       }
 2140    my @out =  keys %temp;  # sort is causing trouble with Safe.??
 2141    @out;
 2142 }
 2143 
 2144 sub lex_sort {
 2145   PGsort( sub {$_[0] lt $_[1]}, @_);
 2146 }
 2147 sub num_sort {
 2148   PGsort( sub {$_[0] < $_[1]}, @_);
 2149 }
 2150 
 2151 
 2152 =head2 Macros for handling tables
 2153 
 2154   Usage:
 2155   begintable( number_of_columns_in_table)
 2156   row(@dataelements)
 2157   endtable()
 2158 
 2159 Example of useage:
 2160 
 2161   BEGIN_TEXT
 2162     This problem tests calculating new functions from old ones:$BR
 2163     From the table below calculate the quantities asked for:$BR
 2164     \{begintable(scalar(@firstrow)+1)\}
 2165     \{row(" \(x\) ",@firstrow)\}
 2166     \{row(" \(f(x)\) ", @secondrow)\}
 2167     \{row(" \(g(x)\) ", @thirdrow)\}
 2168     \{row(" \(f'(x)\) ", @fourthrow)\}
 2169     \{row(" \(g'(x)\) ", @fifthrow)\}
 2170     \{endtable()\}
 2171 
 2172    (The arrays contain numbers which are placed in the table.)
 2173 
 2174   END_TEXT
 2175 
 2176 =cut
 2177 
 2178 sub begintable {
 2179   my ($number)=shift;   #number of columns in table
 2180   my %options = @_;
 2181   warn "begintable(cols) requires a number indicating the number of columns" unless defined($number);
 2182   my $out = "";
 2183   if ($displayMode eq 'TeX') {
 2184     $out .= "\n\\par\\smallskip\\begin{center}\\begin{tabular}{"  .  "|c" x $number .  "|} \\hline\n";
 2185     }
 2186   elsif ($displayMode eq 'Latex2HTML') {
 2187     $out .= "\n\\begin{rawhtml} <TABLE , BORDER=1>\n\\end{rawhtml}";
 2188     }
 2189   elsif ($displayMode eq 'HTML_MathJax'
 2190    || $displayMode eq 'HTML_dpng'
 2191    || $displayMode eq 'HTML'
 2192    || $displayMode eq 'HTML_tth'
 2193    || $displayMode eq 'HTML_jsMath'
 2194    || $displayMode eq 'HTML_asciimath'
 2195    || $displayMode eq 'HTML_LaTeXMathML'
 2196    || $displayMode eq 'HTML_img') {
 2197     $out .= "<TABLE BORDER=1>\n"
 2198   }
 2199   else {
 2200     $out = "Error: PGbasicmacros: begintable: Unknown displayMode: $displayMode.\n";
 2201     }
 2202   $out;
 2203   }
 2204 
 2205 sub endtable {
 2206   my $out = "";
 2207   if ($displayMode eq 'TeX') {
 2208     $out .= "\n\\end {tabular}\\end{center}\\par\\smallskip\n";
 2209     }
 2210   elsif ($displayMode eq 'Latex2HTML') {
 2211     $out .= "\n\\begin{rawhtml} </TABLE >\n\\end{rawhtml}";
 2212     }
 2213   elsif ($displayMode eq 'HTML_MathJax'
 2214    || $displayMode eq 'HTML_dpng'
 2215    || $displayMode eq 'HTML'
 2216    || $displayMode eq 'HTML_tth'
 2217    || $displayMode eq 'HTML_jsMath'
 2218    || $displayMode eq 'HTML_asciimath'
 2219    || $displayMode eq 'HTML_LaTeXMathML'
 2220    || $displayMode eq 'HTML_img') {
 2221     $out .= "</TABLE>\n";
 2222     }
 2223   else {
 2224     $out = "Error: PGbasicmacros: endtable: Unknown displayMode: $displayMode.\n";
 2225     }
 2226   $out;
 2227 }
 2228 
 2229 
 2230 sub row {
 2231   my @elements = @_;
 2232   my $out = "";
 2233   if ($displayMode eq 'TeX') {
 2234     while (@elements) {
 2235       $out .= shift(@elements) . " &";
 2236       }
 2237      chop($out); # remove last &
 2238      $out .= "\\\\ \\hline \n";
 2239      # carriage returns must be added manually for tex
 2240     }
 2241   elsif ($displayMode eq 'Latex2HTML') {
 2242     $out .= "\n\\begin{rawhtml}\n<TR>\n\\end{rawhtml}\n";
 2243     while (@elements) {
 2244       $out .= " \n\\begin{rawhtml}\n<TD> \n\\end{rawhtml}\n" . shift(@elements) . " \n\\begin{rawhtml}\n</TD> \n\\end{rawhtml}\n";
 2245       }
 2246     $out .= " \n\\begin{rawhtml}\n</TR> \n\\end{rawhtml}\n";
 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 .= "<TR>\n";
 2257     while (@elements) {
 2258       $out .= "<TD>" . shift(@elements) . "</TD>";
 2259       }
 2260     $out .= "\n</TR>\n";
 2261   }
 2262   else {
 2263     $out = "Error: PGbasicmacros: row: Unknown displayMode: $displayMode.\n";
 2264     }
 2265   $out;
 2266 }
 2267 
 2268 =head2 Macros for displaying static images
 2269 
 2270   Usage:
 2271   $string = image($image, width => 100, height => 100, tex_size => 800)
 2272   $string = image($image, width => 100, height => 100, extra_html_tags => 'align="middle"', tex_size => 800)
 2273   $string = image([$image1, $image2], width => 100, height => 100, tex_size => 800)
 2274   $string = caption($string);
 2275   $string = imageRow([$image1, $image2 ], [$caption1, $caption2]);
 2276            # produces a complete table with rows of pictures.
 2277 
 2278 
 2279 =cut
 2280 
 2281 #   More advanced macros
 2282 sub image {
 2283   my $image_ref  = shift;
 2284   my @opt = @_;
 2285   unless (scalar(@opt) % 2 == 0 ) {
 2286     warn "ERROR in image macro.  A list of macros must be inclosed in square brackets.";
 2287   }
 2288   my %in_options = @opt;
 2289   my %known_options = (
 2290     width    => 100,
 2291     height   => 100,
 2292     tex_size => 800,
 2293     extra_html_tags => '',
 2294   );
 2295   # handle options
 2296   my %out_options = %known_options;
 2297   foreach my $opt_name (keys %in_options) {
 2298     if ( exists( $known_options{$opt_name} ) ) {
 2299       $out_options{$opt_name} = $in_options{$opt_name} if exists( $in_options{$opt_name} ) ;
 2300     } else {
 2301       die "Option $opt_name not defined for image. " .
 2302           "Default options are:<BR> ", display_options2(%known_options);
 2303     }
 2304   }
 2305   my $width       = $out_options{width};
 2306   my $height      = $out_options{height};
 2307   my $tex_size    = $out_options{tex_size};
 2308   my $width_ratio = $tex_size*(.001);
 2309   my @image_list  = ();
 2310 
 2311   if (ref($image_ref) =~ /ARRAY/ ) {
 2312     @image_list = @{$image_ref};
 2313   } else {
 2314     push(@image_list,$image_ref);
 2315   }
 2316 
 2317   my @output_list = ();
 2318     while(@image_list) {
 2319     my $imageURL = alias(shift @image_list);
 2320     my $out="";
 2321 
 2322     if ($displayMode eq 'TeX') {
 2323       my $imagePath = $imageURL; # in TeX mode, alias gives us a path, not a URL
 2324       if (defined $envir->{texDisposition} and $envir->{texDisposition} eq "pdf") {
 2325         # We're going to create PDF files with our TeX (using pdflatex), so
 2326         # alias should have given us the path to a PNG image. What we need
 2327         # to do is find out the dimmensions of this image, since pdflatex
 2328         # is too dumb to live.
 2329 
 2330         #my ($height, $width) = getImageDimmensions($imagePath);
 2331         ##warn "&image: $imagePath $height $width\n";
 2332         #unless ($height and $width) {
 2333         # warn "Couldn't get the dimmensions of image $imagePath.\n"
 2334         #}
 2335         #$out = "\\includegraphics[bb=0 0 $height $width,width=$width_ratio\\linewidth]{$imagePath}\n";
 2336         $out = "\\includegraphics[width=$width_ratio\\linewidth]{$imagePath}\n";
 2337       } else {
 2338         # Since we're not creating PDF files, alias should have given us the
 2339         # path to an EPS file. latex can get its dimmensions no problem!
 2340 
 2341         $out = "\\includegraphics[width=$width_ratio\\linewidth]{$imagePath}\n";
 2342       }
 2343     } elsif ($displayMode eq 'Latex2HTML') {
 2344       my $wid = ($envir->{onTheFlyImageSize} || 0)+ 30;
 2345       $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
 2346       \\end{rawhtml}\n !
 2347     } elsif ($displayMode eq 'HTML_MathJax'
 2348    || $displayMode eq 'HTML_dpng'
 2349    || $displayMode eq 'HTML'
 2350    || $displayMode eq 'HTML_tth'
 2351    || $displayMode eq 'HTML_jsMath'
 2352    || $displayMode eq 'HTML_asciimath'
 2353    || $displayMode eq 'HTML_LaTeXMathML'
 2354    || $displayMode eq 'HTML_img') {
 2355       my $wid = ($envir->{onTheFlyImageSize} || 0) +30;
 2356       $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>
 2357       !
 2358     } else {
 2359       $out = "Error: PGbasicmacros: image: Unknown displayMode: $displayMode.\n";
 2360     }
 2361     push(@output_list, $out);
 2362   }
 2363   return wantarray ? @output_list : $output_list[0];
 2364 }
 2365 
 2366 # This is legacy code.
 2367 sub images {
 2368   my @in = @_;
 2369   my @outlist = ();
 2370   while (@in) {
 2371      push(@outlist,&image( shift(@in) ) );
 2372    }
 2373   @outlist;
 2374 }
 2375 
 2376 
 2377 sub caption {
 2378   my ($out) = @_;
 2379   $out = " $out \n" if $displayMode eq 'TeX';
 2380   $out = " $out  " if $displayMode eq 'HTML';
 2381   $out = " $out  " if $displayMode eq 'HTML_tth';
 2382   $out = " $out  " if $displayMode eq 'HTML_dpng';
 2383   $out = " $out  " if $displayMode eq 'HTML_img';
 2384   $out = " $out  " if $displayMode eq 'HTML_jsMath';
 2385   $out = " $out  " if $displayMode eq 'HTML_asciimath';
 2386   $out = " $out  " if $displayMode eq 'HTML_LaTeXMathML';
 2387   $out = " $out  " if $displayMode eq 'Latex2HTML';
 2388     $out;
 2389 }
 2390 
 2391 sub captions {
 2392   my @in = @_;
 2393   my @outlist = ();
 2394   while (@in) {
 2395      push(@outlist,&caption( shift(@in) ) );
 2396   }
 2397   @outlist;
 2398 }
 2399 
 2400 sub imageRow {
 2401 
 2402   my $pImages = shift;
 2403   my $pCaptions=shift;
 2404   my $out = "";
 2405   my @images = @$pImages;
 2406   my @captions = @$pCaptions;
 2407   my $number = @images;
 2408   # standard options
 2409   my %options = ( 'tex_size' => 200,  # width for fitting 4 across
 2410                   'height' => 100,
 2411                   'width' => 100,
 2412                   @_            # overwrite any default options
 2413                 );
 2414 
 2415   if ($displayMode eq 'TeX') {
 2416     $out .= "\n\\par\\smallskip\\begin{center}\\begin{tabular}{"  .  "|c" x $number .  "|} \\hline\n";
 2417     while (@images) {
 2418       $out .= &image( shift(@images),%options ) . '&';
 2419     }
 2420     chop($out);
 2421     $out .= "\\\\ \\hline \n";
 2422     while (@captions) {
 2423       $out .= &caption( shift(@captions) ) . '&';
 2424     }
 2425     chop($out);
 2426     $out .= "\\\\ \\hline \n\\end {tabular}\\end{center}\\par\\smallskip\n";
 2427   } elsif ($displayMode eq 'Latex2HTML'){
 2428 
 2429     $out .= "\n\\begin{rawhtml} <TABLE  BORDER=1><TR>\n\\end{rawhtml}\n";
 2430     while (@images) {
 2431       $out .= "\n\\begin{rawhtml} <TD>\n\\end{rawhtml}\n" . &image( shift(@images),%options )
 2432               . "\n\\begin{rawhtml} </TD>\n\\end{rawhtml}\n" ;
 2433     }
 2434 
 2435     $out .= "\n\\begin{rawhtml}</TR><TR>\\end{rawhtml}\n";
 2436     while (@captions) {
 2437       $out .= "\n\\begin{rawhtml} <TH>\n\\end{rawhtml}\n".&caption( shift(@captions) )
 2438               . "\n\\begin{rawhtml} </TH>\n\\end{rawhtml}\n" ;
 2439     }
 2440 
 2441     $out .= "\n\\begin{rawhtml} </TR> </TABLE >\n\\end{rawhtml}";
 2442   } elsif ($displayMode eq 'HTML_MathJax'
 2443    || $displayMode eq 'HTML_dpng'
 2444    || $displayMode eq 'HTML'
 2445    || $displayMode eq 'HTML_tth'
 2446    || $displayMode eq 'HTML_jsMath'
 2447    || $displayMode eq 'HTML_asciimath'
 2448    || $displayMode eq 'HTML_LaTeXMathML'
 2449    || $displayMode eq 'HTML_img') {
 2450     $out .= "<P>\n <TABLE BORDER=2 CELLPADDING=3 CELLSPACING=2 ><TR ALIGN=CENTER    VALIGN=MIDDLE>\n";
 2451     while (@images) {
 2452       $out .= " \n<TD>". &image( shift(@images),%options ) ."</TD>";
 2453     }
 2454     $out .= "</TR>\n<TR>";
 2455     while (@captions) {
 2456       $out .= " <TH>". &caption( shift(@captions) ) ."</TH>";
 2457     }
 2458     $out .= "\n</TR></TABLE></P>\n"
 2459   }
 2460   else {
 2461     $out = "Error: PGbasicmacros: imageRow: Unknown languageMode: $displayMode.\n";
 2462     warn $out;
 2463   }
 2464   $out;
 2465 }
 2466 
 2467 
 2468 ###########
 2469 # Auxiliary macros
 2470 
 2471 sub display_options2{
 2472   my %options = @_;
 2473   my $out_string = "";
 2474   foreach my $key (keys %options) {
 2475     $out_string .= " $key => $options{$key},<BR>";
 2476   }
 2477   $out_string;
 2478 }
 2479 
 2480 
 2481 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9