[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 6418 - (download) (as text) (annotate)
Tue Sep 7 21:19:14 2010 UTC (9 years, 4 months ago) by apizer
File size: 82924 byte(s)
Add MathJax display mode

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9