[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 1385 - (download) (as text) (annotate)
Mon Jul 14 20:22:19 2003 UTC (16 years, 6 months ago) by apizer
File size: 61169 byte(s)
Fixed a bug in Davide Cervone's changes

Arnie

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9