[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 6851 - (download) (as text) (annotate)
Sat Jun 11 17:17:39 2011 UTC (8 years, 6 months ago) by gage
File size: 83490 byte(s)
?	added some warning messages to Course Admin if permissions on DATA, log and html directories are not set correctly.
?	added refreshEquations(1) to PG to force all equation images to be recalculated.

?added AddToTexPreamble($str ) to PG  to allow short macro definitions such as    \newcommand{\myVec}[#1]{\vec{#1}}
	?	this works in images mode and in hardcopy mode.  It does not work in jsMath mode (but fails gracefully).  MathJax also fails, not quite so gracefully.


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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9