View of /trunk/pg/macros/PGbasicmacros.pl

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