[system] / trunk / webwork / system / courseScripts / PGbasicmacros.pl Repository:
ViewVC logotype

View of /trunk/webwork/system/courseScripts/PGbasicmacros.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 188 - (download) (as text) (annotate)
Tue Sep 4 16:40:58 2001 UTC (18 years, 3 months ago) by gage
File size: 50267 byte(s)
Modifications in these two files make questions whose answer blanks hve
the same names behave properly.

The new versions of CGI seem to return such answers as a reference to an array.
Earlier versions returned the answrs as a string with \0 separators.

With the new changes the AnswerEvaluator get_student_answer subroutine and
the NAMED_ANS_RULE in PGbasicmacros.pl will handle either a null separated
string or an answer array when dealing with vector answers.

This should correct some difficulties experienced in the linear algebra
questions.  More testing needs to be done.

    1 #!/usr/local/bin/webwork-perl
    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=$main::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   $HR,
   52   $LBRACE,
   53   $RBRACE,
   54   $LB,
   55   $RB,
   56   $DOLLAR,
   57   $PERCENT,
   58   $CARET,
   59   $PI,
   60   $E,
   61   @ALPHABET,
   62   );
   63 
   64 sub _PGbasicmacros_init {
   65     $displayMode    =$main::displayMode;
   66   $main::PAR        = PAR();
   67   $main::BR       = BR();
   68   $main::LQ       = LQ();
   69   $main::RQ       = RQ();
   70   $main::BM       = BM();
   71   $main::EM       = EM();
   72   $main::BDM        = BDM();
   73   $main::EDM        = EDM();
   74   $main::LTS        = LTS();
   75   $main::GTS        = GTS();
   76   $main::LTE        = LTE();
   77   $main::GTE        = GTE();
   78   $main::BEGIN_ONE_COLUMN = BEGIN_ONE_COLUMN();
   79   $main::END_ONE_COLUMN = END_ONE_COLUMN();
   80   $main::SOL        = SOLUTION_HEADING();
   81   $main::SOLUTION     = SOLUTION_HEADING();
   82   $main::HINT       = HINT_HEADING();
   83   $main::US       = US();
   84   $main::SPACE      = SPACE();
   85   $main::BBOLD      = BBOLD();
   86   $main::EBOLD      = EBOLD();
   87   $main::HR       = HR();
   88   $main::LBRACE     = LBRACE();
   89   $main::RBRACE     = RBRACE();
   90   $main::LB       = LB();
   91   $main::RB       = RB();
   92   $main::DOLLAR     = DOLLAR();
   93   $main::PERCENT      = PERCENT();
   94   $main::CARET      = CARET();
   95   $main::PI       = PI();
   96   $main::E        = E();
   97   @main::ALPHABET     = ('A'..'ZZ');
   98 
   99   $PAR        = PAR();
  100   $BR       = BR();
  101   $LQ       = LQ();
  102   $RQ       = RQ();
  103   $BM       = BM();
  104   $EM       = EM();
  105   $BDM        = BDM();
  106   $EDM        = EDM();
  107   $LTS        = LTS();
  108   $GTS        = GTS();
  109   $LTE        = LTE();
  110   $GTE        = GTE();
  111   $BEGIN_ONE_COLUMN = BEGIN_ONE_COLUMN();
  112   $END_ONE_COLUMN = END_ONE_COLUMN();
  113   $SOL        = SOLUTION_HEADING();
  114   $SOLUTION     = SOLUTION_HEADING();
  115   $HINT       = HINT_HEADING();
  116   $US       = US();
  117   $SPACE      = SPACE();
  118   $BBOLD      = BBOLD();
  119   $EBOLD      = EBOLD();
  120   $HR       = HR();
  121   $LBRACE     = LBRACE();
  122   $RBRACE     = RBRACE();
  123   $LB       = LB();
  124   $RB       = RB();
  125   $DOLLAR     = DOLLAR();
  126   $PERCENT      = PERCENT();
  127   $CARET      = CARET();
  128   $PI       = PI();
  129   $E        = E();
  130   @ALPHABET     = ('A'..'ZZ');
  131 
  132 
  133 
  134 }
  135 
  136 =head2  Answer blank macros:
  137 
  138 These produce answer blanks of various sizes or pop up lists or radio answer buttons.
  139 The names for the answer blanks are
  140 generated implicitly.
  141 
  142   ans_rule( width )
  143   tex_ans_rule( width )
  144   ans_radio_buttons(value1=>label1, value2,label2 => value3,label3=>...)
  145   pop_up_list(@list)  # list consists of (value => label,  PR => "Product rule",...)
  146 
  147 To indicate the checked position of radio buttons put a '%' in front of the value: C<ans_radio_buttons(1, 'Yes','%2','No')>
  148 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
  149 since this mode produces gif pictures.
  150 
  151 
  152 The following method is defined in F<PG.pl> for entering the answer evaluators corresponding
  153 to answer rules with automatically generated names.  The answer evaluators are matched with the
  154 answer rules in the order in which they appear on the page.
  155 
  156   ANS(ans_evaluator1, ans_evaluator2,...);
  157 
  158 These are more primitive macros which produce answer blanks for specialized cases when complete
  159 control over the matching of answers blanks and answer evaluators is desired.
  160 The names of the answer blanks must be generated manually, and it is best if they do NOT begin
  161 with the default answer prefix (currently AnSwEr).
  162 
  163 
  164   NAMED_ANS_RULE(name, width)
  165   NAMED_ANS_BOX(name, rows, cols)
  166   NAMED_ANS_RADIO(name, value,label,)
  167   NAMED_ANS_RADIO_OPTION(name, value,label)
  168   NAMED_ANS_RADIO_BUTTONS(name,value1,label1,value2,label2,...)
  169   check_box('-name' =>answer5,'-value' =>'statement3','-label' =>'I loved this course!'   )
  170   NAMED_POP_UP_LIST($name, @list) # list consists of (value => tag,  PR => "Product rule",...)
  171 
  172 (Name is the name of the variable, value is the value given to the variable when this option is selected,
  173 and label is the text printed next to the button or check box.    Check box variables can have multiple values.)
  174 
  175 NAMED_ANS_RADIO_BUTTONS creates a sequence of NAMED_ANS_RADIO and NAMED_ANS_RADIO_OPTION  items which
  176 are  output either as an array or, in scalar context, as the array glued together with spaces.  It is
  177 usually easier to use this than to manually construct the radio buttons by hand.  However, sometimes
  178  extra flexibility is desiredin which case:
  179 
  180 When entering radio buttons using the "NAMED" format, you should use NAMED_ANS_RADIO button for the first button
  181 and then use NAMED_ANS_RADIO_OPTION for the remaining buttons.  NAMED_ANS_RADIO requires a matching answer evalutor,
  182 while NAMED_ANS_RADIO_OPTION does not. The name used for NAMED_ANS_RADIO_OPTION should match the name
  183 used for NAMED_ANS_RADIO (and the associated answer evaluator).
  184 
  185 
  186 
  187 The following method is defined in in F<PG.pl> for entering the answer evaluators corresponding
  188 to answer rules with automatically generated names.  The answer evaluators are matched with the
  189 answer rules in the order in which they appear on the page.
  190 
  191       NAMED_ANS(name1 => ans_evaluator1, name2 => ans_evaluator2,...);
  192 
  193 These auxiliary macros are defined in PG.pl
  194 
  195 
  196   NEW_ANS_NAME( number );   # produces a new answer blank name from a number by adding a prefix (AnSwEr)
  197                             # and registers this name as an implicitly labeled answer
  198                             # Its use is paired with each answer evaluator being entered using ANS()
  199 
  200     ANS_NUM_TO_NAME(number);  # adds the prefix (AnSwEr) to the number, but does nothing else.
  201 
  202   RECORD_ANS_NAME( name );  # records the order in which the answer blank  is rendered
  203                             # This is called by all of the constructs above, but must
  204                             # be called explicitly if an input blank is constructed explictly
  205                             # using HTML code.
  206 
  207 These are legacy macros:
  208 
  209   ANS_RULE( number, width );                  # equivalent to NAMED_ANS_RULE( NEW_ANS_NAME(number), width)
  210   ANS_BOX( question_number,height, width );       # equivalent to NAMED_ANS_BOX( NEW_ANS_NAME(number), height, width)
  211   ANS_RADIO( question_number, value,tag );        # equivalent to NAMED_ANS_RADIO( NEW_ANS_NAME(number), value,tag)
  212   ANS_RADIO_OPTION( question_number, value,tag );   # equivalent to NAMED_ANS_RADIO_OPTION( ANS_NUM_TO_NAME(number), value,tag)
  213 
  214 
  215 =cut
  216 
  217 
  218 sub NAMED_ANS_RULE {
  219   my($name,$col) = @_;
  220   my $len = 0.07*$col;
  221   my $answer_value = '';
  222   $answer_value = ${$main::inputs_ref}{$name} if    defined(${$main::inputs_ref}{$name});
  223     if ($answer_value =~ /\0/ ) {
  224       my @answers = split("\0", $answer_value);
  225       $answer_value = shift(@answers);  # use up the first answer
  226       $main::rh_sticky_answers{$name}=\@answers;  # store the rest
  227       $answer_value= '' unless defined($answer_value);
  228   } elsif (ref($answer_value) eq 'ARRAY') {
  229     my @answers = @{ $answer_value};
  230       $answer_value = shift(@answers);  # use up the first answer
  231       $main::rh_sticky_answers{$name}=\@answers;  # store the rest
  232       $answer_value= '' unless defined($answer_value);
  233   }
  234   $name = RECORD_ANS_NAME($name);
  235   MODES(
  236     TeX => "\\mbox{\\parbox[t]{10pt}{\\hrulefill}}\\hrulefill\\quad ",
  237     Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=TEXT SIZE=$col NAME=\"$name\" VALUE = \"\">\n\\end{rawhtml}\n!,
  238     HTML => "<INPUT TYPE=TEXT SIZE=$col NAME=\"$name\" VALUE = \"$answer_value\">\n"
  239   );
  240 }
  241 
  242 sub NAMED_ANS_RULE_OPTION {
  243   &NAMED_ANS_RULE_EXTENSION;
  244 }
  245 
  246 sub NAMED_ANS_RULE_EXTENSION {
  247   my($name,$col) = @_;
  248   my $len = 0.07*$col;
  249   my $answer_value = '';
  250   $answer_value = ${$main::inputs_ref}{$name} if defined(${$main::inputs_ref}{$name});
  251   if ( defined($main::rh_sticky_answers{$name}) ) {
  252     $answer_value = shift( @{$main::rh_sticky_answers{$name}});
  253     $answer_value = '' unless defined($answer_value);
  254   }
  255   MODES(
  256     TeX => '\\hrulefill\\quad ',
  257     Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=TEXT SIZE=$col NAME=\"$name\" VALUE = \"\">\n\\end{rawhtml}\n!,
  258     HTML => qq!<INPUT TYPE=TEXT SIZE=$col NAME = "$name" VALUE = "$answer_value">\n!
  259   );
  260 }
  261 
  262 sub ANS_RULE {
  263   my($number,$col) = @_;
  264   my $name = NEW_ANS_NAME($number);
  265     NAMED_ANS_RULE($name,$col);
  266 }
  267 
  268 
  269 sub  NAMED_ANS_BOX {
  270   my($name,$row,$col) = @_;
  271   $row = 10 unless defined($row);
  272   $col = 80 unless defined($col);
  273   $name = RECORD_ANS_NAME($name);
  274   my $len = 0.07*$col;
  275   my $height = .07*$row;
  276   my $answer_value = '';
  277   $answer_value = $main::inputs_ref->{$name} if defined( $main::inputs_ref->{$name} );
  278   my $out = M3(
  279        qq!\\vskip $height in \\hrulefill\\quad !,
  280        qq!\\begin{rawhtml}<TEXTAREA NAME="$name" ROWS="$row" COLS="$col"
  281                WRAP="VIRTUAL">$answer_value</TEXTAREA>\\end{rawhtml}!,
  282          qq!<TEXTAREA NAME="$name" ROWS="$row" COLS="$col"
  283                WRAP="VIRTUAL">$answer_value</TEXTAREA>!
  284          );
  285   $out;
  286 }
  287 
  288 sub  ANS_BOX {
  289   my($number,$row,$col) = @_;
  290   my $name = NEW_ANS_NAME($number);
  291     NAMED_ANS_BOX($name,$row,$col);
  292 }
  293 
  294 sub NAMED_ANS_RADIO {
  295   my $name = shift;
  296   my $value = shift;
  297     my $tag =shift;
  298     $name = RECORD_ANS_NAME($name);
  299     my $checked = '';
  300     if ($value =~/^\%/) {
  301       $value =~ s/^\%//;
  302       $checked = 'CHECKED'
  303     }
  304   if (defined($main::inputs_ref->{$name}) ) {
  305     if ($main::inputs_ref->{$name} eq $value) {
  306       $checked = 'CHECKED'
  307     } else {
  308       $checked = '';
  309     }
  310 
  311     }
  312 
  313   MODES(
  314     TeX => qq!\\item{$tag}\n!,
  315     Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=RADIO NAME="$name" VALUE="$value" $checked>\\end{rawhtml}$tag!,
  316     HTML => qq!<INPUT TYPE=RADIO NAME="$name" VALUE="$value" $checked>$tag!
  317   );
  318 
  319 }
  320 
  321 sub NAMED_ANS_RADIO_OPTION {
  322   my $name = shift;
  323   my $value = shift;
  324   my $tag =shift;
  325 
  326 
  327     my $checked = '';
  328     if ($value =~/^\%/) {
  329       $value =~ s/^\%//;
  330       $checked = 'CHECKED'
  331     }
  332   if (defined($main::inputs_ref->{$name}) ) {
  333     if ($main::inputs_ref->{$name} eq $value) {
  334       $checked = 'CHECKED'
  335     } else {
  336       $checked = '';
  337     }
  338 
  339     }
  340 
  341   MODES(
  342     TeX => qq!\\item{$tag}\n!,
  343     Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=RADIO NAME="$name" VALUE="$value" $checked>\\end{rawhtml}$tag!,
  344     HTML => qq!<INPUT TYPE=RADIO NAME="$name" VALUE="$value" $checked>$tag!
  345   );
  346 
  347 }
  348 
  349 sub NAMED_ANS_RADIO_BUTTONS {
  350     my $name  =shift;
  351     my $value = shift;
  352     my $tag = shift;
  353 
  354 
  355   my @out = ();
  356   push(@out, NAMED_ANS_RADIO($name, $value,$tag));
  357   my @buttons = @_;
  358   while (@buttons) {
  359     $value = shift @buttons;  $tag = shift @buttons;
  360     push(@out, NAMED_ANS_RADIO_OPTION($name, $value,$tag));
  361   }
  362   (wantarray) ? @out : join(" ",@out);
  363 }
  364 sub ANS_RADIO {
  365   my $number = shift;
  366   my $value = shift;
  367   my $tag =shift;
  368     my $name = NEW_ANS_NAME($number);
  369   NAMED_ANS_RADIO($name,$value,$tag);
  370 }
  371 
  372 sub ANS_RADIO_OPTION {
  373   my $number = shift;
  374   my $value = shift;
  375   my $tag =shift;
  376 
  377 
  378     my $name = ANS_NUM_TO_NAME($number);
  379   NAMED_ANS_RADIO_OPTION($name,$value,$tag);
  380 }
  381 sub ANS_RADIO_BUTTONS {
  382     my $number  =shift;
  383     my $value = shift;
  384     my $tag = shift;
  385 
  386 
  387   my @out = ();
  388   push(@out, ANS_RADIO($number, $value,$tag));
  389   my @buttons = @_;
  390   while (@buttons) {
  391       $value = shift @buttons; $tag = shift @buttons;
  392     push(@out, ANS_RADIO_OPTION($number, $value,$tag));
  393   }
  394   (wantarray) ? @out : join(" ",@out);
  395 }
  396 
  397 sub NAMED_ANS_CHECKBOX {
  398   my $name = shift;
  399   my $value = shift;
  400     my $tag =shift;
  401     $name = RECORD_ANS_NAME($name);
  402 
  403     my $checked = '';
  404     if ($value =~/^\%/) {
  405       $value =~ s/^\%//;
  406       $checked = 'CHECKED'
  407     }
  408 
  409   if (defined($main::inputs_ref->{$name}) ) {
  410     if ($main::inputs_ref->{$name} eq $value) {
  411       $checked = 'CHECKED'
  412     }
  413     else {
  414       $checked = '';
  415     }
  416 
  417     }
  418 
  419   MODES(
  420     TeX => qq!\\item{$tag}\n!,
  421     Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=CHECKBOX NAME="$name" VALUE="$value" $checked>\\end{rawhtml}$tag!,
  422     HTML => qq!<INPUT TYPE=CHECKBOX NAME="$name" VALUE="$value" $checked>$tag!
  423   );
  424 
  425 }
  426 
  427 sub NAMED_ANS_CHECKBOX_OPTION {
  428   my $name = shift;
  429   my $value = shift;
  430   my $tag =shift;
  431 
  432     my $checked = '';
  433     if ($value =~/^\%/) {
  434       $value =~ s/^\%//;
  435       $checked = 'CHECKED'
  436     }
  437 
  438   if (defined($main::inputs_ref->{$name}) ) {
  439     if ($main::inputs_ref->{$name} eq $value) {
  440       $checked = 'CHECKED'
  441     }
  442     else {
  443       $checked = '';
  444     }
  445 
  446     }
  447 
  448   MODES(
  449     TeX => qq!\\item{$tag}\n!,
  450     Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=CHECKBOX NAME="$name" VALUE="$value" $checked>\\end{rawhtml}$tag!,
  451     HTML => qq!<INPUT TYPE=CHECKBOX NAME="$name" VALUE="$value" $checked>$tag!
  452   );
  453 
  454 }
  455 
  456 sub NAMED_ANS_CHECKBOX_BUTTONS {
  457     my $name  =shift;
  458     my $value = shift;
  459     my $tag = shift;
  460 
  461   my @out = ();
  462   push(@out, NAMED_ANS_CHECKBOX($name, $value,$tag));
  463 
  464   my @buttons = @_;
  465   while (@buttons) {
  466     $value = shift @buttons;  $tag = shift @buttons;
  467     push(@out, NAMED_ANS_CHECKBOX_OPTION($name, $value,$tag));
  468   }
  469 
  470   (wantarray) ? @out : join(" ",@out);
  471 }
  472 
  473 sub ANS_CHECKBOX {
  474   my $number = shift;
  475   my $value = shift;
  476   my $tag =shift;
  477     my $name = NEW_ANS_NAME($number);
  478 
  479   NAMED_ANS_CHECKBOX($name,$value,$tag);
  480 }
  481 
  482 sub ANS_CHECKBOX_OPTION {
  483   my $number = shift;
  484   my $value = shift;
  485   my $tag =shift;
  486     my $name = ANS_NUM_TO_NAME($number);
  487 
  488   NAMED_ANS_CHECKBOX_OPTION($name,$value,$tag);
  489 }
  490 
  491 sub ANS_CHECKBOX_BUTTONS {
  492     my $number  =shift;
  493     my $value = shift;
  494     my $tag = shift;
  495 
  496   my @out = ();
  497   push(@out, ANS_CHECKBOX($number, $value, $tag));
  498 
  499   my @buttons = @_;
  500   while (@buttons) {
  501     $value = shift @buttons;  $tag = shift @buttons;
  502     push(@out, ANS_CHECKBOX_OPTION($number, $value,$tag));
  503   }
  504 
  505   (wantarray) ? @out : join(" ",@out);
  506 }
  507 
  508 sub ans_rule {
  509   my $len = shift;     # gives the optional length of the answer blank
  510   $len    = 20 unless $len ;
  511   my $name = NEW_ANS_NAME(++$main::ans_rule_count);
  512   NAMED_ANS_RULE($name ,$len);
  513 }
  514 sub ans_rule_extension {
  515   my $len = shift;
  516     $len    = 20 unless $len ;
  517   my $name = NEW_ANS_NAME($main::ans_rule_count);  # don't update the answer name
  518   NAMED_ANS_RULE($name ,$len);
  519 }
  520 sub ans_radio_buttons {
  521   my $name  = NEW_ANS_NAME(++$main::ans_rule_count);
  522   my @radio_buttons = NAMED_ANS_RADIO_BUTTONS($name, @_);
  523 
  524   if ($displayMode eq 'TeX') {
  525     $radio_buttons[0] = "\n\\begin{itemize}\n" . $radio_buttons[0];
  526     $radio_buttons[$#radio_buttons] .= "\n\\end{itemize}\n";
  527   }
  528 
  529   (wantarray) ? @radio_buttons: join(" ", @radio_buttons);
  530 }
  531 
  532 #added 6/14/2000 by David Etlinger
  533 sub ans_checkbox {
  534   my $name = NEW_ANS_NAME( ++$main::ans_rule_count );
  535   my @checkboxes = NAMED_ANS_CHECKBOX_BUTTONS( $name, @_ );
  536 
  537   if ($displayMode eq 'TeX') {
  538     $checkboxes[0] = "\n\\begin{itemize}\n" . $checkboxes[0];
  539     $checkboxes[$#checkboxes] .= "\n\\end{itemize}\n";
  540   }
  541 
  542   (wantarray) ? @checkboxes: join(" ", @checkboxes);
  543 }
  544 
  545 
  546 ## define a version of ans_rule which will work inside TeX math mode or display math mode -- at least for tth mode.
  547 ## This is great for displayed fractions.
  548 ## This will not work with latex2HTML mode since it creates gif equations.
  549 
  550 sub tex_ans_rule {
  551   my $len = shift;
  552   $len    = 20 unless $len ;
  553     my $name = NEW_ANS_NAME(++$main::ans_rule_count);
  554     my $answer_rule = NAMED_ANS_RULE($name ,$len);  # we don't want to create three answer rules in different modes.
  555     my $out = MODES(
  556                      'TeX' => $answer_rule,
  557                      'Latex2HTML' => '\\fbox{Answer boxes cannot be placed inside typeset equations}',
  558                      'HTML_tth' => '\\begin{rawhtml} '. $answer_rule.'\\end{rawhtml}',
  559                      'HTML'     => $answer_rule
  560                    );
  561 
  562     $out;
  563 }
  564 sub tex_ans_rule_extension {
  565   my $len = shift;
  566   $len    = 20 unless $len ;
  567     my $name = NEW_ANS_NAME($main::ans_rule_count);
  568     my $answer_rule = NAMED_ANS_RULE($name ,$len);  # we don't want to create three answer rules in different modes.
  569     my $out = MODES(
  570                      'TeX' => $answer_rule,
  571                      'Latex2HTML' => '\fbox{Answer boxes cannot be placed inside typeset equations}',
  572                      'HTML_tth' => '\\begin{rawhtml} '. $answer_rule.'\\end{rawhtml}',
  573                      'HTML'     => $answer_rule
  574                    );
  575 
  576     $out;
  577 }
  578 # still needs some cleanup.
  579 sub NAMED_TEX_ANS_RULE {
  580     my $name = shift;
  581   my $len = shift;
  582   $len    = 20 unless $len ;
  583     my $answer_rule = NAMED_ANS_RULE($name ,$len);  # we don't want to create three answer rules in different modes.
  584     my $out = MODES(
  585                      'TeX' => $answer_rule,
  586                      'Latex2HTML' => '\\fbox{Answer boxes cannot be placed inside typeset equations}',
  587                      'HTML_tth' => '\\begin{rawhtml} '. $answer_rule.'\\end{rawhtml}',
  588                      'HTML'     => $answer_rule
  589                    );
  590 
  591     $out;
  592 }
  593 sub NAMED_TEX_ANS_RULE_EXTENSION {
  594   my $name = shift;
  595   my $len = shift;
  596   $len    = 20 unless $len ;
  597     my $answer_rule = NAMED_ANS_RULE_EXTENSION($name ,$len);  # we don't want to create three answer rules in different modes.
  598     my $out = MODES(
  599                      'TeX' => $answer_rule,
  600                      'Latex2HTML' => '\fbox{Answer boxes cannot be placed inside typeset equations}',
  601                      'HTML_tth' => '\\begin{rawhtml} '. $answer_rule.'\\end{rawhtml}',
  602                      'HTML'     => $answer_rule
  603                    );
  604 
  605     $out;
  606 }
  607 sub ans_box {
  608   my $row = shift;
  609   my $col =shift;
  610   $row = 5 unless $row;
  611   $col = 80 unless $col;
  612   my $name = NEW_ANS_NAME(++$main::ans_rule_count);
  613   NAMED_ANS_BOX($name ,$row,$col);
  614 }
  615 
  616 #this is legacy code; use ans_checkbox instead
  617 sub checkbox {
  618   my %options = @_;
  619   qq!<INPUT TYPE="checkbox" NAME="$options{'-name'}" VALUE="$options{'-value'}">$options{'-label'}!
  620 }
  621 
  622 
  623 sub NAMED_POP_UP_LIST {
  624     my $name = shift;
  625   my @list = @_;
  626   $name = RECORD_ANS_NAME($name);   # record answer name
  627     my $answer_value = '';
  628   $answer_value = ${$main::inputs_ref}{$name} if defined(${$main::inputs_ref}{$name});
  629   my $out = "";
  630   if ($displayMode eq "HTML" or $displayMode eq "HTML_tth") {
  631     $out = qq!<SELECT NAME = "$name" SIZE=1> \n!;
  632     my $i;
  633     foreach ($i=0; $i< @list; $i=$i+2) {
  634       my $select_flag = ($list[$i] eq $answer_value) ? "SELECTED" : "";
  635       $out .= qq!<OPTION $select_flag VALUE ="$list[$i]" > $list[$i+1]  </OPTION>\n!;
  636     };
  637     $out .= " </SELECT>\n";
  638   } elsif ( $displayMode eq "Latex2HTML") {
  639     $out = qq! \\begin{rawhtml}<SELECT NAME = "$name" SIZE=1> \\end{rawhtml} \n !;
  640     my $i;
  641     foreach ($i=0; $i< @list; $i=$i+2) {
  642       my $select_flag = ($list[$i] eq $answer_value) ? "SELECTED" : "";
  643       $out .= qq!\\begin{rawhtml}<OPTION $select_flag VALUE ="$list[$i]" > $list[$i+1]  </OPTION>\\end{rawhtml}\n!;
  644     };
  645     $out .= " \\begin{rawhtml}</SELECT>\\end{rawhtml}\n";
  646   } elsif ( $displayMode eq "TeX") {
  647       $out .= "\\fbox{?}";
  648   }
  649 
  650 }
  651 
  652 sub pop_up_list {
  653   my @list = @_;
  654   my $name = NEW_ANS_NAME(++$main::ans_rule_count);  # get new answer name
  655   NAMED_POP_UP_LIST($name, @list);
  656 }
  657 
  658 # end answer blank macros
  659 
  660 =head2 Hints and solutions macros
  661 
  662   solution('text','text2',...);
  663   SOLUTION('text','text2',...);   # equivalent to TEXT(solution(...));
  664 
  665   hint('text', 'text2', ...);
  666   HINT('text', 'text2',...);      # equivalent to TEXT("$BR$HINT" . hint(@_) . "$BR") if hint(@_);
  667 
  668 Solution prints its concatenated input when the check box named 'ShowSol' is set and
  669 the time is after the answer date.  The check box 'ShowSol' is visible only after the
  670 answer date or when the problem is viewed by a professor.
  671 
  672 $envir{'displaySolutionsQ'} is set to 1 when a solution is to be displayed.
  673 
  674 Hints are shown only after the number of attempts is greater than $:showHint
  675 ($main::showHint defaults to 1) and the check box named 'ShowHint' is set. The check box
  676 'ShowHint' is visible only after the number of attempts is greater than $main::showHint.
  677 
  678 $envir{'displayHintsQ'} is set to 1 when a hint is to be displayed.
  679 
  680 
  681 =cut
  682 
  683 
  684 
  685 #   solution prints its input when $displaySolutionsQ is set.
  686 #   use as TEXT(solution("blah, blah");
  687 #   \$solutionExists
  688 #   is passed to processProblem which displays a "show Solution" button
  689 #   when a solution is available for viewing
  690 
  691 
  692 sub solution {
  693   my @in = @_;
  694   my $out = '';
  695   $main::solutionExists =1;
  696   if ($envir{'displaySolutionsQ'}) {$out = join(' ',@in);}
  697     $out;
  698 }
  699 
  700 
  701 sub SOLUTION {
  702   TEXT( solution(@_)) ;
  703 }
  704 
  705 
  706 
  707 sub hint {
  708     my @in = @_;
  709   my $out = '';
  710 
  711   $main::hintExists =1;
  712     $main::numOfAttempts = 0 unless defined($main::numOfAttempts);
  713 
  714   if ($main::displayMode eq 'TeX')   {
  715     $out = '';  # do nothing since hints are not available for download
  716   } elsif (($envir{'displayHintsQ'}) and ($main::numOfAttempts >= $main::showHint))
  717 
  718    ## the second test above prevents a hint being shown if a doctored form is submitted
  719 
  720   {$out = join(' ',@in);}    # show hint
  721 
  722   $out ;
  723 }
  724 
  725 
  726 sub HINT {
  727     TEXT("$main::BR" . hint(@_) . "$main::BR") if hint(@_);
  728 }
  729 
  730 
  731 
  732 # End hints and solutions macros
  733 #################################
  734 
  735 # Produces a random number between $begin and $end with increment 1.
  736 # You do not have to worry about integer or floating point types.
  737 
  738 =head2 Pseudo-random number generator
  739 
  740   Usage:
  741   random(0,5,.1)      # produces a random number between 0 and 5 in increments of .1
  742   non_zero_random(0,5,.1) # gives a non-zero random number
  743 
  744   SRAND(seed)     # resets the main random generator -- use very cautiously
  745 
  746 
  747 SRAND(time) will create a different problem everytime it is called.  This makes it difficult
  748 to check the answers :-).
  749 
  750 SRAND($envir{'inputs_ref'}->{'key'} ) will create a different problem for each login session.
  751 This is probably what is desired.
  752 
  753 =cut
  754 
  755 
  756 sub random  {
  757   my ($begin, $end, $incr) = @_;
  758   $main::PG_random_generator->random($begin,$end,$incr);
  759 }
  760 
  761 
  762 sub non_zero_random { ##gives a non-zero random number
  763   my (@arguments)=@_;
  764   my $a=0;
  765   my $i=100; #safety counter
  766   while ($a==0 && ( 0 < $i-- ) ) {
  767     $a=random(@arguments);
  768   }
  769   $a;
  770 }
  771 
  772 sub SRAND { # resets the main random generator -- use cautiously
  773     my $seed = shift;
  774   $main::PG_random_generator -> srand($seed);
  775 }
  776 
  777 # display macros
  778 
  779 =head2 Display Macros
  780 
  781 These macros produce different output depending on the display mode being used to show
  782 the problem on the screen, or whether the problem is being converted to TeX to produce
  783 a hard copy output.
  784 
  785   MODES   ( TeX =>        "Output this in TeX mode",
  786             HTML =>       "output this in HTML mode",
  787             HTML_tth =>   "output this in HTML_tth mode",
  788             Latex2HTML => "output this in Latex2HTML mode",
  789            )
  790 
  791   TEX     (tex_version, html_version) #obsolete
  792 
  793   M3      (tex_version, latex2html_version, html_version) #obsolete
  794 
  795 
  796 
  797 =cut
  798 
  799 
  800 sub TEX {
  801   my ($tex, $html ) = @_;
  802   MODES(TeX => $tex, HTML => $html, HTML_tth => $html);
  803 }
  804 
  805 
  806 sub M3 {
  807   my($tex,$l2h,$html) = @_;
  808   MODES(TeX => $tex, Latex2HTML => $l2h, HTML => $html, HTML_tth => $html);
  809 }
  810 
  811 # This replaces M3.  You can add new modes at will to this one.
  812 
  813 sub MODES {
  814   my %options = @_;
  815   return $options{$displayMode}
  816              if defined( $options{$displayMode} );
  817 
  818   # default searches.
  819   if ($displayMode eq "Latex2HTML") {
  820     return $options{TeX}
  821              if defined( $options{TeX} );
  822       return $options{HTML}
  823              if defined( $options{HTML} );
  824       die " ERROR in using MODES: 'HTML' and 'TeX' options not defined for 'Latex2HTML'";
  825   }
  826 
  827   if ($displayMode eq "HTML_tth") {
  828     return $options{HTML}
  829              if defined( $options{HTML} );
  830       die " ERROR in using MODES: 'HTML' option not defined for HTML_tth";
  831 
  832   }
  833 
  834   # trap undefined errors
  835   die "ERROR in defining MODES:  Can't find |$displayMode| among
  836            available options:" . join(" ", keys(%options) )
  837            . " file " . __FILE__ ." line " . __LINE__."\n\n";
  838 
  839 }
  840 
  841 
  842 # end display macros
  843 
  844 
  845 =head2  Display constants
  846 
  847   @ALPHABET       ALPHABET()      capital letter alphabet -- ALPHABET[0] = 'A'
  848   $PAR        PAR()       paragraph character (\par or <p>)
  849   $BR             BR()        line break character
  850   $LQ         LQ()        left double quote
  851   $RQ         RQ()        right double quote
  852   $BM         BM()        begin math
  853   $EM         EM()        end math
  854   $BDM        BDM()       begin display math
  855   $EDM        EDM()       end display math
  856   $LTS        LTS()       strictly less than
  857   $GTS        GTS()       strictly greater than
  858   $LTE        LTE()       less than or equal
  859   $GTE        GTE()       greater than or equal
  860   $BEGIN_ONE_COLUMN BEGIN_ONE_COLUMN()  begin one-column mode
  861   $END_ONE_COLUMN   END_ONE_COLUMN()  end one-column mode
  862   $SOL        SOLUTION_HEADING()  solution headline
  863   $SOLUTION     SOLUTION_HEADING()  solution headline
  864   $HINT       HINT_HEADING()    hint headline
  865   $US         US()        underscore character
  866   $SPACE        SPACE()       space character (tex and latex only)
  867   $BBOLD        BBOLD()       begin bold typeface
  868   $EBOLD        EBOLD()       end bold typeface
  869   $HR         HR()        horizontal rule
  870   $LBRACE       LBRACE()      left brace
  871   $LB         LB ()       left brace
  872   $RBRACE       RBRACE()      right brace
  873   $RB         RB ()       right brace
  874   $DOLLAR       DOLLAR()      a dollar sign
  875   $PERCENT      PERCENT()     a percent sign
  876   $CARET        CARET()       a caret sign
  877   $PI         PI()        the number pi
  878   $E          E()         the number e
  879 
  880 =cut
  881 
  882 
  883 
  884 
  885 
  886 # A utility variable.  Notice that "B"=$ALPHABET[1] and
  887 # "ABCD"=@ALPHABET[0..3].
  888 
  889 sub ALPHABET  {
  890   ('A'..'ZZ')[@_];
  891 }
  892 
  893 ###############################################################
  894 # Some constants which are different in tex and in HTML
  895 # The order of arguments is TeX, Latex2HTML, HTML
  896 sub PAR { MODES( TeX => '\\par ',Latex2HTML => '\\par ',HTML => '<P>' ); };
  897 sub BR { MODES( TeX => '\\par\\noindent ',Latex2HTML => '\\par\\noindent ',HTML => '<BR>'); };
  898 sub LQ { MODES( TeX => "``", Latex2HTML =>   '"',  HTML =>  '&quot;' ); };
  899 sub RQ { MODES( TeX => "''", Latex2HTML =>   '"',   HTML =>  '&quot;' ); };
  900 sub BM { MODES(TeX => '\\(', Latex2HTML => '\\(', HTML =>  ''); };  # begin math mode
  901 sub EM { MODES(TeX => '\\)', Latex2HTML => '\\)', HTML => ''); };  # end math mode
  902 sub BDM { MODES(TeX => '\\[', Latex2HTML =>   '\\[', HTML =>   '<P ALIGN=CENTER>'); };  #begin displayMath mode
  903 sub EDM { MODES(TeX => '\\]',  Latex2HTML =>  '\\]', HTML => '</P>'); };              #end displayMath mode
  904 sub LTS { MODES(TeX => ' < ', Latex2HTML => ' \\lt ',  HTML =>   '&lt;'); };
  905 sub GTS {MODES(TeX => ' > ', Latex2HTML => ' \\gt ',  HTML =>    '&gt;'); };
  906 sub LTE { MODES(TeX => ' \\le ', Latex2HTML =>  ' \\le ',  HTML => '&lt;=' ); };
  907 sub GTE { MODES(TeX => ' \\ge ',  Latex2HTML => ' \\ge ',  HTML =>  '&gt;'); };
  908 sub BEGIN_ONE_COLUMN { MODES(TeX => " \\end{multicols}\n",  Latex2HTML => " ", HTML =>   " "); };
  909 sub END_ONE_COLUMN { MODES(TeX =>
  910               " \\begin{multicols}{2}\n\\columnwidth=\\linewidth\n",
  911                             Latex2HTML => ' ', HTML => ' ');
  912 
  913 };
  914 sub SOLUTION_HEADING { MODES( TeX => '\\par {\\bf Solution:}',
  915                  Latex2HTML => '\\par {\\bf Solution:}',
  916                HTML =>  '<P><B>Solution:</B>');
  917               };
  918 sub HINT_HEADING { MODES( TeX => "\\par {\\bf Hint:}", Latex2HTML => "\\par {\\bf Hint:}", HTML => "<P><B>Hint:</B>"); };
  919 sub US { MODES(TeX => '\\_', Latex2HTML => '\\_', HTML => '_');};  # underscore, e.g. file${US}name
  920 sub SPACE { MODES(TeX => '\\ ',  Latex2HTML => '\\ ', HTML => '&nbsp;');};  # force a space in latex, doesn't force extra space in html
  921 sub BBOLD { MODES(TeX => '{\\bf ',  Latex2HTML => '{\\bf ', HTML => '<B>'); };
  922 sub EBOLD { MODES( TeX => '}', Latex2HTML =>  '}',HTML =>  '</B>'); };
  923 sub HR { MODES(TeX => '\\par\\hrulefill\\par ', Latex2HTML => '\\begin{rawhtml} <HR> \\end{rawhtml}', HTML =>  '<HR>'); };
  924 sub LBRACE { MODES( TeX => '\{', Latex2HTML =>   '\\lbrace',  HTML =>  '\{' , HTML_tth=> '\\lbrace' ); };
  925 sub RBRACE { MODES( TeX => '\}', Latex2HTML =>   '\\rbrace',  HTML =>  '\}' , HTML_tth=> '\\rbrace',); };
  926 sub LB { MODES( TeX => '\{', Latex2HTML =>   '\\lbrace',  HTML =>  '\{' , HTML_tth=> '\\lbrace' ); };
  927 sub RB { MODES( TeX => '\}', Latex2HTML =>   '\\rbrace',  HTML =>  '\}' , HTML_tth=> '\\rbrace',); };
  928 sub DOLLAR { MODES( TeX => '\\$', Latex2HTML => '\\$', HTML => '$' ); };
  929 sub PERCENT { MODES( TeX => '\\%', Latex2HTML => '\\%', HTML => '%' ); };
  930 sub CARET { MODES( TeX => '\\^', Latex2HTML => '\\^', HTML => '^' ); };
  931 sub PI {4*atan2(1,1);};
  932 sub E {exp(1);};
  933 
  934 ###############################################################
  935 ## Evaluation macros
  936 
  937 
  938 =head2 TEXT macros
  939 
  940   Usage:
  941     TEXT(@text);
  942 
  943 This is the simplest way to print text from a problem.  The strings in the array C<@text> are concatenated
  944 with spaces between them and printed out in the text of the problem.  The text is not processed in any other way.
  945 C<TEXT> is defined in PG.pl.
  946 
  947   Usage:
  948     BEGIN_TEXT
  949       text.....
  950     END_TEXT
  951 
  952 This is the most common way to enter text into the problem.  All of the text between BEGIN_TEXT and END_TEXT
  953 is processed by the C<EV3> macro described below and then printed using the C<TEXT> command.  The two key words
  954 must appear on lines by themselves.  The preprocessing that makes this construction work is done in F<PGtranslator.pm>.
  955 See C<EV3> below for details on the processing.
  956 
  957 
  958 =cut
  959 
  960 =head2 Evaluation macros
  961 
  962 =head3 EV3
  963 
  964         TEXT(EV3("This is a formulat \( \int_0^5 x^2 \, dx \) ");
  965         TEXT(EV3(@text));
  966 
  967     TEXT(EV3(<<'END_TEXT'));
  968       text stuff...
  969     END_TEXT
  970 
  971 
  972 The BEGIN_TEXT/END_TEXT construction is translated into the construction above by PGtranslator.pm.  END_TEXT must appear
  973 on a line by itself and be left justified.  (The << construction is known as a "here document" in UNIX and in PERL.)
  974 
  975 The single quotes around END_TEXT mean that no automatic interpolation of variables takes place in the text.
  976 Using EV3 with strings which have been evaluated by double quotes may lead to unexpected results.
  977 
  978 
  979 The evaluation macro E3 first evaluates perl code inside the braces:  C<\{  code \}>.
  980 Any perl statment can be put inside the braces.  The
  981 result of the evaluation (i.e. the last statement evaluated) replaces the C<\{ code \}> construction.
  982 
  983 Next interpolation of all variables (e.g. C<$var or @array> ) is performed.
  984 
  985 Then mathematical formulas in TeX are evaluated within the
  986 C<\(  tex math mode \)> and
  987 C<\[ tex display math mode \] >
  988 constructions, in that order:
  989 
  990 =head3 FEQ
  991 
  992   FEQ($string);   # processes and outputs the string
  993 
  994 
  995 The mathematical formulas are run through the macro C<FEQ> (Format EQuations) which performs
  996 several substitutions (see below).
  997 In C<HTML_tth> mode the resulting code is processed by tth to obtain an HTML version
  998 of the formula. (In the future processing by WebEQ may be added here as another option.)
  999 The Latex2HTML mode does nothing
 1000 at this stage; it creates the entire problem before running it through
 1001 TeX and creating the GIF images of the equations.
 1002 
 1003 The resulting string is output (and usually fed into TEXT to be printed in the problem).
 1004 
 1005   Usage:
 1006 
 1007     $string2 = FEQ($string1);
 1008 
 1009 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
 1010 understood with an example.
 1011 
 1012     $string1 = "${a}x^2 + ${b}x + {$c:%.1f}"; $a = 3;, $b = -2; $c = -7.345;
 1013 
 1014 when interpolated becomes:
 1015 
 1016     $string1 = '3x^2 + -2x + {-7.345:%0.1f}
 1017 
 1018 FEQ first changes the number of decimal places displayed, so that the last term becomes -7.3 Then it removes the
 1019 extraneous plus and minus signs, so that the final result is what you want:
 1020 
 1021     $string2 = '3x^2 - 2x -7.3';
 1022 
 1023 (The %0.1f construction
 1024 is the same formatting convention used by Perl and nearly identical to the one used by the C printf statement. Some common
 1025 usage:  %0.3f 3 decimal places, fixed notation; %0.3e 3 significant figures exponential notation; %0.3g uses either fixed
 1026 or exponential notation depending on the size of the number.)
 1027 
 1028 Two additional legacy formatting constructions are also supported:
 1029 
 1030 C<?{$c:%0.3f} > will give a number with 3 decimal places and a negative
 1031 sign if the number is negative, no sign if the number is positive.
 1032 
 1033 C<!{$c:%0.3f}> determines the sign and prints it
 1034 whether the number is positive or negative.
 1035 
 1036 =head3 EV2
 1037 
 1038     TEXT(EV2(@text));
 1039 
 1040     TEXT(EV2(<<END_OF_TEXT));
 1041       text stuff...
 1042     END_OF_TEXT
 1043 
 1044 This is a precursor to EV3.  In this case the constants are interpolated first, before the evaluation of the \{ ...code...\}
 1045 construct. This can lead to unexpected results.  For example C<\{ join(" ", @text) \}> with C<@text = ("Hello","World);> becomes,
 1046 after interpolation, C<\{ join(" ",Hello World) \}> which then causes an error when evaluated because Hello is a bare word.
 1047 C<EV2> can still be useful if you allow for this, and in particular it works on double quoted strings, which lead to
 1048 unexpected results with C<EV3>. Using single quoted strings with C<EV2> may lead to unexpected results.
 1049 
 1050 The unexpected results have to do with the number of times backslashed constructions have to be escaped. It's quite messy.  For
 1051 more details get a good Perl book and then read the code. :-)
 1052 
 1053 
 1054 
 1055 
 1056 =cut
 1057 
 1058 
 1059 sub ev_substring {
 1060     my $string      = shift;
 1061   my $start_delim = shift;
 1062   my $end_delim   = shift;
 1063   my $actionRef   = shift;
 1064   my ($eval_out,$PG_eval_errors,$PG_full_error_report)=();
 1065     my $out = "";
 1066     while ($string) {
 1067         if ($string =~ /\Q$start_delim\E/s) {
 1068        #print "$start_delim $end_delim evaluating_substring=$string<BR>";
 1069         $string =~ s/^(.*?)\Q$start_delim\E//s;  # get string up to next \{ ---treats string as a single line, ignoring returns
 1070         $out .= $1;
 1071        #print "$start_delim $end_delim substring_out=$out<BR>";
 1072         $string =~ s/^(.*?)\Q$end_delim\E//s;  # get perl code up to \} ---treats string as a single line,  ignoring returns
 1073            #print "$start_delim $end_delim evaluate_string=$1<BR>";
 1074         ($eval_out,$PG_eval_errors,$PG_full_error_report) = &$actionRef($1);
 1075         $eval_out = "$start_delim $eval_out $end_delim" if $PG_full_error_report;
 1076         $out = $out . $eval_out;
 1077        #print "$start_delim $end_delim new substring_out=$out<BR><p><BR>";
 1078         $out .="$main::PAR ERROR $0 in ev_substring, PGbasicmacros.pl:$main::PAR <PRE>  $@ </PRE>$main::PAR" if $@;
 1079         }
 1080       else {
 1081         $out .= $string;  # flush the last part of the string
 1082         last;
 1083         }
 1084 
 1085       }
 1086   $out;
 1087 }
 1088 sub  safe_ev {
 1089     my ($out,$PG_eval_errors,$PG_full_error_report) = &old_safe_ev;   # process input by old_safe_ev first
 1090     $out =~s/\\/\\\\/g;   # protect any new backslashes introduced.
 1091   ($out,$PG_eval_errors,$PG_full_error_report)
 1092 }
 1093 
 1094 sub  old_safe_ev {
 1095     my $in = shift;
 1096     my   ($out,$PG_eval_errors,$PG_full_error_report) = PG_restricted_eval("$in;");
 1097     # the addition of the ; seems to provide better error reporting
 1098     if ($PG_eval_errors) {
 1099       my @errorLines = split("\n",$PG_eval_errors);
 1100     #$out = "<PRE>$main::PAR % ERROR in $0:old_safe_ev, PGbasicmacros.pl: $main::PAR % There is an error occuring inside evaluation brackets \\{ ...code... \\} $main::BR % somewhere in an EV2 or EV3 or BEGIN_TEXT block. $main::BR % Code evaluated:$main::BR $in $main::BR % $main::BR % $errorLines[0]\n % $errorLines[1]$main::BR % $main::BR % $main::BR </PRE> ";
 1101     warn " ERROR in old_safe_ev, PGbasicmacros.pl: <PRE>
 1102      ## There is an error occuring inside evaluation brackets \\{ ...code... \\}
 1103      ## somewhere in an EV2 or EV3 or BEGIN_TEXT block.
 1104      ## Code evaluated:
 1105      ## $in
 1106      ##" .join("\n     ", @errorLines). "
 1107      ##</PRE>$main::BR
 1108      ";
 1109      $out ="$main::PAR $main::BBOLD  $in $main::EBOLD $main::PAR";
 1110 
 1111 
 1112   }
 1113 
 1114   ($out,$PG_eval_errors,$PG_full_error_report);
 1115 }
 1116 
 1117 sub FEQ   {    # Format EQuations
 1118   my $in = shift;
 1119    # formatting numbers -- the ?{} and !{} constructions
 1120   $in =~s/\?\s*\{([.\-\$\w\d]+):?([%.\da-z]*)\}/${ \( &sspf($1,$2) )}/g;
 1121   $in =~s/\!\s*\{([.\-\$\w\d]+):?([%.\da-z]*)\}/${ \( &spf($1,$2) )}/g;
 1122 
 1123   # more formatting numbers -- {number:format} constructions
 1124   $in =~ s/\{(\s*[\+\-\d\.]+[eE]*[\+\-]*\d*):(\%\d*.\d*\w)}/${ \( &spf($1,$2) )}/g;
 1125   $in =~ s/\+\s*\-/ - /g;
 1126   $in =~ s/\-\s*\+/ - /g;
 1127   $in =~ s/\+\s*\+/ + /g;
 1128   $in =~ s/\-\s*\-/ + /g;
 1129   $in;
 1130 }
 1131 
 1132 sub math_ev3 {
 1133   my $in = shift; #print "in=$in<BR>";
 1134   my ($out,$PG_eval_errors,$PG_full_error_report);
 1135   $in = FEQ($in);
 1136   $in =~ s/%/\\%/g;   #  % causes trouble in TeX and HTML_tth it usually (always?) indicates an error, not comment
 1137   return("$main::BM $in $main::EM") unless ($displayMode eq 'HTML_tth');
 1138   $in = "\\(" . $in . "\\)";
 1139   $out = tth($in);
 1140   ($out,$PG_eval_errors,$PG_full_error_report);
 1141 
 1142 }
 1143 
 1144 sub display_math_ev3 {
 1145   my $in = shift; #print "in=$in<BR>";
 1146   my ($out,$PG_eval_errors,$PG_full_error_report);
 1147   $in = FEQ($in);
 1148   $in =~ s/%/\\%/g;
 1149   return("$main::BDM $in $main::EDM") unless $displayMode eq 'HTML_tth' ;
 1150   $in = "\\[" . $in . "\\]";
 1151   $out =tth($in);
 1152   ($out,$PG_eval_errors,$PG_full_error_report);
 1153 }
 1154 
 1155 sub EV2 {
 1156   my $string = join(" ",@_);
 1157   # evaluate code inside of \{  \}  (no nesting allowed)
 1158     $string = ev_substring($string,"\\{","\\}",\&old_safe_ev);
 1159     $string = ev_substring($string,"\\<","\\>",\&old_safe_ev);
 1160   $string = ev_substring($string,"\\(","\\)",\&math_ev3);
 1161   $string = ev_substring($string,"\\[","\\]",\&display_math_ev3);
 1162   # macros for displaying math
 1163   $string =~ s/\\\(/$main::BM/g;
 1164   $string =~ s/\\\)/$main::EM/g;
 1165   $string =~ s/\\\[/$main::BDM/g;
 1166   $string =~ s/\\\]/$main::EDM/g;
 1167   $string;
 1168 }
 1169 
 1170 sub EV3{
 1171   my $string = join(" ",@_);
 1172   # evaluate code inside of \{  \}  (no nesting allowed)
 1173     $string = ev_substring($string,"\\\\{","\\\\}",\&safe_ev);  # handles \{ \} in single quoted strings of PG files
 1174   # interpolate variables
 1175   my ($evaluated_string,$PG_eval_errors,$PG_full_errors) = PG_restricted_eval("<<END_OF_EVALUATION_STRING\n$string\nEND_OF_EVALUATION_STRING\n");
 1176   if ($PG_eval_errors) {
 1177       my @errorLines = split("\n",$PG_eval_errors);
 1178       $string =~ s/</&lt;/g; $string =~ s/>/&gt;/g;
 1179     $evaluated_string = "<PRE>$main::PAR % ERROR in $0:EV3, PGbasicmacros.pl: $main::PAR % There is an error occuring in the following code:$main::BR $string $main::BR % $main::BR % $errorLines[0]\n % $errorLines[1]$main::BR % $main::BR % $main::BR </PRE> ";
 1180     $@="";
 1181   }
 1182   $string = $evaluated_string;
 1183   $string = ev_substring($string,"\\(","\\)",\&math_ev3);
 1184     $string = ev_substring($string,"\\[","\\]",\&display_math_ev3);
 1185   $string;
 1186 }
 1187 
 1188 =head2 Formatting macros
 1189 
 1190   beginproblem()  # generates text listing number and the point value of
 1191                   # the problem. It will also print the file name containing
 1192                   # the problem for users listed in the PRINT_FILE_NAMES_FOR PG_environment
 1193                   # variable.
 1194   OL(@array)      # formats the array as an Ordered List ( <OL> </OL> ) enumerated by letters.
 1195 
 1196   htmlLink($url, $text)
 1197                   # Places a reference to the URL with the specified text in the problem.
 1198                   # A common usage is \{ htmlLink(alias('prob1_help.html') \}, 'for help')
 1199                   # where alias finds the full address of the prob1_help.html file in the same directory
 1200                   # as the problem file
 1201   appletLink($url, $parameters)
 1202                   # For example
 1203                   # appletLink(q!  archive="http: //webwork.math.rochester.edu/gage/xFunctions/xFunctions.zip"
 1204                                   code="xFunctionsLauncher.class"  width=100 height=14!,
 1205                   " parameter text goes here")
 1206                   # will link to xFunctions.
 1207 
 1208   low level:
 1209 
 1210   spf($number, $format)   # prints the number with the given format
 1211   sspf($number, $format)  # prints the number with the given format, always including a sign.
 1212   protect_underbar($string) # protects the underbar (class_name) in strings which may have to pass through TeX.
 1213 
 1214 =cut
 1215 
 1216 sub beginproblem {
 1217   my $out = "";
 1218     my $TeXFileName = protect_underbar($main::fileName);
 1219     my $l2hFileName = protect_underbar($main::fileName);
 1220   my %inlist;
 1221   my $points ='pts';
 1222   $points = 'pt' if $main::problemValue == 1;
 1223   ##    Prepare header for the problem
 1224   grep($inlist{$_}++,@{ $envir{'PRINT_FILE_NAMES_FOR'} });
 1225   if ( defined($inlist{$main::studentLogin}) and ($inlist{$main::studentLogin} > 0) ) {
 1226     $out = &M3("\n\n\\medskip\\hrule\\smallskip\\par{\\bf ${main::probNum}.{\\footnotesize ($main::problemValue $points) $TeXFileName}}\\newline ",
 1227     " \\begin{rawhtml} ($main::problemValue $points) <B>$l2hFileName</B><BR>\\end{rawhtml}",
 1228      "($main::problemValue $points) <B>$main::fileName</B><BR>"
 1229        );
 1230   } else {
 1231     $out = &M3("\n\n\\smallskip\\hrule\\smallskip\\par{\\bf ${main::probNum}.}($main::problemValue $points) ",
 1232     "($main::problemValue $points) ",
 1233      "($main::problemValue $points) "
 1234        );
 1235   }
 1236   $out;
 1237 
 1238 }
 1239 
 1240 # kludge to clean up path names
 1241             ## allow underscore character in set and section names and also allows line breaks at /
 1242 sub protect_underbar {
 1243     my $in = shift;
 1244     if ($displayMode eq 'TeX')  {
 1245 
 1246         $in =~ s|_|\\\_|g;
 1247         $in =~ s|/|\\\-/|g;  # allows an optional hyphenation of the path (in tex)
 1248     }
 1249     $in;
 1250 }
 1251 
 1252 
 1253 # An example of a macro which prints out a list (with letters)
 1254 sub OL {
 1255   my(@array) = @_;
 1256   my $i = 0;
 1257   my  $out=   &M3(
 1258           "\\begin{enumerate}\n",
 1259           " \\begin{rawhtml} <OL TYPE=\"A\" VALUE=\"1\"> \\end{rawhtml} ",
 1260           "<OL TYPE=\"A\" VALUE=\"1\">\n"
 1261           ) ;
 1262   my $elem;
 1263   foreach $elem (@array) {
 1264     $out .= &M3(
 1265           "\\item[$main::ALPHABET[$i].] $elem\n",
 1266           " \\begin{rawhtml} <LI> \\end{rawhtml} $elem  ",
 1267           "<LI> $elem\n"
 1268           ) ;
 1269     $i++;
 1270   }
 1271   $out .= &M3(
 1272         "\\end{enumerate}\n",
 1273         " \\begin{rawhtml} </OL>\n \\end{rawhtml} ",
 1274         "</OL>\n"
 1275         ) ;
 1276 }
 1277 
 1278 sub htmlLink {
 1279   my $url = shift;
 1280   my $text = shift;
 1281   my $options = shift;
 1282   $options = "" unless defined($options);
 1283   return "${main::BBOLD}[ broken link:  $text ] ${main::EBOLD}" unless defined($url);
 1284   M3( "{\\bf \\underline{$text}  }",
 1285       "\\begin{rawhtml} <A HREF=\"$url\" $options> $text </A>\\end{rawhtml}",
 1286       "<A HREF=\"$url\" $options> $text </A>"
 1287       );
 1288 }
 1289 sub appletLink {
 1290   my $url = shift;
 1291   my $options = shift;
 1292   $options = "" unless defined($options);
 1293   M3( "{\\bf \\underline{APPLET}  }",
 1294       "\\begin{rawhtml} <APPLET $url> $options </APPLET>\\end{rawhtml}",
 1295       "<APPLET $url> $options </APPLET>"
 1296       );
 1297 }
 1298 sub spf {
 1299   my($number,$format) = @_;  # attention, the order of format and number are reversed
 1300   $format = "%4.3g" unless $format;   # default value for format
 1301   sprintf($format, $number);
 1302   }
 1303 sub sspf {
 1304   my($number,$format) = @_;  # attention, the order of format and number are reversed
 1305   $format = "%4.3g" unless $format;   # default value for format
 1306   my $sign = $number>=0 ? " + " : " - ";
 1307   $number = $number>=0 ? $number : -$number;
 1308   $sign .sprintf($format, $number);
 1309   }
 1310 
 1311 =head2  Sorting and other list macros
 1312 
 1313 
 1314 
 1315   Usage:
 1316   lex_sort(@list);   # outputs list in lexigraphic (alphabetical) order
 1317   num_sort(@list);   # outputs list in numerical order
 1318   uniq( @list);      # outputs a list with no duplicates.  Order is unspecified.
 1319 
 1320   PGsort( \&sort_subroutine, @list);
 1321   # &sort_subroutine defines order. It's output must be -1,0 or 1.
 1322 
 1323 =cut
 1324 
 1325 #  uniq gives unique elements of a list:
 1326  sub uniq {
 1327    my (@in) =@_;
 1328    my %temp = ();
 1329    while (@in) {
 1330           $temp{shift(@in)}++;
 1331       }
 1332    my @out =  keys %temp;  # sort is causing trouble with Safe.??
 1333    @out;
 1334 }
 1335 
 1336 sub lex_sort {
 1337   PGsort sub {$_[0] cmp $_[1]}, @_;
 1338 }
 1339 sub num_sort {
 1340   PGsort sub {$_[0] <=> $_[1]}, @_;
 1341 }
 1342 
 1343 
 1344 =head2 Macros for handling tables
 1345 
 1346   Usage:
 1347   begintable( number_of_columns_in_table)
 1348   row(@dataelements)
 1349   endtable()
 1350 
 1351 Example of useage:
 1352 
 1353   BEGIN_TEXT
 1354     This problem tests calculating new functions from old ones:$BR
 1355     From the table below calculate the quantities asked for:$BR
 1356     \{begintable(scalar(@firstrow)+1)\}
 1357     \{row(" \(x\) ",@firstrow)\}
 1358     \{row(" \(f(x)\) ", @secondrow)\}
 1359     \{row(" \(g(x)\) ", @thirdrow)\}
 1360     \{row(" \(f'(x)\) ", @fourthrow)\}
 1361     \{row(" \(g'(x)\) ", @fifthrow)\}
 1362     \{endtable()\}
 1363 
 1364    (The arrays contain numbers which are placed in the table.)
 1365 
 1366   END_TEXT
 1367 
 1368 =cut
 1369 
 1370 sub begintable {
 1371   my ($number)=shift;   #number of columns in table
 1372   my %options = @_;
 1373   warn "begintable(cols) requires a number indicating the number of columns" unless defined($number);
 1374   my $out = "";
 1375   if ($displayMode eq 'TeX') {
 1376     $out .= "\n\\par\\smallskip\\begin{center}\\begin{tabular}{"  .  "|c" x $number .  "|} \\hline\n";
 1377     }
 1378   elsif ($displayMode eq 'Latex2HTML') {
 1379     $out .= "\n\\begin{rawhtml} <TABLE , BORDER=1>\n\\end{rawhtml}";
 1380     }
 1381   elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth') {
 1382     $out .= "<TABLE BORDER=1>\n"
 1383   }
 1384   else {
 1385     $out = "Error: PGchoicemacros: begintable: Unknown displayMode: $displayMode.\n";
 1386     }
 1387   $out;
 1388   }
 1389 
 1390 sub endtable {
 1391   my $out = "";
 1392   if ($displayMode eq 'TeX') {
 1393     $out .= "\n\\end {tabular}\\end{center}\\par\\smallskip\n";
 1394     }
 1395   elsif ($displayMode eq 'Latex2HTML') {
 1396     $out .= "\n\\begin{rawhtml} </TABLE >\n\\end{rawhtml}";
 1397     }
 1398   elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth') {
 1399     $out .= "</TABLE>\n";
 1400     }
 1401   else {
 1402     $out = "Error: PGchoicemacros: endtable: Unknown displayMode: $displayMode.\n";
 1403     }
 1404   $out;
 1405   }
 1406 
 1407 
 1408 sub row {
 1409   my @elements = @_;
 1410   my $out = "";
 1411   if ($displayMode eq 'TeX') {
 1412     while (@elements) {
 1413       $out .= shift(@elements) . " &";
 1414       }
 1415      chop($out); # remove last &
 1416      $out .= "\\\\ \\hline \n";
 1417      # carriage returns must be added manually for tex
 1418     }
 1419   elsif ($displayMode eq 'Latex2HTML') {
 1420     $out .= "\n\\begin{rawhtml}\n<TR>\n\\end{rawhtml}\n";
 1421     while (@elements) {
 1422       $out .= " \n\\begin{rawhtml}\n<TD> \n\\end{rawhtml}\n" . shift(@elements) . " \n\\begin{rawhtml}\n</TD> \n\\end{rawhtml}\n";
 1423       }
 1424     $out .= " \n\\begin{rawhtml}\n</TR> \n\\end{rawhtml}\n";
 1425   }
 1426   elsif ($main::displayMode eq 'HTML' || $main::displayMode eq 'HTML_tth') {
 1427     $out .= "<TR>\n";
 1428     while (@elements) {
 1429       $out .= "<TD>" . shift(@elements) . "</TD>";
 1430       }
 1431     $out .= "\n</TR>\n";
 1432   }
 1433   else {
 1434     $out = "Error: PGchoicemacros: row: Unknown displayMode: $main::displayMode.\n";
 1435     }
 1436   $out;
 1437 }
 1438 
 1439 =head2 Macros for displaying static images
 1440 
 1441   Usage:
 1442   $string = image($image, width => 100, height => 100, tex_size => 800)
 1443   $string = image([$image1, $image2], width => 100, height => 100, tex_size => 800)
 1444   $string = caption($string);
 1445   $string = imageRow([$image1, $image2 ], [$caption1, $caption2]);
 1446            # produces a complete table with rows of pictures.
 1447 
 1448 
 1449 =cut
 1450 
 1451 #   More advanced macros
 1452 sub image {
 1453   my $image_ref  = shift;
 1454     my @opt = @_;
 1455     unless (scalar(@opt) % 2 == 0 ) {
 1456       warn "ERROR in image macro.  A list of macros must be inclosed in square brackets.";
 1457     }
 1458     my %in_options = @opt;
 1459     my %known_options = ( width   => 100,
 1460                           height  => 100,
 1461                           tex_size  => 800
 1462                          );
 1463 #   # handle options
 1464     my %out_options = %known_options;
 1465   foreach my $opt_name (keys %in_options) {
 1466     if ( exists( $known_options{$opt_name} ) ) {
 1467       $out_options{$opt_name} = $in_options{$opt_name} if exists( $in_options{$opt_name} ) ;
 1468     } else {
 1469       die "Option $opt_name not defined for image. " .
 1470       "Default options are:<BR> ", display_options2(%known_options);
 1471 
 1472     }
 1473   }
 1474   my $width     = $out_options{width};
 1475   my $height    = $out_options{height};
 1476   my $tex_size  = $out_options{tex_size};
 1477   my $width_ratio = $tex_size*(.001);
 1478   my @image_list = ();
 1479 
 1480   if (ref($image_ref) =~ /ARRAY/ ) {
 1481     @image_list = @{$image_ref};
 1482   } else {
 1483     push(@image_list,$image_ref);
 1484   }
 1485   my @output_list = ();
 1486     while(@image_list) {
 1487 
 1488     my $imageURL = alias(shift @image_list);
 1489     my $out="";
 1490 
 1491 
 1492     if ($main::displayMode eq 'TeX') {
 1493       $out = qq!\\includegraphics[width=$width_ratio\\linewidth]{$imageURL}\n !
 1494       }
 1495     elsif ($main::displayMode eq 'Latex2HTML') {
 1496       $out = qq!\\begin{rawhtml}\n<A HREF= "$imageURL" TARGET="ZOOM"><IMG SRC="$imageURL"  WIDTH="$width" HEIGHT="$height"></A>\n
 1497       \\end{rawhtml}\n !
 1498       }
 1499     elsif ($main::displayMode eq 'HTML' || $main::displayMode eq 'HTML_tth') {
 1500       $out = qq!<A HREF= "$imageURL" TARGET="ZOOM"><IMG SRC="$imageURL"  WIDTH="$width" HEIGHT="$height"></A>
 1501       !
 1502       }
 1503     else {
 1504       $out = "Error: PGchoicemacros: image: Unknown displayMode: $main::displayMode.\n";
 1505       }
 1506     push(@output_list, $out);
 1507   }
 1508   wantarray ? @output_list : $output_list[0] ;
 1509 }
 1510 
 1511 # This is legacy code.
 1512 sub images {
 1513   my @in = @_;
 1514   my @outlist = ();
 1515   while (@in) {
 1516      push(@outlist,&image( shift(@in) ) );
 1517    }
 1518   @outlist;
 1519 }
 1520 
 1521 
 1522 sub caption {
 1523   my ($out) = @_;
 1524   $out = " $out \n" if $main::displayMode eq 'TeX';
 1525   $out = " $out  " if $main::displayMode eq 'HTML';
 1526   $out = " $out  " if $main::displayMode eq 'HTML_tth';
 1527   $out = " $out  " if $main::displayMode eq 'Latex2HTML';
 1528     $out;
 1529 }
 1530 
 1531 sub captions {
 1532   my @in = @_;
 1533   my @outlist = ();
 1534   while (@in) {
 1535      push(@outlist,&caption( shift(@in) ) );
 1536   }
 1537   @outlist;
 1538 }
 1539 
 1540 sub imageRow {
 1541 
 1542   my $pImages = shift;
 1543   my $pCaptions=shift;
 1544   my $out = "";
 1545   my @images = @$pImages;
 1546   my @captions = @$pCaptions;
 1547   my $number = @images;
 1548   # standard options
 1549   my %options = ( 'tex_size' => 200,  # width for fitting 4 across
 1550                   'height' => 100,
 1551                   'width' => 100,
 1552                   @_            # overwrite any default options
 1553                 );
 1554 
 1555   if ($main::displayMode eq 'TeX') {
 1556     $out .= "\n\\par\\smallskip\\begin{center}\\begin{tabular}{"  .  "|c" x $number .  "|} \\hline\n";
 1557     while (@images) {
 1558       $out .= &image( shift(@images),%options ) . '&';
 1559     }
 1560     chop($out);
 1561     $out .= "\\\\ \\hline \n";
 1562     while (@captions) {
 1563       $out .= &caption( shift(@captions) ) . '&';
 1564     }
 1565     chop($out);
 1566     $out .= "\\\\ \\hline \n\\end {tabular}\\end{center}\\par\\smallskip\n";
 1567   } elsif ($main::displayMode eq 'Latex2HTML'){
 1568 
 1569     $out .= "\n\\begin{rawhtml} <TABLE  BORDER=1><TR>\n\\end{rawhtml}\n";
 1570     while (@images) {
 1571       $out .= "\n\\begin{rawhtml} <TD>\n\\end{rawhtml}\n" . &image( shift(@images),%options )
 1572               . "\n\\begin{rawhtml} </TD>\n\\end{rawhtml}\n" ;
 1573     }
 1574 
 1575     $out .= "\n\\begin{rawhtml}</TR><TR>\\end{rawhtml}\n";
 1576     while (@captions) {
 1577       $out .= "\n\\begin{rawhtml} <TH>\n\\end{rawhtml}\n".&caption( shift(@captions) )
 1578               . "\n\\begin{rawhtml} </TH>\n\\end{rawhtml}\n" ;
 1579     }
 1580 
 1581     $out .= "\n\\begin{rawhtml} </TR> </TABLE >\n\\end{rawhtml}";
 1582   } elsif ($main::displayMode eq 'HTML' || $main::displayMode eq 'HTML_tth'){
 1583     $out .= "<P>\n <TABLE BORDER=2 CELLPADDING=3 CELLSPACING=2 ><TR ALIGN=CENTER    VALIGN=MIDDLE>\n";
 1584     while (@images) {
 1585       $out .= " \n<TD>". &image( shift(@images),%options ) ."</TD>";
 1586     }
 1587     $out .= "</TR>\n<TR>";
 1588     while (@captions) {
 1589       $out .= " <TH>". &caption( shift(@captions) ) ."</TH>";
 1590     }
 1591     $out .= "\n</TR></TABLE></P>\n"
 1592   }
 1593   else {
 1594     $out = "Error: PGchoicemacros: imageRow: Unknown languageMode: $main::displayMode.\n";
 1595     warn $out;
 1596   }
 1597   $out;
 1598 }
 1599 
 1600 
 1601 ###########
 1602 # Auxiliary macros
 1603 
 1604 sub display_options2{
 1605   my %options = @_;
 1606   my $out_string = "";
 1607   foreach my $key (keys %options) {
 1608     $out_string .= " $key => $options{$key},<BR>";
 1609   }
 1610   $out_string;
 1611 }
 1612 
 1613 
 1614 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9