[system] / trunk / pg / macros / PGbasicmacros.pl Repository:
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3520 - (download) (as text) (annotate)
Sat Aug 13 21:45:46 2005 UTC (14 years, 4 months ago) by jj
File size: 67461 byte(s)
Implimentation of COMMENT for comments to appear in the library browser.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9