[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 6248 - (download) (as text) (annotate)
Fri May 14 01:17:21 2010 UTC (9 years, 6 months ago) by gage
File size: 82393 byte(s)
major update which adds objective methods to the basic code of PG.
HEAD should be considered more beta than usual for a few days until minor glitches
are shaken out.
new modules needed:

PGcore PGalias PGresource PGloadfiles PGanswergroup PGresponsegroup  Tie::IxHash

    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.64 2010/03/20 00:53:25 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   DEBUG_MESSAGE( "RECORD_ANS_NAME($name, $answer_value)");
  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);
  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' or $displayMode eq 'HTML_tth' or
  833             $displayMode eq 'HTML_dpng' or $displayMode eq 'HTML_img' or $displayMode eq 'HTML_jsMath' or
  834       $displayMode eq 'HTML_asciimath' or $displayMode eq 'HTML_LaTeXMathML') {
  835     $out = qq!<SELECT NAME = "$name" id="$name" SIZE=1> \n!;
  836     my $i;
  837     foreach ($i=0; $i< @list; $i=$i+2) {
  838       my $select_flag = ($list[$i] eq $answer_value) ? "SELECTED" : "";
  839       $out .= qq!<OPTION $select_flag VALUE ="$list[$i]" > $list[$i+1]  </OPTION>\n!;
  840     };
  841     $out .= " </SELECT>\n";
  842   } elsif ( $displayMode eq "Latex2HTML") {
  843     $out = qq! \\begin{rawhtml}<SELECT NAME = "$name" id="$name" SIZE=1> \\end{rawhtml} \n !;
  844     my $i;
  845     foreach ($i=0; $i< @list; $i=$i+2) {
  846       my $select_flag = ($list[$i] eq $answer_value) ? "SELECTED" : "";
  847       $out .= qq!\\begin{rawhtml}<OPTION $select_flag VALUE ="$list[$i]" > $list[$i+1]  </OPTION>\\end{rawhtml}\n!;
  848     };
  849     $out .= " \\begin{rawhtml}</SELECT>\\end{rawhtml}\n";
  850   } elsif ( $displayMode eq "TeX") {
  851       $out .= "\\fbox{?}";
  852   }
  853   $name = RECORD_ANS_NAME($name,$answer_value);   # record answer name
  854   $out;
  855 }
  856 
  857 sub pop_up_list {
  858   my @list = @_;
  859   my $name = NEW_ANS_NAME();  # get new answer name
  860   NAMED_POP_UP_LIST($name, @list);
  861 }
  862 
  863 
  864 
  865 =head5  answer_matrix
  866 
  867     Usage   \[ \{   answer_matrix(rows,columns,width_of_ans_rule, @options) \} \]
  868 
  869     Creates an array of answer blanks and passes it to display_matrix which returns
  870     text which represents the matrix in TeX format used in math display mode. Answers
  871     are then passed back to whatever answer evaluators you write at the end of the problem.
  872     (note, if you have an m x n matrix, you will need mn answer evaluators, and they will be
  873     returned to the evaluaters starting in the top left hand corner and proceed to the left
  874     and then at the end moving down one row, just as you would read them.)
  875 
  876     The options are passed on to display_matrix.
  877 
  878 
  879 =cut
  880 
  881 
  882 sub answer_matrix{
  883   my $m = shift;
  884   my $n = shift;
  885   my $width = shift;
  886   my @options = @_;
  887   my @array=();
  888   for( my $i = 0; $i < $m; $i+=1)
  889   {
  890     my @row_array = ();
  891 
  892     for( my $i = 0; $i < $n; $i+=1)
  893     {
  894       push @row_array,  ans_rule($width);
  895     }
  896     my $r_row_array = \@row_array;
  897     push @array,  $r_row_array;
  898   }
  899   # display_matrix hasn't been loaded into the cache safe compartment
  900   # so we need to refer to the subroutine in this way to make
  901   # sure that main is defined correctly.
  902   my $ra_local_display_matrix=PG_restricted_eval(q!\&main::display_matrix!);
  903   &$ra_local_display_matrix( \@array, @options );
  904 
  905 }
  906 
  907 sub NAMED_ANS_ARRAY_EXTENSION{
  908 
  909   my $name = shift;
  910   my $col = shift;
  911   my %options = @_;
  912   $col = 20 unless $col;
  913   my $answer_value = '';
  914 
  915   $answer_value = ${$inputs_ref}{$name} if    defined(${$inputs_ref}{$name});
  916   if ($answer_value =~ /\0/ ) {
  917     my @answers = split("\0", $answer_value);
  918     $answer_value = shift(@answers);
  919     $answer_value= '' unless defined($answer_value);
  920   } elsif (ref($answer_value) eq 'ARRAY') {
  921     my @answers = @{ $answer_value};
  922       $answer_value = shift(@answers);
  923         $answer_value= '' unless defined($answer_value);
  924   }
  925 
  926   $answer_value =~ tr/\\$@`//d;   #`## make sure student answers can not be interpolated by e.g. EV3
  927   warn "ans_label $options{ans_label} $name $answer_value";
  928   if (defined($options{ans_label}) ) {
  929     INSERT_RESPONSE($options{ans_label}, $name, $answer_value);
  930   }
  931   MODES(
  932     TeX => "\\mbox{\\parbox[t]{10pt}{\\hrulefill}}\\hrulefill\\quad ",
  933     Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=TEXT SIZE=$col NAME="$name" id="$name" VALUE = "">\n\\end{rawhtml}\n!,
  934     HTML => qq!<INPUT TYPE=TEXT SIZE=$col NAME="$name" id="$name" VALUE = "$answer_value">\n!
  935   );
  936 }
  937 
  938 sub ans_array{
  939   my $m = shift;
  940   my $n = shift;
  941   my $col = shift;
  942   $col = 20 unless $col;
  943   my $ans_label = NEW_ANS_NAME();
  944   my $num = ans_rule_count();
  945   my @options = @_;
  946   my @array=();
  947   my $answer_value = "";
  948     my @response_list = ();
  949     my $name;
  950     $main::vecnum = -1;
  951     CLEAR_RESPONSES($ans_label);
  952 
  953 
  954   for( my $i = 0; $i < $n; $i+=1)
  955   {
  956     $name = NEW_ANS_ARRAY_NAME_EXTENSION($num,0,$i);
  957     $array[0][$i] =   NAMED_ANS_ARRAY_EXTENSION($name,$col,ans_label=>$ans_label);
  958 
  959   }
  960 
  961   for( my $j = 1; $j < $m; $j+=1 ){
  962 
  963     for( my $i = 0; $i < $n; $i+=1)
  964     {
  965       $name = NEW_ANS_ARRAY_NAME_EXTENSION($num,$j,$i);
  966       $array[$j][$i] =  NAMED_ANS_ARRAY_EXTENSION($name,$col, ans_label=>$ans_label);
  967     }
  968 
  969   }
  970   my $ra_local_display_matrix=PG_restricted_eval(q!\&main::display_matrix!);
  971   &$ra_local_display_matrix( \@array, @options );
  972 
  973 }
  974 
  975 sub ans_array_extension{
  976   my $m = shift;
  977   my $n = shift;
  978   my $col = shift;
  979   $col = 20 unless $col;
  980   my $num = ans_rule_count(); #hack -- ans_rule_count is updated after being used
  981   my @options = @_;
  982   my @response_list = ();
  983   my $name;
  984   my @array=();
  985     my $ans_label = $main::PG->new_label($num);
  986   for( my $j = 0; $j < $m; $j+=1 ){
  987 
  988     for( my $i = 0; $i < $n; $i+=1)
  989     {
  990       $name = NEW_ANS_ARRAY_NAME_EXTENSION($num,$j,$i);
  991       $array[$j][$i] =  NAMED_ANS_ARRAY_EXTENSION($name,$col, ans_label=>$ans_label);
  992 
  993     }
  994 
  995   }
  996   my $ra_local_display_matrix=PG_restricted_eval(q!\&main::display_matrix!);
  997   &$ra_local_display_matrix( \@array, @options );
  998 
  999 }
 1000 
 1001 
 1002 # end answer blank macros
 1003 
 1004 =head2 Hints and solutions macros
 1005 
 1006   solution('text','text2',...);
 1007   SOLUTION('text','text2',...);   # equivalent to TEXT(solution(...));
 1008 
 1009   hint('text', 'text2', ...);
 1010   HINT('text', 'text2',...);      # equivalent to TEXT("$BR$HINT" . hint(@_) . "$BR") if hint(@_);
 1011 
 1012 Solution prints its concatenated input when the check box named 'ShowSol' is set and
 1013 the time is after the answer date.  The check box 'ShowSol' is visible only after the
 1014 answer date or when the problem is viewed by a professor.
 1015 
 1016 $main::envir{'displaySolutionsQ'} is set to 1 when a solution is to be displayed.
 1017 
 1018 Hints are shown only after the number of attempts is greater than $:showHint
 1019 ($main::showHint defaults to 1) and the check box named 'ShowHint' is set. The check box
 1020 'ShowHint' is visible only after the number of attempts is greater than $main::showHint.
 1021 
 1022 $main::envir{'displayHintsQ'} is set to 1 when a hint is to be displayed.
 1023 
 1024 
 1025 =cut
 1026 
 1027 
 1028 
 1029 #   solution prints its input when $displaySolutionsQ is set.
 1030 #   use as TEXT(solution("blah, blah");
 1031 #   \$solutionExists
 1032 #   is passed to processProblem which displays a "show Solution" button
 1033 #   when a solution is available for viewing
 1034 
 1035 
 1036 sub solution {
 1037   my @in = @_;
 1038   my $out = '';
 1039   PG_restricted_eval(q!$main::solutionExists =1!);
 1040   if (PG_restricted_eval(q!$main::envir{'displaySolutionsQ'}!)) {$out = join(' ',@in);}
 1041     $out;
 1042 }
 1043 
 1044 
 1045 sub SOLUTION {
 1046   TEXT( solution(@_)) ;
 1047 }
 1048 
 1049 
 1050 sub hint {
 1051     my @in = @_;
 1052   my $out = '';
 1053   my $permissionLevel = PG_restricted_eval(q!$main::envir{permissionLevel}!); #user permission level
 1054   my $PRINT_FILE_NAMES_PERMISSION_LEVEL = (PG_restricted_eval(q!defined( $main::envir{'PRINT_FILE_NAMES_PERMISSION_LEVEL'} )!))?
 1055              PG_restricted_eval(q!$main::envir{'PRINT_FILE_NAMES_PERMISSION_LEVEL'}!) : 10000; # protect against undefined values
 1056     my $printHintForInstructor = $permissionLevel >= $PRINT_FILE_NAMES_PERMISSION_LEVEL;
 1057     my $showHint = PG_restricted_eval(q!$main::showHint!);
 1058     my $displayHint = PG_restricted_eval(q!$main::envir{'displayHintsQ'}!);
 1059   PG_restricted_eval(q!$main::hintExists =1!);
 1060     PG_restricted_eval(q!$main::numOfAttempts = 0 unless defined($main::numOfAttempts);!);
 1061     my $attempts = PG_restricted_eval(q!$main::numOfAttempts!);
 1062 
 1063   if ($displayMode eq 'TeX')   {
 1064       if ($printHintForInstructor) {
 1065         $out = join(' ', "$BR(Show the student hint after $showHint attempts: ) $BR",@in);
 1066     } else  {
 1067       $out = '';  # do nothing since hints are not available for download for students
 1068     }
 1069   } elsif ($printHintForInstructor) {  # always print hints for instructor types
 1070     $out = join(' ', "$BR( Show the student hint after $showHint attempts. The current number of attempts is $attempts. )$BR $BBOLD HINT: $EBOLD ", @in);
 1071   } elsif ( $displayHint  and ( $attempts > $showHint ))  {
 1072 
 1073    ## the second test above prevents a hint being shown if a doctored form is submitted
 1074 
 1075     $out = join(' ',@in);
 1076   }    # show hint
 1077 
 1078   $out ;
 1079 }
 1080 
 1081 
 1082 sub HINT {
 1083     TEXT("$BR" . hint(@_) . "$BR") if hint(@_);
 1084 }
 1085 
 1086 
 1087 
 1088 # End hints and solutions macros
 1089 #################################
 1090 
 1091 =head2 Comments to instructors
 1092 
 1093   COMMENT('text','text2',...);
 1094 
 1095 Takes the text to be lines of a comment to be shown only
 1096 in the Library Browser below the rendered problem.
 1097 
 1098 The function COMMENT stores the needed html in the variable
 1099 pgComment, which gets transfered to the flag 'comment' in PG_FLAGS.
 1100 
 1101 =cut
 1102 
 1103 # Add a comment which will display in the Library browser
 1104 #  Currently, the only output is html
 1105 
 1106 sub COMMENT {
 1107     my @in = @_;
 1108   my $out = join("$BR", @in);
 1109   $out = '<div class=\"AuthorComment\">'.$out.'</div>';
 1110   PG_restricted_eval(q!$main::pgComment = "!.$out.q!"!);
 1111   return('');
 1112 }
 1113 
 1114 #################################
 1115 # Produces a random number between $begin and $end with increment 1.
 1116 # You do not have to worry about integer or floating point types.
 1117 
 1118 =head2 Pseudo-random number generator
 1119 
 1120   Usage:
 1121   random(0,5,.1)      # produces a random number between 0 and 5 in increments of .1
 1122   non_zero_random(0,5,.1) # gives a non-zero random number
 1123 
 1124   list_random(2,3,5,6,7,8,10) # produces random value from the list
 1125   list_random(2,3, (5..8),10) # does the same thing
 1126 
 1127   SRAND(seed)     # resets the main random generator -- use very cautiously
 1128 
 1129 
 1130 SRAND(time) will create a different problem everytime it is called.  This makes it difficult
 1131 to check the answers :-).
 1132 
 1133 SRAND($envir->{'inputs_ref'}->{'key'} ) will create a different problem for each login session.
 1134 This is probably what is desired.
 1135 
 1136 =cut
 1137 
 1138 
 1139 sub random  {
 1140   my ($begin, $end, $incr) = @_;
 1141   $PG_random_generator->random($begin,$end,$incr);
 1142 }
 1143 
 1144 
 1145 sub non_zero_random { ##gives a non-zero random number
 1146   my (@arguments)=@_;
 1147   my $a=0;
 1148   my $i=100; #safety counter
 1149   while ($a==0 && ( 0 < $i-- ) ) {
 1150     $a=random(@arguments);
 1151   }
 1152   $a;
 1153 }
 1154 
 1155 sub list_random {
 1156         my(@li) = @_;
 1157         return $li[random(1,scalar(@li))-1];
 1158 }
 1159 
 1160 sub SRAND { # resets the main random generator -- use cautiously
 1161     my $seed = shift;
 1162   $PG_random_generator -> srand($seed);
 1163 }
 1164 
 1165 # display macros
 1166 
 1167 =head2 Display Macros
 1168 
 1169 These macros produce different output depending on the display mode being used to show
 1170 the problem on the screen, or whether the problem is being converted to TeX to produce
 1171 a hard copy output.
 1172 
 1173   MODES   ( TeX =>        "Output this in TeX mode",
 1174             HTML =>       "output this in HTML mode",
 1175             HTML_tth =>   "output this in HTML_tth mode",
 1176             HTML_dpng =>   "output this in HTML_dpng mode",
 1177             Latex2HTML => "output this in Latex2HTML mode",
 1178            )
 1179 
 1180   TEX     (tex_version, html_version) #obsolete
 1181 
 1182   M3      (tex_version, latex2html_version, html_version) #obsolete
 1183 
 1184 
 1185 
 1186 =cut
 1187 
 1188 
 1189 sub TEX {
 1190   my ($tex, $html ) = @_;
 1191   MODES(TeX => $tex, HTML => $html, HTML_tth => $html, HTML_dpng => $html);
 1192 }
 1193 
 1194 
 1195 sub M3 {
 1196   my($tex,$l2h,$html) = @_;
 1197   MODES(TeX => $tex, Latex2HTML => $l2h, HTML => $html, HTML_tth => $html, HTML_dpng => $html);
 1198 }
 1199 
 1200 # MODES() is now table driven
 1201 our %DISPLAY_MODE_FAILOVER = (
 1202   TeX              => [],
 1203   HTML             => [],
 1204   HTML_tth         => [ "HTML", ],
 1205   HTML_dpng        => [ "HTML_tth", "HTML", ],
 1206   HTML_jsMath      => [ "HTML_dpng", "HTML_tth", "HTML", ],
 1207   HTML_asciimath   => [ "HTML_dpng", "HTML_tth", "HTML", ],
 1208   HTML_LaTeXMathML => [ "HTML_dpng", "HTML_tth", "HTML", ],
 1209   # legacy modes -- these are not supported, but some problems might try to
 1210   # set the display mode to one of these values manually and some macros may
 1211   # provide rendered versions for these modes but not the one we want.
 1212   Latex2HTML  => [ "TeX", "HTML", ],
 1213   HTML_img    => [ "HTML_dpng", "HTML_tth", "HTML", ],
 1214 );
 1215 
 1216 # This replaces M3.  You can add new modes at will to this one.
 1217 sub MODES {
 1218   my %options = @_;
 1219 
 1220   # is a string supplied for the current display mode? if so, return it
 1221   return $options{$main::displayMode} if defined $options{$main::displayMode};
 1222 
 1223   # otherwise, fail over to backup modes
 1224   my @backup_modes;
 1225   if (exists $DISPLAY_MODE_FAILOVER{$main::displayMode}) {
 1226     @backup_modes = @{$DISPLAY_MODE_FAILOVER{$main::displayMode}};
 1227     foreach my $mode (@backup_modes) {
 1228       return $options{$mode} if defined $options{$mode};
 1229     }
 1230   }
 1231   die "ERROR in defining MODES: neither display mode '$main::displayMode' nor",
 1232     " any fallback modes (", join(", ", @backup_modes), ") supplied.";
 1233 }
 1234 
 1235 # end display macros
 1236 
 1237 
 1238 =head2  Display constants
 1239 
 1240   @ALPHABET       ALPHABET()      capital letter alphabet -- ALPHABET[0] = 'A'
 1241   $PAR        PAR()       paragraph character (\par or <p>)
 1242   $BR             BR()        line break character
 1243   $LQ         LQ()        left double quote
 1244   $RQ         RQ()        right double quote
 1245   $BM         BM()        begin math
 1246   $EM         EM()        end math
 1247   $BDM        BDM()       begin display math
 1248   $EDM        EDM()       end display math
 1249   $LTS        LTS()       strictly less than
 1250   $GTS        GTS()       strictly greater than
 1251   $LTE        LTE()       less than or equal
 1252   $GTE        GTE()       greater than or equal
 1253   $BEGIN_ONE_COLUMN BEGIN_ONE_COLUMN()  begin one-column mode
 1254   $END_ONE_COLUMN   END_ONE_COLUMN()  end one-column mode
 1255   $SOL        SOLUTION_HEADING()  solution headline
 1256   $SOLUTION     SOLUTION_HEADING()  solution headline
 1257   $HINT       HINT_HEADING()    hint headline
 1258   $US         US()        underscore character
 1259   $SPACE        SPACE()       space character (tex and latex only)
 1260   $BBOLD        BBOLD()       begin bold typeface
 1261   $EBOLD        EBOLD()       end bold typeface
 1262   $BITALIC        BITALIC()       begin italic typeface
 1263   $EITALIC        EITALIC()       end italic typeface
 1264   $BUL          BUL()         begin underlined type
 1265   $EUL          EUL()         end underlined type
 1266   $BCENTER        BCENTER()       begin centered environment
 1267   $ECENTER        ECENTER()       end centered environment
 1268   $HR         HR()        horizontal rule
 1269   $LBRACE       LBRACE()      left brace
 1270   $LB         LB ()       left brace
 1271   $RBRACE       RBRACE()      right brace
 1272   $RB         RB ()       right brace
 1273   $DOLLAR       DOLLAR()      a dollar sign
 1274   $PERCENT      PERCENT()     a percent sign
 1275   $CARET        CARET()       a caret sign
 1276   $PI         PI()        the number pi
 1277   $E          E()         the number e
 1278 
 1279 =cut
 1280 
 1281 
 1282 
 1283 
 1284 
 1285 # A utility variable.  Notice that "B"=$ALPHABET[1] and
 1286 # "ABCD"=@ALPHABET[0..3].
 1287 
 1288 sub ALPHABET  {
 1289   ('A'..'ZZ')[@_];
 1290 }
 1291 
 1292 ###############################################################
 1293 # Some constants which are different in tex and in HTML
 1294 # The order of arguments is TeX, Latex2HTML, HTML
 1295 # Adopted Davide Cervone's improvements to PAR, LTS, GTS, LTE, GTE, LBRACE, RBRACE, LB, RB. 7-14-03 AKP
 1296 sub PAR { MODES( TeX => '\\par ', Latex2HTML => '\\begin{rawhtml}<P>\\end{rawhtml}', HTML => '<P>'); };
 1297 #sub BR { MODES( TeX => '\\par\\noindent ', Latex2HTML => '\\begin{rawhtml}<BR>\\end{rawhtml}', HTML => '<BR>'); };
 1298 # Alternate definition of BR which is slightly more flexible and gives more white space in printed output
 1299 # which looks better but kills more trees.
 1300 sub BR { MODES( TeX => '\\leavevmode\\\\\\relax ', Latex2HTML => '\\begin{rawhtml}<BR>\\end{rawhtml}', HTML => '<BR/>'); };
 1301 sub LQ { MODES( TeX => "\\lq\\lq{}", Latex2HTML =>   '"',  HTML =>  '&quot;' ); };
 1302 sub RQ { MODES( TeX => "\\rq\\rq{}", Latex2HTML =>   '"',   HTML =>  '&quot;' ); };
 1303 sub BM { MODES(TeX => '\\(', Latex2HTML => '\\(', HTML =>  ''); };  # begin math mode
 1304 sub EM { MODES(TeX => '\\)', Latex2HTML => '\\)', HTML => ''); };  # end math mode
 1305 sub BDM { MODES(TeX => '\\[', Latex2HTML =>   '\\[', HTML =>   '<P ALIGN=CENTER>'); };  #begin displayMath mode
 1306 sub EDM { MODES(TeX => '\\]',  Latex2HTML =>  '\\]', HTML => '</P>'); };              #end displayMath mode
 1307 sub LTS { MODES(TeX => '<', Latex2HTML => '\\lt ', HTML => '&lt;', HTML_tth => '<' ); };
 1308 sub GTS { MODES(TeX => '>', Latex2HTML => '\\gt ', HTML => '&gt;', HTML_tth => '>' ); };
 1309 sub LTE { MODES(TeX => '\\le ', Latex2HTML => '\\le ', HTML => '<U>&lt;</U>', HTML_tth => '\\le ' ); };
 1310 sub GTE { MODES(TeX => '\\ge ', Latex2HTML => '\\ge ', HTML => '<U>&gt;</U>', HTML_tth => '\\ge ' ); };
 1311 sub BEGIN_ONE_COLUMN { MODES(TeX => " \\end{multicols}\n",  Latex2HTML => " ", HTML =>   " "); };
 1312 sub END_ONE_COLUMN { MODES(TeX =>
 1313               " \\begin{multicols}{2}\n\\columnwidth=\\linewidth\n",
 1314                             Latex2HTML => ' ', HTML => ' ');
 1315 
 1316 };
 1317 sub SOLUTION_HEADING { MODES( TeX => '\\par {\\bf Solution:}',
 1318                  Latex2HTML => '\\par {\\bf Solution:}',
 1319                HTML =>  '<P><B>Solution:</B>');
 1320               };
 1321 sub HINT_HEADING { MODES( TeX => "\\par {\\bf Hint:}", Latex2HTML => "\\par {\\bf Hint:}", HTML => "<P><B>Hint:</B>"); };
 1322 sub US { MODES(TeX => '\\_', Latex2HTML => '\\_', HTML => '_');};  # underscore, e.g. file${US}name
 1323 sub SPACE { MODES(TeX => '\\ ',  Latex2HTML => '\\ ', HTML => '&nbsp;');};  # force a space in latex, doesn't force extra space in html
 1324 sub BBOLD { MODES(TeX => '{\\bf ',  Latex2HTML => '{\\bf ', HTML => '<B>'); };
 1325 sub EBOLD { MODES( TeX => '}', Latex2HTML =>  '}',HTML =>  '</B>'); };
 1326 sub BITALIC { MODES(TeX => '{\\it ',  Latex2HTML => '{\\it ', HTML => '<I>'); };
 1327 sub EITALIC { MODES(TeX => '} ',  Latex2HTML => '} ', HTML => '</I>'); };
 1328 sub BUL { MODES(TeX => '\\underline{',  Latex2HTML => '\\underline{', HTML => '<U>'); };
 1329 sub EUL { MODES(TeX => '}',  Latex2HTML => '}', HTML => '</U>'); };
 1330 sub BCENTER { MODES(TeX => '\\begin{center} ',  Latex2HTML => ' \\begin{rawhtml} <div align="center"> \\end{rawhtml} ', HTML => '<div align="center">'); };
 1331 sub ECENTER { MODES(TeX => '\\end{center} ',  Latex2HTML => ' \\begin{rawhtml} </div> \\end{rawhtml} ', HTML => '</div>'); };
 1332 sub HR { MODES(TeX => '\\par\\hrulefill\\par ', Latex2HTML => '\\begin{rawhtml} <HR> \\end{rawhtml}', HTML =>  '<HR>'); };
 1333 sub LBRACE { MODES( TeX => '\{', Latex2HTML =>   '\\lbrace',  HTML =>  '{' , HTML_tth=> '\\lbrace' ); };
 1334 sub RBRACE { MODES( TeX => '\}', Latex2HTML =>   '\\rbrace',  HTML =>  '}' , HTML_tth=> '\\rbrace',); };
 1335 sub LB { MODES( TeX => '\{', Latex2HTML =>   '\\lbrace',  HTML =>  '{' , HTML_tth=> '\\lbrace' ); };
 1336 sub RB { MODES( TeX => '\}', Latex2HTML =>   '\\rbrace',  HTML =>  '}' , HTML_tth=> '\\rbrace',); };
 1337 sub DOLLAR { MODES( TeX => '\\$', Latex2HTML => '&#36;', HTML => '&#36;' ); };
 1338 sub PERCENT { MODES( TeX => '\\%', Latex2HTML => '\\%', HTML => '%' ); };
 1339 sub CARET { MODES( TeX => '\\verb+^+', Latex2HTML => '\\verb+^+', HTML => '^' ); };
 1340 sub PI {4*atan2(1,1);};
 1341 sub E {exp(1);};
 1342 
 1343 ###############################################################
 1344 ## Evaluation macros
 1345 
 1346 
 1347 =head2 TEXT macros
 1348 
 1349   Usage:
 1350     TEXT(@text);
 1351 
 1352 This is the simplest way to print text from a problem.  The strings in the array C<@text> are concatenated
 1353 with spaces between them and printed out in the text of the problem.  The text is not processed in any other way.
 1354 C<TEXT> is defined in PG.pl.
 1355 
 1356   Usage:
 1357     BEGIN_TEXT
 1358       text.....
 1359     END_TEXT
 1360 
 1361 This is the most common way to enter text into the problem.  All of the text between BEGIN_TEXT and END_TEXT
 1362 is processed by the C<EV3> macro described below and then printed using the C<TEXT> command.  The two key words
 1363 must appear on lines by themselves.  The preprocessing that makes this construction work is done in F<PGtranslator.pm>.
 1364 See C<EV3> below for details on the processing.
 1365 
 1366 
 1367 =cut
 1368 
 1369 =head2 Evaluation macros
 1370 
 1371 =head3 EV3
 1372 
 1373         TEXT(EV3("This is a formulat \( \int_0^5 x^2 \, dx \) ");
 1374         TEXT(EV3(@text));
 1375 
 1376     TEXT(EV3(<<'END_TEXT'));
 1377       text stuff...
 1378     END_TEXT
 1379 
 1380 
 1381 The BEGIN_TEXT/END_TEXT construction is translated into the construction above by PGtranslator.pm.  END_TEXT must appear
 1382 on a line by itself and be left justified.  (The << construction is known as a "here document" in UNIX and in PERL.)
 1383 
 1384 The single quotes around END_TEXT mean that no automatic interpolation of variables takes place in the text.
 1385 Using EV3 with strings which have been evaluated by double quotes may lead to unexpected results.
 1386 
 1387 
 1388 The evaluation macro E3 first evaluates perl code inside the braces:  C<\{  code \}>.
 1389 Any perl statment can be put inside the braces.  The
 1390 result of the evaluation (i.e. the last statement evaluated) replaces the C<\{ code \}> construction.
 1391 
 1392 Next interpolation of all variables (e.g. C<$var or @array> ) is performed.
 1393 
 1394 Then mathematical formulas in TeX are evaluated within the
 1395 C<\(  tex math mode \)> and
 1396 C<\[ tex display math mode \] >
 1397 constructions, in that order:
 1398 
 1399 =head3 FEQ
 1400 
 1401   FEQ($string);   # processes and outputs the string
 1402 
 1403 
 1404 The mathematical formulas are run through the macro C<FEQ> (Format EQuations) which performs
 1405 several substitutions (see below).
 1406 In C<HTML_tth> mode the resulting code is processed by tth to obtain an HTML version
 1407 of the formula. (In the future processing by WebEQ may be added here as another option.)
 1408 The Latex2HTML mode does nothing
 1409 at this stage; it creates the entire problem before running it through
 1410 TeX and creating the GIF images of the equations.
 1411 
 1412 The resulting string is output (and usually fed into TEXT to be printed in the problem).
 1413 
 1414   Usage:
 1415 
 1416     $string2 = FEQ($string1);
 1417 
 1418 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
 1419 understood with an example.
 1420 
 1421     $string1 = "${a}x^2 + ${b}x + {$c:%.1f}"; $a = 3;, $b = -2; $c = -7.345;
 1422 
 1423 when interpolated becomes:
 1424 
 1425     $string1 = '3x^2 + -2x + {-7.345:%0.1f}
 1426 
 1427 FEQ first changes the number of decimal places displayed, so that the last term becomes -7.3 Then it removes the
 1428 extraneous plus and minus signs, so that the final result is what you want:
 1429 
 1430     $string2 = '3x^2 - 2x -7.3';
 1431 
 1432 (The %0.1f construction
 1433 is the same formatting convention used by Perl and nearly identical to the one used by the C printf statement. Some common
 1434 usage:  %0.3f 3 decimal places, fixed notation; %0.3e 3 significant figures exponential notation; %0.3g uses either fixed
 1435 or exponential notation depending on the size of the number.)
 1436 
 1437 Two additional legacy formatting constructions are also supported:
 1438 
 1439 C<!{$c:%0.3f} > will give a number with 3 decimal places and a negative
 1440 sign if the number is negative, no sign if the number is positive.  Since this is
 1441 identical to the behavior of C<{$c:%0.3f}> the use of this syntax is depricated.
 1442 
 1443 C<?{$c:%0.3f}> determines the sign and prints it
 1444 whether the number is positive or negative.  You can use this
 1445 to force an expression such as C<+5.456>.
 1446 
 1447 =head3 EV2
 1448 
 1449     TEXT(EV2(@text));
 1450 
 1451     TEXT(EV2(<<END_OF_TEXT));
 1452       text stuff...
 1453     END_OF_TEXT
 1454 
 1455 This is a precursor to EV3.  In this case the constants are interpolated first, before the evaluation of the \{ ...code...\}
 1456 construct. This can lead to unexpected results.  For example C<\{ join(" ", @text) \}> with C<@text = ("Hello","World");> becomes,
 1457 after interpolation, C<\{ join(" ",Hello World) \}> which then causes an error when evaluated because Hello is a bare word.
 1458 C<EV2> can still be useful if you allow for this, and in particular it works on double quoted strings, which lead to
 1459 unexpected results with C<EV3>. Using single quoted strings with C<EV2> may lead to unexpected results.
 1460 
 1461 The unexpected results have to do with the number of times backslashed constructions have to be escaped. It is quite messy.  For
 1462 more details get a good Perl book and then read the code. :-)
 1463 
 1464 
 1465 
 1466 
 1467 =cut
 1468 
 1469 
 1470 sub ev_substring {
 1471     my $string      = shift;
 1472   my $start_delim = shift;
 1473   my $end_delim   = shift;
 1474   my $actionRef   = shift;
 1475   my ($eval_out,$PG_eval_errors,$PG_full_error_report)=();
 1476     my $out = "";
 1477                 #
 1478                 #  DPVC -- 2001/12/07
 1479                 #     original "while ($string)" fails to process the string "0" correctly
 1480                 #
 1481     while ($string ne "") {
 1482                 #
 1483                 #  end DPVC
 1484                 #
 1485         if ($string =~ /\Q$start_delim\E/s) {
 1486        #print "$start_delim $end_delim evaluating_substring=$string<BR>";
 1487         $string =~ s/^(.*?)\Q$start_delim\E//s;  # get string up to next \{ ---treats string as a single line, ignoring returns
 1488         $out .= $1;
 1489        #print "$start_delim $end_delim substring_out=$out<BR>";
 1490         $string =~ s/^(.*?)\Q$end_delim\E//s;  # get perl code up to \} ---treats string as a single line,  ignoring returns
 1491            #print "$start_delim $end_delim evaluate_string=$1<BR>";
 1492         ($eval_out,$PG_eval_errors,$PG_full_error_report) = &$actionRef($1);
 1493         $eval_out = "$start_delim $eval_out $end_delim" if $PG_full_error_report;
 1494         $out = $out . $eval_out;
 1495        #print "$start_delim $end_delim new substring_out=$out<BR><p><BR>";
 1496         $out .="$PAR ERROR $0 in ev_substring, PGbasicmacros.pl:$PAR <PRE>  $@ </PRE>$PAR" if $@;
 1497         }
 1498       else {
 1499         $out .= $string;  # flush the last part of the string
 1500         last;
 1501         }
 1502 
 1503       }
 1504   $out;
 1505 }
 1506 sub  safe_ev {
 1507     my ($out,$PG_eval_errors,$PG_full_error_report) = &old_safe_ev;   # process input by old_safe_ev first
 1508     $out = "" unless defined($out) and $out =~/\S/;
 1509     $out =~s/\\/\\\\/g;   # protect any new backslashes introduced.
 1510   ($out,$PG_eval_errors,$PG_full_error_report)
 1511 }
 1512 
 1513 sub  old_safe_ev {
 1514     my $in = shift;
 1515     my   ($out,$PG_eval_errors,$PG_full_error_report) = PG_restricted_eval("$in;");
 1516     # the addition of the ; seems to provide better error reporting
 1517     if ($PG_eval_errors) {
 1518       my @errorLines = split("\n",$PG_eval_errors);
 1519     #$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> ";
 1520     warn " ERROR in old_safe_ev, PGbasicmacros.pl: <PRE>
 1521      ## There is an error occuring inside evaluation brackets \\{ ...code... \\}
 1522      ## somewhere in an EV2 or EV3 or BEGIN_TEXT block.
 1523      ## Code evaluated:
 1524      ## $in
 1525      ##" .join("\n     ", @errorLines). "
 1526      ##</PRE>$BR
 1527      ";
 1528      $out ="$PAR $BBOLD  $in $EBOLD $PAR";
 1529 
 1530 
 1531   }
 1532 
 1533   ($out,$PG_eval_errors,$PG_full_error_report);
 1534 }
 1535 
 1536 sub FEQ   {    # Format EQuations
 1537   my $in = shift;
 1538    # formatting numbers -- the ?{} and !{} constructions
 1539   $in =~s/\?\s*\{([.\-\$\w\d]+):?([%.\da-z]*)\}/${ \( &sspf($1,$2) )}/g;
 1540   $in =~s/\!\s*\{([.\-\$\w\d]+):?([%.\da-z]*)\}/${ \( &spf($1,$2) )}/g;
 1541 
 1542   # more formatting numbers -- {number:format} constructions
 1543   $in =~ s/\{(\s*[\+\-\d\.]+[eE]*[\+\-]*\d*):(\%\d*.\d*\w)}/${ \( &spf($1,$2) )}/g;
 1544   $in =~ s/\+\s*\-/ - /g;
 1545   $in =~ s/\-\s*\+/ - /g;
 1546   $in =~ s/\+\s*\+/ + /g;
 1547   $in =~ s/\-\s*\-/ + /g;
 1548   $in;
 1549 }
 1550 
 1551 #sub math_ev3 {
 1552 # my $in = shift; #print "in=$in<BR>";
 1553 # my ($out,$PG_eval_errors,$PG_full_error_report);
 1554 # $in = FEQ($in);
 1555 # $in =~ s/%/\\%/g;   #  % causes trouble in TeX and HTML_tth it usually (always?) indicates an error, not comment
 1556 # return("$BM $in $EM") unless ($displayMode eq 'HTML_tth');
 1557 # $in = "\\(" . $in . "\\)";
 1558 # $out = tth($in);
 1559 # ($out,$PG_eval_errors,$PG_full_error_report);
 1560 #
 1561 #}
 1562 #
 1563 #sub display_math_ev3 {
 1564 # my $in = shift; #print "in=$in<BR>";
 1565 # my ($out,$PG_eval_errors,$PG_full_error_report);
 1566 # $in = FEQ($in);
 1567 # $in =~ s/%/\\%/g;
 1568 # return("$main::BDM $in $main::EDM") unless $displayMode eq 'HTML_tth' ;
 1569 # $in = "\\[" . $in . "\\]";
 1570 # $out =tth($in);
 1571 # ($out,$PG_eval_errors,$PG_full_error_report);
 1572 #}
 1573 
 1574 sub math_ev3 {
 1575   my $in = shift;
 1576   return general_math_ev3($in, "inline");
 1577 }
 1578 
 1579 sub display_math_ev3 {
 1580   my $in = shift;
 1581   return general_math_ev3($in, "display");
 1582 }
 1583 
 1584 sub general_math_ev3 {
 1585   my $in = shift;
 1586   my $mode = shift || "inline";
 1587 
 1588   $in = FEQ($in); # Format EQuations
 1589   $in =~ s/%/\\%/g; # avoid % becoming TeX comments
 1590 
 1591   ## remove leading and trailing spaces so that HTML mode will
 1592   ## not include unwanted spaces as per Davide Cervone.
 1593   $in =~ s/^\s+//;
 1594   $in =~ s/\s+$//;
 1595   ## If it ends with a backslash, there should be another space
 1596   ## at the end
 1597   if($in =~ /\\$/) { $in .= ' ';}
 1598 
 1599   # some modes want the delimiters, some don't
 1600   my $in_delim = $mode eq "inline"
 1601     ? "\\($in\\)"
 1602     : "\\[$in\\]";
 1603 
 1604   my $out;
 1605   if($displayMode eq "HTML_tth") {
 1606     $out = tth($in_delim);
 1607     ## remove leading and trailing spaces as per Davide Cervone.
 1608     $out =~ s/^\s+//;
 1609     $out =~ s/\s+$//;
 1610   } elsif ($displayMode eq "HTML_dpng") {
 1611     # for jj's version of ImageGenerator
 1612     $out = $envir->{'imagegen'}->add($in_delim);
 1613     # for my version of ImageGenerator
 1614     #$out = $envir->{'imagegen'}->add($in, $mode);
 1615   } elsif ($displayMode eq "HTML_img") {
 1616     $out = math2img($in, $mode);
 1617   } elsif ($displayMode eq "HTML_jsMath") {
 1618     $in =~ s/</&lt;/g; $in =~ s/>/&gt;/g;
 1619     $out = '<SPAN CLASS="math">'.$in.'</SPAN>' if $mode eq "inline";
 1620     $out = '<DIV CLASS="math">'.$in.'</DIV>' if $mode eq "display";
 1621   } elsif ($displayMode eq "HTML_asciimath") {
 1622     $out = "`$in`" if $mode eq "inline";
 1623     $out = '<DIV ALIGN="CENTER">`'.$in.'`</DIV>' if $mode eq "display";
 1624   } elsif ($displayMode eq "HTML_LaTeXMathML") {
 1625     $in = '{'.$in.'}';
 1626     $in =~ s/</\\lt/g; $in =~ s/>/\\gt/g;
 1627     $in =~ s/\{\s*(\\(display|text|script|scriptscript)style)/$1\{/g;
 1628     $out = '$$'.$in.'$$' if $mode eq "inline";
 1629     $out = '<DIV ALIGN="CENTER">$$\displaystyle{'.$in.'}$$</DIV>' if $mode eq "display";
 1630   } else {
 1631     $out = "\\($in\\)" if $mode eq "inline";
 1632     $out = "\\[$in\\]" if $mode eq "display";
 1633   }
 1634   return $out;
 1635 }
 1636 
 1637 sub EV2 {
 1638   my $string = join(" ",@_);
 1639   # evaluate code inside of \{  \}  (no nesting allowed)
 1640     $string = ev_substring($string,"\\{","\\}",\&old_safe_ev);
 1641     $string = ev_substring($string,"\\<","\\>",\&old_safe_ev);
 1642   $string = ev_substring($string,"\\(","\\)",\&math_ev3);
 1643   $string = ev_substring($string,"\\[","\\]",\&display_math_ev3);
 1644   # macros for displaying math
 1645   $string =~ s/\\\(/$BM/g;
 1646   $string =~ s/\\\)/$EM/g;
 1647   $string =~ s/\\\[/$BDM/g;
 1648   $string =~ s/\\\]/$EDM/g;
 1649   $string;
 1650 }
 1651 
 1652 sub EV3{
 1653   my $string = join(" ",@_);
 1654   # evaluate code inside of \{  \}  (no nesting allowed)
 1655     $string = ev_substring($string,"\\\\{","\\\\}",\&safe_ev);  # handles \{ \} in single quoted strings of PG files
 1656   # interpolate variables
 1657   my ($evaluated_string,$PG_eval_errors,$PG_full_errors) = PG_restricted_eval("<<END_OF_EVALUATION_STRING\n$string\nEND_OF_EVALUATION_STRING\n");
 1658   if ($PG_eval_errors) {
 1659       my @errorLines = split("\n",$PG_eval_errors);
 1660       $string =~ s/</&lt;/g; $string =~ s/>/&gt;/g;
 1661     $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> ";
 1662     $@="";
 1663   }
 1664   $string = $evaluated_string;
 1665   $string = ev_substring($string,"\\(","\\)",\&math_ev3);
 1666     $string = ev_substring($string,"\\[","\\]",\&display_math_ev3);
 1667   $string;
 1668 }
 1669 
 1670 sub EV4{
 1671     if ($displayMode eq "HTML_dpng") {
 1672         my $string = join(" ",@_);
 1673         my ($evaluated_string,$PG_eval_errors,$PG_full_errors) = PG_restricted_eval("<<END_OF_EVALUATION_STRING\n$string\nEND_OF_EVALUATION_STRING\n");
 1674         if ($PG_eval_errors) {
 1675             my @errorLines = split("\n",$PG_eval_errors);
 1676             $string =~ s/</&lt;/g; $string =~ s/>/&gt;/g;
 1677             $evaluated_string = "<PRE>$PAR % ERROR in $0:EV3, PGbasicmacros.pl:".
 1678       "$PAR % There is an error occuring in the following code:$BR ".
 1679       "$string $BR % $BR % $errorLines[0]\n % $errorLines[1]$BR ".
 1680       "% $BR % $BR </PRE> ";
 1681         }
 1682         $string = $evaluated_string;
 1683         $string = $envir{'imagegen'}->add($string);
 1684         $string;
 1685     } else {
 1686       EV3(@_);
 1687     }
 1688 }
 1689 
 1690 =head3 EV3P
 1691 
 1692   ######################################################################
 1693   #
 1694   #  New version of EV3 that allows `...` and ``...`` to insert TeX produced
 1695   #  by the new Parser (in math and display modes).
 1696   #
 1697   #  Format:  EV3P(string,...);
 1698   #           EV3P({options},string,...);
 1699   #
 1700   #           `x^2/5` will become \(\frac{x^2}{5}\) and then rendered for hardcopy or screen output
 1701   #
 1702   #  where options can include:
 1703   #
 1704   #    processCommands => 0 or 1     Indicates if the student's answer will
 1705   #                                  be allowed to process \{...\}.
 1706   #                                    Default: 1
 1707   #
 1708   #    processVariables => 0 1       Indicates whether variable substitution
 1709   #                                  should be performed on the student's
 1710   #                                  answer.
 1711   #                                    Default: 1
 1712   #
 1713   #    processMath => 0 or 1         Indicates whether \(...\), \[...\],
 1714   #                                  `...` and ``...`` will be processed
 1715   #                                  in the student's answer.
 1716   #                                    Default: 1
 1717   #
 1718   #    processParser => 0 or 1       Indicates if `...` and ``...`` should
 1719   #                                  be processed when math is being
 1720   #                                  processed.
 1721   #                                    Default: 1
 1722   #
 1723   #    fixDollars => 0 or 1          Specifies whether dollar signs not followed
 1724   #                                  by a letter should be replaced by ${DOLLAR}
 1725   #                                  prior to variable substitution (to prevent
 1726   #                                  accidental substitution of strange Perl
 1727   #                                  values).
 1728   #                                    Default: 1
 1729   #
 1730 
 1731 =cut
 1732 
 1733 sub EV3P {
 1734   my $option_ref = {}; $option_ref = shift if ref($_[0]) eq 'HASH';
 1735   my %options = (
 1736     processCommands => 1,
 1737     processVariables => 1,
 1738     processParser => 1,
 1739     processMath => 1,
 1740     fixDollars => 1,
 1741     %{$option_ref},
 1742   );
 1743   my $string = join(" ",@_);
 1744   $string = ev_substring($string,"\\\\{","\\\\}",\&safe_ev) if $options{processCommands};
 1745   if ($options{processVariables}) {
 1746     my $eval_string = $string;
 1747     $eval_string =~ s/\$(?![a-z\{])/\${DOLLAR}/gi if $options{fixDollars};
 1748     my ($evaluated_string,$PG_eval_errors,$PG_full_errors) =
 1749       PG_restricted_eval("<<END_OF_EVALUATION_STRING\n$eval_string\nEND_OF_EVALUATION_STRING\n");
 1750     if ($PG_eval_errors) {
 1751       my $error = (split("\n",$PG_eval_errors))[0]; $error =~ s/at \(eval.*//gs;
 1752       $string =~ s/&/&amp;/g; $string =~ s/</&lt;/g; $string =~ s/>/&gt;/g;
 1753       $evaluated_string = $BBOLD."(Error: $error in '$string')".$EBOLD;
 1754     }
 1755     $string = $evaluated_string;
 1756   }
 1757   if ($options{processMath}) {
 1758     $string = EV3P_parser($string) if $options{processParser};
 1759     $string = ev_substring($string,"\\(","\\)",\&math_ev3);
 1760     $string = ev_substring($string,"\\[","\\]",\&display_math_ev3);
 1761   }
 1762   return $string;
 1763 }
 1764 
 1765 #
 1766 #  Look through a string for ``...`` or `...` and use
 1767 #  the parser to produce TeX code for the specified mathematics.
 1768 #  ``...`` does display math, `...` does in-line math.  They
 1769 #  can also be used within math mode already, in which case they
 1770 #  use whatever mode is already in effect.
 1771 #
 1772 sub EV3P_parser {
 1773   my $string = shift;
 1774   return $string unless $string =~ m/`/;
 1775   my $start = ''; my %end = ('\('=>'\)','\['=>'\]');
 1776   my @parts = split(/(``.*?``\*?|`.+?`\*?|(?:\\[()\[\]]))/s,$string);
 1777   foreach my $part (@parts) {
 1778     if ($part =~ m/^(``?)(.*)\1(\*?)$/s) {
 1779       my ($delim,$math,$star) = ($1,$2,$3);
 1780       my $f = Parser::Formula($math);
 1781       if (defined($f)) {
 1782         $f = $f->reduce if $star;
 1783   $part = $f->TeX;
 1784   $part = ($delim eq '`' ? '\('.$part.'\)': '\['.$part.'\]') if (!$start);
 1785       } else {
 1786   ## FIXME:  use context->{error}{ref} to highlight error in $math.
 1787   $part = $BBOLD."(Error: $$Value::context->{error}{message} '$math')".$EBOLD;
 1788   $part = $end{$start}." ".$part." ".$start if $start;
 1789       }
 1790     }
 1791     elsif ($start) {$start = '' if $part eq $end{$start}}
 1792     elsif ($end{$part}) {$start = $part}
 1793   }
 1794   return join('',@parts);
 1795 }
 1796 
 1797 
 1798 =head2 Formatting macros
 1799 
 1800   beginproblem()  # generates text listing number and the point value of
 1801                   # the problem. It will also print the file name containing
 1802                   # the problem for users listed in the PRINT_FILE_NAMES_FOR PG_environment
 1803                   # variable.
 1804   OL(@array)      # formats the array as an Ordered List ( <OL> </OL> ) enumerated by letters.
 1805 
 1806   htmlLink($url, $text)
 1807                   # Places a reference to the URL with the specified text in the problem.
 1808                   # A common usage is \{ htmlLink(alias('prob1_help.html') \}, 'for help')
 1809                   # where alias finds the full address of the prob1_help.html file in the same directory
 1810                   # as the problem file
 1811   appletLink( { name => "xFunctions",
 1812                 codebase => '',    # use this to specify the complete url
 1813                                    # otherwise libraries specified in global.conf are searched
 1814                 archive  => 'xFunctions.zip', # name the archive containing code (.jar files go here also)
 1815                 code     => 'xFunctionsLauncher.class',
 1816                 width    => 100,
 1817                 height   => 14,
 1818                 params   => { param1 =>value1, param2 => value2},
 1819               }
 1820             );
 1821   helpLink()     allows site specific help specified in global.conf or course.conf
 1822                  the parameter localHelpURL  must be defined in the environment
 1823                  currently works only for 'interval notation' and 'units'
 1824                  NEEDS REFINEMENT
 1825 
 1826   ########################
 1827                 deprecated coding method
 1828           appletLink  ($url, $parameters)
 1829                   # For example
 1830                   # appletLink(q!  archive="http: //webwork.math.rochester.edu/gage/xFunctions/xFunctions.zip"
 1831                                   code="xFunctionsLauncher.class"  width=100 height=14!,
 1832                   " parameter text goes here")
 1833                   # will link to xFunctions.
 1834 
 1835   low level:
 1836 
 1837   spf($number, $format)   # prints the number with the given format
 1838   sspf($number, $format)  # prints the number with the given format, always including a sign.
 1839   nicestring($coefficients, $terms) # print a linear combinations of terms using coefficients
 1840   nicestring($coefficients) # uses the coefficients to make a polynomial
 1841       # For example
 1842       # nicestring([1,-2, 0]) produces 'x^2-2x'
 1843       # nicestring([2,0,-1],['', 't', 't^2']) produces '2-t^2'
 1844   protect_underbar($string) # protects the underbar (class_name) in strings which may have to pass through TeX.
 1845 
 1846 =cut
 1847 
 1848 sub beginproblem {
 1849   my $out = "";
 1850   my $problemValue = $envir->{problemValue} || 0;
 1851   my $fileName     = $envir->{fileName};
 1852   my $probNum      = $envir->{probNum};
 1853     my $TeXFileName = protect_underbar($envir->{fileName});
 1854     my $l2hFileName = protect_underbar($envir->{fileName});
 1855   my %inlist;
 1856   my $points ='pts';
 1857 
 1858   $points = 'pt' if $problemValue == 1;
 1859   ##    Prepare header for the problem
 1860   grep($inlist{$_}++,@{ $envir->{'PRINT_FILE_NAMES_FOR'} });
 1861   my $effectivePermissionLevel = $envir->{effectivePermissionLevel}; # permission level of user assigned to question
 1862   my $PRINT_FILE_NAMES_PERMISSION_LEVEL = $envir->{'PRINT_FILE_NAMES_PERMISSION_LEVEL'};
 1863   my $studentLogin = $envir->{studentLogin};
 1864   my $print_path_name_flag =
 1865       (defined($effectivePermissionLevel) && defined($PRINT_FILE_NAMES_PERMISSION_LEVEL) && $effectivePermissionLevel >= $PRINT_FILE_NAMES_PERMISSION_LEVEL)
 1866        || ( defined($inlist{ $studentLogin }) and ( $inlist{ $studentLogin }>0 )  ) ;
 1867 
 1868   if ( $print_path_name_flag ) {
 1869     $out = &M3("{\\bf ${probNum}. {\\footnotesize ($problemValue $points) $TeXFileName}}\\newline ",
 1870     " \\begin{rawhtml} ($problemValue $points) <B>$l2hFileName</B><BR>\\end{rawhtml}",
 1871      "($problemValue $points) <B>$fileName</B><BR>"
 1872        ) if ($problemValue ne "");
 1873   } else {
 1874     $out = &M3("{\\bf ${probNum}.} ($problemValue $points) ",
 1875     "($problemValue $points) ",
 1876      "($problemValue $points) "
 1877        ) if ($problemValue ne "");
 1878   }
 1879   $out .= MODES(%{main::PG_restricted_eval(q!$main::problemPreamble!)});
 1880   $out;
 1881 
 1882 }
 1883 
 1884 sub nicestring {
 1885     my($thingy) = shift;
 1886     my(@coefs) = @{$thingy};
 1887     my $n = scalar(@coefs);
 1888     $thingy = shift;
 1889     my(@others);
 1890     if(defined($thingy)) {
 1891   @others = @{$thingy};
 1892     } else {
 1893   my($j);
 1894   for $j (1..($n-2)) {
 1895       $others[$j-1] = "x^".($n-$j);
 1896   }
 1897   if($n>=2) { $others[$n-2] = "x";}
 1898   $others[$n-1] = "";
 1899     }
 1900     my($j, $k)=(0,0);
 1901     while(($k<$n) && ($coefs[$k]==0)) {$k++;}
 1902     if($k==$n) {return("0");}
 1903     my $ans;
 1904     if($coefs[$k]==1) {$ans = ($others[$k]) ? "$others[$k]" : "1";}
 1905     elsif($coefs[$k]== -1) {$ans =  ($others[$k]) ? "- $others[$k]" : "-1"}
 1906     else { $ans = "$coefs[$k] $others[$k]";}
 1907     $k++;
 1908     for $j ($k..($n-1)) {
 1909   if($coefs[$j] != 0) {
 1910       if($coefs[$j] == 1) {
 1911     $ans .= ($others[$j]) ? "+ $others[$j]" : "+ 1";
 1912       } elsif($coefs[$j] == -1) {
 1913     $ans .= ($others[$j]) ? "- $others[$j]" : "-1";
 1914       } else {
 1915     $ans .= "+ $coefs[$j] $others[$j]";
 1916       }
 1917   }
 1918     }
 1919     return($ans);
 1920 }
 1921 
 1922 # kludge to clean up path names
 1923             ## allow underscore character in set and section names and also allows line breaks at /
 1924 sub protect_underbar {
 1925     my $in = shift;
 1926     if ($displayMode eq 'TeX')  {
 1927 
 1928         $in =~ s|_|\\\_|g;
 1929         $in =~ s|/|\\\-/|g;  # allows an optional hyphenation of the path (in tex)
 1930     }
 1931     $in;
 1932 }
 1933 
 1934 
 1935 # An example of a macro which prints out a list (with letters)
 1936 sub OL {
 1937   my(@array) = @_;
 1938   my $i = 0;
 1939   my @alpha = ('A'..'Z', 'AA'..'ZZ');
 1940   my $letter;
 1941   my  $out=   &M3(
 1942           "\\begin{enumerate}\n",
 1943           " \\begin{rawhtml} <OL TYPE=\"A\" VALUE=\"1\"> \\end{rawhtml} ",
 1944           # kludge to fix IE/CSS problem
 1945           #"<OL TYPE=\"A\" VALUE=\"1\">\n"
 1946           "<BLOCKQUOTE>\n"
 1947           ) ;
 1948   my $elem;
 1949   foreach $elem (@array) {
 1950     $letter = shift @alpha;
 1951                 $out .= MODES(
 1952                         TeX=>   "\\item[$ALPHABET[$i].] $elem\n",
 1953                         Latex2HTML=>    " \\begin{rawhtml} <LI> \\end{rawhtml} $elem  ",
 1954                         #HTML=>  "<LI> $elem\n",
 1955                         HTML=>  "<br /> <b>$letter.</b> $elem\n",
 1956                         #HTML_dpng=>     "<LI> $elem <br /> <br /> \n"
 1957                         HTML_dpng=>     "<br /> <b>$letter.</b> $elem \n"
 1958                                         );
 1959     $i++;
 1960   }
 1961   $out .= &M3(
 1962         "\\end{enumerate}\n",
 1963         " \\begin{rawhtml} </OL>\n \\end{rawhtml} ",
 1964         #"</OL>\n"
 1965         "</BLOCKQUOTE>\n"
 1966         ) ;
 1967 }
 1968 
 1969 sub htmlLink {
 1970   my $url = shift;
 1971   my $text = shift;
 1972   my $options = shift;
 1973   $options = "" unless defined($options);
 1974   return "$BBOLD\[ broken link:  $text \] $EBOLD" unless defined($url);
 1975   M3( "{\\bf \\underline{$text}}",
 1976       "\\begin{rawhtml}<A HREF=\"$url\" $options>$text</A>\\end{rawhtml}",
 1977       "<A HREF=\"$url\" $options>$text</A>"
 1978       );
 1979 }
 1980 
 1981 
 1982 sub helpLink {
 1983   my $type1 = shift;
 1984   return "" if(not defined($envir{'localHelpURL'}));
 1985   my $type = lc($type1);
 1986   my %typeHash = (
 1987     'interval notation' => 'IntervalNotation.html',
 1988     'units' => 'Units.html',
 1989     'syntax' => 'Syntax.html',
 1990     );
 1991 
 1992   my $infoRef = $typeHash{$type};
 1993   return htmlLink( $envir{'localHelpURL'}.$infoRef, $type1,
 1994 'target="ww_help" onclick="window.open(this.href,this.target,\'width=550,height=350,scrollbars=yes,resizable=on\'); return false;"');
 1995 }
 1996 
 1997 sub appletLink {
 1998   my $url  = $_[0];
 1999   return oldAppletLink(@_) unless ref($url) ; # handle legacy where applet link completely defined
 2000   # search for applet
 2001   # get fileName of applet
 2002   my $applet       = shift;
 2003   my $options      = shift;
 2004   my $archive      = $applet ->{archive};
 2005   my $codebase     = $applet ->{codebase};
 2006   my $code         = $applet ->{code};
 2007   my $appletHeader = '';
 2008   # find location of applet
 2009     if (defined($codebase) and $codebase =~/\S/) {
 2010       # do nothing
 2011     } elsif(defined($archive) and $archive =~/\S/) {
 2012       $codebase = findAppletCodebase($archive )
 2013     } elsif (defined($code) and $code =~/\S/) {
 2014       $codebase =  findAppletCodebase($code )
 2015     } else {
 2016       warn "Must define the achive (.jar file) or code (.class file) where the applet code is to be found";
 2017       return;
 2018     }
 2019 
 2020   if ( $codebase =~/^Error/) {
 2021     warn $codebase;
 2022     return;
 2023   } else {
 2024      # we are set to include the applet
 2025   }
 2026   $appletHeader  =  qq! archive = "$archive " codebase = "$codebase" !;
 2027   foreach my $key ('name', 'code','width','height', ) {
 2028     if ( defined($applet->{$key})   ) {
 2029       $appletHeader .= qq! $key = "!.$applet->{$key}.q!" ! ;
 2030     } else {
 2031       warn " $key is not defined for applet ".$applet->{name};
 2032       # technically name is not required, but all of the other parameters are
 2033     }
 2034   }
 2035   # add parameters to options
 2036   if (defined($applet->{params}) ) {
 2037     foreach my $key (keys %{ $applet->{params} }) {
 2038       my $value = $applet->{params}->{$key};
 2039       $options .=  qq{<PARAM NAME = "$key" VALUE = "$value" >\n};
 2040     }
 2041 
 2042 
 2043   }
 2044   MODES( TeX        => "{\\bf \\underline{APPLET}  }".$applet->{name},
 2045          Latex2HTML => "\\begin{rawhtml} <APPLET $appletHeader> $options </APPLET>\\end{rawhtml}",
 2046          HTML       => "<APPLET\n $appletHeader> \n $options \n </APPLET>",
 2047          #HTML       => qq!<OBJECT $appletHeader codetype="application/java"> $options </OBJECT>!
 2048   );
 2049 }
 2050 
 2051 sub oldAppletLink {
 2052   my $url = shift;
 2053   my $options = shift;
 2054   $options = "" unless defined($options);
 2055   MODES( TeX        => "{\\bf \\underline{APPLET}  }",
 2056          Latex2HTML => "\\begin{rawhtml} <APPLET $url> $options </APPLET>\\end{rawhtml}",
 2057          HTML       => "<APPLET $url> $options </APPLET>"
 2058       );
 2059 }
 2060 sub spf {
 2061   my($number,$format) = @_;  # attention, the order of format and number are reversed
 2062   $format = "%4.3g" unless $format;   # default value for format
 2063   sprintf($format, $number);
 2064   }
 2065 sub sspf {
 2066   my($number,$format) = @_;  # attention, the order of format and number are reversed
 2067   $format = "%4.3g" unless $format;   # default value for format
 2068   my $sign = $number>=0 ? " + " : " - ";
 2069   $number = $number>=0 ? $number : -$number;
 2070   $sign .sprintf($format, $number);
 2071   }
 2072 
 2073 =head2  Sorting and other list macros
 2074 
 2075 
 2076 
 2077   Usage:
 2078   lex_sort(@list);   # outputs list in lexigraphic (alphabetical) order
 2079   num_sort(@list);   # outputs list in numerical order
 2080   uniq( @list);      # outputs a list with no duplicates.  Order is unspecified.
 2081 
 2082   PGsort( \&sort_subroutine, @list);
 2083   # &sort_subroutine defines order. It's output must be 1 or 0 (true or false)
 2084 
 2085 =cut
 2086 
 2087 #  uniq gives unique elements of a list:
 2088  sub uniq {
 2089    my (@in) =@_;
 2090    my %temp = ();
 2091    while (@in) {
 2092           $temp{shift(@in)}++;
 2093       }
 2094    my @out =  keys %temp;  # sort is causing trouble with Safe.??
 2095    @out;
 2096 }
 2097 
 2098 sub lex_sort {
 2099   PGsort( sub {$_[0] lt $_[1]}, @_);
 2100 }
 2101 sub num_sort {
 2102   PGsort( sub {$_[0] < $_[1]}. @_);
 2103 }
 2104 
 2105 
 2106 =head2 Macros for handling tables
 2107 
 2108   Usage:
 2109   begintable( number_of_columns_in_table)
 2110   row(@dataelements)
 2111   endtable()
 2112 
 2113 Example of useage:
 2114 
 2115   BEGIN_TEXT
 2116     This problem tests calculating new functions from old ones:$BR
 2117     From the table below calculate the quantities asked for:$BR
 2118     \{begintable(scalar(@firstrow)+1)\}
 2119     \{row(" \(x\) ",@firstrow)\}
 2120     \{row(" \(f(x)\) ", @secondrow)\}
 2121     \{row(" \(g(x)\) ", @thirdrow)\}
 2122     \{row(" \(f'(x)\) ", @fourthrow)\}
 2123     \{row(" \(g'(x)\) ", @fifthrow)\}
 2124     \{endtable()\}
 2125 
 2126    (The arrays contain numbers which are placed in the table.)
 2127 
 2128   END_TEXT
 2129 
 2130 =cut
 2131 
 2132 sub begintable {
 2133   my ($number)=shift;   #number of columns in table
 2134   my %options = @_;
 2135   warn "begintable(cols) requires a number indicating the number of columns" unless defined($number);
 2136   my $out = "";
 2137   if ($displayMode eq 'TeX') {
 2138     $out .= "\n\\par\\smallskip\\begin{center}\\begin{tabular}{"  .  "|c" x $number .  "|} \\hline\n";
 2139     }
 2140   elsif ($displayMode eq 'Latex2HTML') {
 2141     $out .= "\n\\begin{rawhtml} <TABLE , BORDER=1>\n\\end{rawhtml}";
 2142     }
 2143   elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng' ||
 2144                $displayMode eq 'HTML_img' || $displayMode eq 'HTML_jsMath' ||
 2145          $displayMode eq 'HTML_asciimath' || $displayMode eq 'HTML_LaTeXMathML') {
 2146     $out .= "<TABLE BORDER=1>\n"
 2147   }
 2148   else {
 2149     $out = "Error: PGbasicmacros: begintable: Unknown displayMode: $displayMode.\n";
 2150     }
 2151   $out;
 2152   }
 2153 
 2154 sub endtable {
 2155   my $out = "";
 2156   if ($displayMode eq 'TeX') {
 2157     $out .= "\n\\end {tabular}\\end{center}\\par\\smallskip\n";
 2158     }
 2159   elsif ($displayMode eq 'Latex2HTML') {
 2160     $out .= "\n\\begin{rawhtml} </TABLE >\n\\end{rawhtml}";
 2161     }
 2162   elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng' ||
 2163                $displayMode eq 'HTML_img' || $displayMode eq 'HTML_jsMath' ||
 2164          $displayMode eq 'HTML_asciimath' || $displayMode eq 'HTML_LaTeXMathML') {
 2165     $out .= "</TABLE>\n";
 2166     }
 2167   else {
 2168     $out = "Error: PGbasicmacros: endtable: Unknown displayMode: $displayMode.\n";
 2169     }
 2170   $out;
 2171 }
 2172 
 2173 
 2174 sub row {
 2175   my @elements = @_;
 2176   my $out = "";
 2177   if ($displayMode eq 'TeX') {
 2178     while (@elements) {
 2179       $out .= shift(@elements) . " &";
 2180       }
 2181      chop($out); # remove last &
 2182      $out .= "\\\\ \\hline \n";
 2183      # carriage returns must be added manually for tex
 2184     }
 2185   elsif ($displayMode eq 'Latex2HTML') {
 2186     $out .= "\n\\begin{rawhtml}\n<TR>\n\\end{rawhtml}\n";
 2187     while (@elements) {
 2188       $out .= " \n\\begin{rawhtml}\n<TD> \n\\end{rawhtml}\n" . shift(@elements) . " \n\\begin{rawhtml}\n</TD> \n\\end{rawhtml}\n";
 2189       }
 2190     $out .= " \n\\begin{rawhtml}\n</TR> \n\\end{rawhtml}\n";
 2191   }
 2192   elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng'||
 2193          $displayMode eq 'HTML_img' || $displayMode eq 'HTML_jsMath' ||
 2194          $displayMode eq 'HTML_asciimath' || $displayMode eq 'HTML_LaTeXMathML') {
 2195     $out .= "<TR>\n";
 2196     while (@elements) {
 2197       $out .= "<TD>" . shift(@elements) . "</TD>";
 2198       }
 2199     $out .= "\n</TR>\n";
 2200   }
 2201   else {
 2202     $out = "Error: PGbasicmacros: row: Unknown displayMode: $displayMode.\n";
 2203     }
 2204   $out;
 2205 }
 2206 
 2207 =head2 Macros for displaying static images
 2208 
 2209   Usage:
 2210   $string = image($image, width => 100, height => 100, tex_size => 800)
 2211   $string = image($image, width => 100, height => 100, extra_html_tags => 'align="middle"', tex_size => 800)
 2212   $string = image([$image1, $image2], width => 100, height => 100, tex_size => 800)
 2213   $string = caption($string);
 2214   $string = imageRow([$image1, $image2 ], [$caption1, $caption2]);
 2215            # produces a complete table with rows of pictures.
 2216 
 2217 
 2218 =cut
 2219 
 2220 #   More advanced macros
 2221 sub image {
 2222   my $image_ref  = shift;
 2223   my @opt = @_;
 2224   unless (scalar(@opt) % 2 == 0 ) {
 2225     warn "ERROR in image macro.  A list of macros must be inclosed in square brackets.";
 2226   }
 2227   my %in_options = @opt;
 2228   my %known_options = (
 2229     width    => 100,
 2230     height   => 100,
 2231     tex_size => 800,
 2232     extra_html_tags => '',
 2233   );
 2234   # handle options
 2235   my %out_options = %known_options;
 2236   foreach my $opt_name (keys %in_options) {
 2237     if ( exists( $known_options{$opt_name} ) ) {
 2238       $out_options{$opt_name} = $in_options{$opt_name} if exists( $in_options{$opt_name} ) ;
 2239     } else {
 2240       die "Option $opt_name not defined for image. " .
 2241           "Default options are:<BR> ", display_options2(%known_options);
 2242     }
 2243   }
 2244   my $width       = $out_options{width};
 2245   my $height      = $out_options{height};
 2246   my $tex_size    = $out_options{tex_size};
 2247   my $width_ratio = $tex_size*(.001);
 2248   my @image_list  = ();
 2249 
 2250   if (ref($image_ref) =~ /ARRAY/ ) {
 2251     @image_list = @{$image_ref};
 2252   } else {
 2253     push(@image_list,$image_ref);
 2254   }
 2255 
 2256   my @output_list = ();
 2257     while(@image_list) {
 2258     my $imageURL = alias(shift @image_list);
 2259     my $out="";
 2260 
 2261     if ($displayMode eq 'TeX') {
 2262       my $imagePath = $imageURL; # in TeX mode, alias gives us a path, not a URL
 2263       if (defined $envir->{texDisposition} and $envir->{texDisposition} eq "pdf") {
 2264         # We're going to create PDF files with our TeX (using pdflatex), so
 2265         # alias should have given us the path to a PNG image. What we need
 2266         # to do is find out the dimmensions of this image, since pdflatex
 2267         # is too dumb to live.
 2268 
 2269         #my ($height, $width) = getImageDimmensions($imagePath);
 2270         ##warn "&image: $imagePath $height $width\n";
 2271         #unless ($height and $width) {
 2272         # warn "Couldn't get the dimmensions of image $imagePath.\n"
 2273         #}
 2274         #$out = "\\includegraphics[bb=0 0 $height $width,width=$width_ratio\\linewidth]{$imagePath}\n";
 2275         $out = "\\includegraphics[width=$width_ratio\\linewidth]{$imagePath}\n";
 2276       } else {
 2277         # Since we're not creating PDF files, alias should have given us the
 2278         # path to an EPS file. latex can get its dimmensions no problem!
 2279 
 2280         $out = "\\includegraphics[width=$width_ratio\\linewidth]{$imagePath}\n";
 2281       }
 2282     } elsif ($displayMode eq 'Latex2HTML') {
 2283       my $wid = ($envir->{onTheFlyImageSize} || 0)+ 30;
 2284       $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
 2285       \\end{rawhtml}\n !
 2286     } elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng' ||
 2287        $displayMode eq 'HTML_img' || $displayMode eq 'HTML_jsMath' ||
 2288        $displayMode eq 'HTML_asciimath' || $displayMode eq 'HTML_LaTeXMathML') {
 2289       my $wid = ($envir->{onTheFlyImageSize} || 0) +30;
 2290       $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>
 2291       !
 2292     } else {
 2293       $out = "Error: PGbasicmacros: image: Unknown displayMode: $displayMode.\n";
 2294     }
 2295     push(@output_list, $out);
 2296   }
 2297   return wantarray ? @output_list : $output_list[0];
 2298 }
 2299 
 2300 # This is legacy code.
 2301 sub images {
 2302   my @in = @_;
 2303   my @outlist = ();
 2304   while (@in) {
 2305      push(@outlist,&image( shift(@in) ) );
 2306    }
 2307   @outlist;
 2308 }
 2309 
 2310 
 2311 sub caption {
 2312   my ($out) = @_;
 2313   $out = " $out \n" if $displayMode eq 'TeX';
 2314   $out = " $out  " if $displayMode eq 'HTML';
 2315   $out = " $out  " if $displayMode eq 'HTML_tth';
 2316   $out = " $out  " if $displayMode eq 'HTML_dpng';
 2317   $out = " $out  " if $displayMode eq 'HTML_img';
 2318   $out = " $out  " if $displayMode eq 'HTML_jsMath';
 2319   $out = " $out  " if $displayMode eq 'HTML_asciimath';
 2320   $out = " $out  " if $displayMode eq 'HTML_LaTeXMathML';
 2321   $out = " $out  " if $displayMode eq 'Latex2HTML';
 2322     $out;
 2323 }
 2324 
 2325 sub captions {
 2326   my @in = @_;
 2327   my @outlist = ();
 2328   while (@in) {
 2329      push(@outlist,&caption( shift(@in) ) );
 2330   }
 2331   @outlist;
 2332 }
 2333 
 2334 sub imageRow {
 2335 
 2336   my $pImages = shift;
 2337   my $pCaptions=shift;
 2338   my $out = "";
 2339   my @images = @$pImages;
 2340   my @captions = @$pCaptions;
 2341   my $number = @images;
 2342   # standard options
 2343   my %options = ( 'tex_size' => 200,  # width for fitting 4 across
 2344                   'height' => 100,
 2345                   'width' => 100,
 2346                   @_            # overwrite any default options
 2347                 );
 2348 
 2349   if ($displayMode eq 'TeX') {
 2350     $out .= "\n\\par\\smallskip\\begin{center}\\begin{tabular}{"  .  "|c" x $number .  "|} \\hline\n";
 2351     while (@images) {
 2352       $out .= &image( shift(@images),%options ) . '&';
 2353     }
 2354     chop($out);
 2355     $out .= "\\\\ \\hline \n";
 2356     while (@captions) {
 2357       $out .= &caption( shift(@captions) ) . '&';
 2358     }
 2359     chop($out);
 2360     $out .= "\\\\ \\hline \n\\end {tabular}\\end{center}\\par\\smallskip\n";
 2361   } elsif ($displayMode eq 'Latex2HTML'){
 2362 
 2363     $out .= "\n\\begin{rawhtml} <TABLE  BORDER=1><TR>\n\\end{rawhtml}\n";
 2364     while (@images) {
 2365       $out .= "\n\\begin{rawhtml} <TD>\n\\end{rawhtml}\n" . &image( shift(@images),%options )
 2366               . "\n\\begin{rawhtml} </TD>\n\\end{rawhtml}\n" ;
 2367     }
 2368 
 2369     $out .= "\n\\begin{rawhtml}</TR><TR>\\end{rawhtml}\n";
 2370     while (@captions) {
 2371       $out .= "\n\\begin{rawhtml} <TH>\n\\end{rawhtml}\n".&caption( shift(@captions) )
 2372               . "\n\\begin{rawhtml} </TH>\n\\end{rawhtml}\n" ;
 2373     }
 2374 
 2375     $out .= "\n\\begin{rawhtml} </TR> </TABLE >\n\\end{rawhtml}";
 2376   } elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng' ||
 2377      $displayMode eq 'HTML_img' || $displayMode eq 'HTML_jsMath' ||
 2378      $displayMode eq 'HTML_asciimath' || $displayMode eq 'HTML_LaTeXMathML') {
 2379     $out .= "<P>\n <TABLE BORDER=2 CELLPADDING=3 CELLSPACING=2 ><TR ALIGN=CENTER    VALIGN=MIDDLE>\n";
 2380     while (@images) {
 2381       $out .= " \n<TD>". &image( shift(@images),%options ) ."</TD>";
 2382     }
 2383     $out .= "</TR>\n<TR>";
 2384     while (@captions) {
 2385       $out .= " <TH>". &caption( shift(@captions) ) ."</TH>";
 2386     }
 2387     $out .= "\n</TR></TABLE></P>\n"
 2388   }
 2389   else {
 2390     $out = "Error: PGbasicmacros: imageRow: Unknown languageMode: $displayMode.\n";
 2391     warn $out;
 2392   }
 2393   $out;
 2394 }
 2395 
 2396 
 2397 ###########
 2398 # Auxiliary macros
 2399 
 2400 sub display_options2{
 2401   my %options = @_;
 2402   my $out_string = "";
 2403   foreach my $key (keys %options) {
 2404     $out_string .= " $key => $options{$key},<BR>";
 2405   }
 2406   $out_string;
 2407 }
 2408 
 2409 
 2410 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9