[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 3268 - (download) (as text) (annotate)
Sun Jun 5 23:36:28 2005 UTC (14 years, 8 months ago) by dpvc
File size: 66820 byte(s)
Removed some unused lines and comments.
Removed unnecessary spaces from around answer-rule-extension rules,
and made the TeX version of this rule be based on the width, as is
the case for ans_rule.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9