[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 1390 - (download) (as text) (annotate)
Tue Jul 15 17:55:32 2003 UTC (16 years, 6 months ago) by apizer
File size: 61430 byte(s)
Back off from Cervone's new definition of BR

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, 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 => '\\par\\noindent ', Latex2HTML => '\\begin{rawhtml}<BR>\\end{rawhtml}', HTML => '<BR>'); };
 1135 # Alternate definition of BR which is slightly more flexible and gives more white space in printed output
 1136 # which looks better but kills more trees.
 1137 #sub BR { MODES( TeX => '\\\\', Latex2HTML => '\\begin{rawhtml}<BR>\\end{rawhtml}', HTML => '<BR>'); };
 1138 sub LQ { MODES( TeX => "``", Latex2HTML =>   '"',  HTML =>  '&quot;' ); };
 1139 sub RQ { MODES( TeX => "''", Latex2HTML =>   '"',   HTML =>  '&quot;' ); };
 1140 sub BM { MODES(TeX => '\\(', Latex2HTML => '\\(', HTML =>  ''); };  # begin math mode
 1141 sub EM { MODES(TeX => '\\)', Latex2HTML => '\\)', HTML => ''); };  # end math mode
 1142 sub BDM { MODES(TeX => '\\[', Latex2HTML =>   '\\[', HTML =>   '<P ALIGN=CENTER>'); };  #begin displayMath mode
 1143 sub EDM { MODES(TeX => '\\]',  Latex2HTML =>  '\\]', HTML => '</P>'); };              #end displayMath mode
 1144 sub LTS { MODES(TeX => '<', Latex2HTML => '\\lt ', HTML => '&lt;', HTML_tth => '<' ); };
 1145 sub GTS { MODES(TeX => '>', Latex2HTML => '\\gt ', HTML => '&gt;', HTML_tth => '>' ); };
 1146 sub LTE { MODES(TeX => '\\le ', Latex2HTML => '\\le ', HTML => '<U>&lt;</U>', HTML_tth => '\\le ' ); };
 1147 sub GTE { MODES(TeX => '\\ge ', Latex2HTML => '\\ge ', HTML => '<U>&gt;</U>', HTML_tth => '\\ge ' ); };
 1148 sub BEGIN_ONE_COLUMN { MODES(TeX => " \\end{multicols}\n",  Latex2HTML => " ", HTML =>   " "); };
 1149 sub END_ONE_COLUMN { MODES(TeX =>
 1150               " \\begin{multicols}{2}\n\\columnwidth=\\linewidth\n",
 1151                             Latex2HTML => ' ', HTML => ' ');
 1152 
 1153 };
 1154 sub SOLUTION_HEADING { MODES( TeX => '\\par {\\bf Solution:}',
 1155                  Latex2HTML => '\\par {\\bf Solution:}',
 1156                HTML =>  '<P><B>Solution:</B>');
 1157               };
 1158 sub HINT_HEADING { MODES( TeX => "\\par {\\bf Hint:}", Latex2HTML => "\\par {\\bf Hint:}", HTML => "<P><B>Hint:</B>"); };
 1159 sub US { MODES(TeX => '\\_', Latex2HTML => '\\_', HTML => '_');};  # underscore, e.g. file${US}name
 1160 sub SPACE { MODES(TeX => '\\ ',  Latex2HTML => '\\ ', HTML => '&nbsp;');};  # force a space in latex, doesn't force extra space in html
 1161 sub BBOLD { MODES(TeX => '{\\bf ',  Latex2HTML => '{\\bf ', HTML => '<B>'); };
 1162 sub EBOLD { MODES( TeX => '}', Latex2HTML =>  '}',HTML =>  '</B>'); };
 1163 sub BITALIC { MODES(TeX => '{\\it ',  Latex2HTML => '{\\it ', HTML => '<I>'); };
 1164 sub EITALIC { MODES(TeX => '} ',  Latex2HTML => '} ', HTML => '</I>'); };
 1165 sub BCENTER { MODES(TeX => '\\begin{center} ',  Latex2HTML => ' \\begin{rawhtml} <div align="center"> \\end{rawhtml} ', HTML => '<div align="center">'); };
 1166 sub ECENTER { MODES(TeX => '\\end{center} ',  Latex2HTML => ' \\begin{rawhtml} </div> \\end{rawhtml} ', HTML => '</div>'); };
 1167 sub HR { MODES(TeX => '\\par\\hrulefill\\par ', Latex2HTML => '\\begin{rawhtml} <HR> \\end{rawhtml}', HTML =>  '<HR>'); };
 1168 sub LBRACE { MODES( TeX => '\{', Latex2HTML =>   '\\lbrace',  HTML =>  '{' , HTML_tth=> '\\lbrace' ); };
 1169 sub RBRACE { MODES( TeX => '\}', Latex2HTML =>   '\\rbrace',  HTML =>  '}' , HTML_tth=> '\\rbrace',); };
 1170 sub LB { MODES( TeX => '\{', Latex2HTML =>   '\\lbrace',  HTML =>  '{' , HTML_tth=> '\\lbrace' ); };
 1171 sub RB { MODES( TeX => '\}', Latex2HTML =>   '\\rbrace',  HTML =>  '}' , HTML_tth=> '\\rbrace',); };
 1172 sub DOLLAR { MODES( TeX => '\\$', Latex2HTML => '\\$', HTML => '$' ); };
 1173 sub PERCENT { MODES( TeX => '\\%', Latex2HTML => '\\%', HTML => '%' ); };
 1174 sub CARET { MODES( TeX => '\\verb+^+', Latex2HTML => '\\verb+^+', HTML => '^' ); };
 1175 sub PI {4*atan2(1,1);};
 1176 sub E {exp(1);};
 1177 
 1178 ###############################################################
 1179 ## Evaluation macros
 1180 
 1181 
 1182 =head2 TEXT macros
 1183 
 1184   Usage:
 1185     TEXT(@text);
 1186 
 1187 This is the simplest way to print text from a problem.  The strings in the array C<@text> are concatenated
 1188 with spaces between them and printed out in the text of the problem.  The text is not processed in any other way.
 1189 C<TEXT> is defined in PG.pl.
 1190 
 1191   Usage:
 1192     BEGIN_TEXT
 1193       text.....
 1194     END_TEXT
 1195 
 1196 This is the most common way to enter text into the problem.  All of the text between BEGIN_TEXT and END_TEXT
 1197 is processed by the C<EV3> macro described below and then printed using the C<TEXT> command.  The two key words
 1198 must appear on lines by themselves.  The preprocessing that makes this construction work is done in F<PGtranslator.pm>.
 1199 See C<EV3> below for details on the processing.
 1200 
 1201 
 1202 =cut
 1203 
 1204 =head2 Evaluation macros
 1205 
 1206 =head3 EV3
 1207 
 1208         TEXT(EV3("This is a formulat \( \int_0^5 x^2 \, dx \) ");
 1209         TEXT(EV3(@text));
 1210 
 1211     TEXT(EV3(<<'END_TEXT'));
 1212       text stuff...
 1213     END_TEXT
 1214 
 1215 
 1216 The BEGIN_TEXT/END_TEXT construction is translated into the construction above by PGtranslator.pm.  END_TEXT must appear
 1217 on a line by itself and be left justified.  (The << construction is known as a "here document" in UNIX and in PERL.)
 1218 
 1219 The single quotes around END_TEXT mean that no automatic interpolation of variables takes place in the text.
 1220 Using EV3 with strings which have been evaluated by double quotes may lead to unexpected results.
 1221 
 1222 
 1223 The evaluation macro E3 first evaluates perl code inside the braces:  C<\{  code \}>.
 1224 Any perl statment can be put inside the braces.  The
 1225 result of the evaluation (i.e. the last statement evaluated) replaces the C<\{ code \}> construction.
 1226 
 1227 Next interpolation of all variables (e.g. C<$var or @array> ) is performed.
 1228 
 1229 Then mathematical formulas in TeX are evaluated within the
 1230 C<\(  tex math mode \)> and
 1231 C<\[ tex display math mode \] >
 1232 constructions, in that order:
 1233 
 1234 =head3 FEQ
 1235 
 1236   FEQ($string);   # processes and outputs the string
 1237 
 1238 
 1239 The mathematical formulas are run through the macro C<FEQ> (Format EQuations) which performs
 1240 several substitutions (see below).
 1241 In C<HTML_tth> mode the resulting code is processed by tth to obtain an HTML version
 1242 of the formula. (In the future processing by WebEQ may be added here as another option.)
 1243 The Latex2HTML mode does nothing
 1244 at this stage; it creates the entire problem before running it through
 1245 TeX and creating the GIF images of the equations.
 1246 
 1247 The resulting string is output (and usually fed into TEXT to be printed in the problem).
 1248 
 1249   Usage:
 1250 
 1251     $string2 = FEQ($string1);
 1252 
 1253 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
 1254 understood with an example.
 1255 
 1256     $string1 = "${a}x^2 + ${b}x + {$c:%.1f}"; $a = 3;, $b = -2; $c = -7.345;
 1257 
 1258 when interpolated becomes:
 1259 
 1260     $string1 = '3x^2 + -2x + {-7.345:%0.1f}
 1261 
 1262 FEQ first changes the number of decimal places displayed, so that the last term becomes -7.3 Then it removes the
 1263 extraneous plus and minus signs, so that the final result is what you want:
 1264 
 1265     $string2 = '3x^2 - 2x -7.3';
 1266 
 1267 (The %0.1f construction
 1268 is the same formatting convention used by Perl and nearly identical to the one used by the C printf statement. Some common
 1269 usage:  %0.3f 3 decimal places, fixed notation; %0.3e 3 significant figures exponential notation; %0.3g uses either fixed
 1270 or exponential notation depending on the size of the number.)
 1271 
 1272 Two additional legacy formatting constructions are also supported:
 1273 
 1274 C<?{$c:%0.3f} > will give a number with 3 decimal places and a negative
 1275 sign if the number is negative, no sign if the number is positive.
 1276 
 1277 C<!{$c:%0.3f}> determines the sign and prints it
 1278 whether the number is positive or negative.
 1279 
 1280 =head3 EV2
 1281 
 1282     TEXT(EV2(@text));
 1283 
 1284     TEXT(EV2(<<END_OF_TEXT));
 1285       text stuff...
 1286     END_OF_TEXT
 1287 
 1288 This is a precursor to EV3.  In this case the constants are interpolated first, before the evaluation of the \{ ...code...\}
 1289 construct. This can lead to unexpected results.  For example C<\{ join(" ", @text) \}> with C<@text = ("Hello","World");> becomes,
 1290 after interpolation, C<\{ join(" ",Hello World) \}> which then causes an error when evaluated because Hello is a bare word.
 1291 C<EV2> can still be useful if you allow for this, and in particular it works on double quoted strings, which lead to
 1292 unexpected results with C<EV3>. Using single quoted strings with C<EV2> may lead to unexpected results.
 1293 
 1294 The unexpected results have to do with the number of times backslashed constructions have to be escaped. It is quite messy.  For
 1295 more details get a good Perl book and then read the code. :-)
 1296 
 1297 
 1298 
 1299 
 1300 =cut
 1301 
 1302 
 1303 sub ev_substring {
 1304     my $string      = shift;
 1305   my $start_delim = shift;
 1306   my $end_delim   = shift;
 1307   my $actionRef   = shift;
 1308   my ($eval_out,$PG_eval_errors,$PG_full_error_report)=();
 1309     my $out = "";
 1310                 #
 1311                 #  DPVC -- 2001/12/07
 1312                 #     original "while ($string)" fails to process the string "0" correctly
 1313                 #
 1314     while ($string ne "") {
 1315                 #
 1316                 #  end DPVC
 1317                 #
 1318         if ($string =~ /\Q$start_delim\E/s) {
 1319        #print "$start_delim $end_delim evaluating_substring=$string<BR>";
 1320         $string =~ s/^(.*?)\Q$start_delim\E//s;  # get string up to next \{ ---treats string as a single line, ignoring returns
 1321         $out .= $1;
 1322        #print "$start_delim $end_delim substring_out=$out<BR>";
 1323         $string =~ s/^(.*?)\Q$end_delim\E//s;  # get perl code up to \} ---treats string as a single line,  ignoring returns
 1324            #print "$start_delim $end_delim evaluate_string=$1<BR>";
 1325         ($eval_out,$PG_eval_errors,$PG_full_error_report) = &$actionRef($1);
 1326         $eval_out = "$start_delim $eval_out $end_delim" if $PG_full_error_report;
 1327         $out = $out . $eval_out;
 1328        #print "$start_delim $end_delim new substring_out=$out<BR><p><BR>";
 1329         $out .="$PAR ERROR $0 in ev_substring, PGbasicmacros.pl:$PAR <PRE>  $@ </PRE>$PAR" if $@;
 1330         }
 1331       else {
 1332         $out .= $string;  # flush the last part of the string
 1333         last;
 1334         }
 1335 
 1336       }
 1337   $out;
 1338 }
 1339 sub  safe_ev {
 1340     my ($out,$PG_eval_errors,$PG_full_error_report) = &old_safe_ev;   # process input by old_safe_ev first
 1341     $out =~s/\\/\\\\/g;   # protect any new backslashes introduced.
 1342   ($out,$PG_eval_errors,$PG_full_error_report)
 1343 }
 1344 
 1345 sub  old_safe_ev {
 1346     my $in = shift;
 1347     my   ($out,$PG_eval_errors,$PG_full_error_report) = PG_restricted_eval("$in;");
 1348     # the addition of the ; seems to provide better error reporting
 1349     if ($PG_eval_errors) {
 1350       my @errorLines = split("\n",$PG_eval_errors);
 1351     #$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> ";
 1352     warn " ERROR in old_safe_ev, PGbasicmacros.pl: <PRE>
 1353      ## There is an error occuring inside evaluation brackets \\{ ...code... \\}
 1354      ## somewhere in an EV2 or EV3 or BEGIN_TEXT block.
 1355      ## Code evaluated:
 1356      ## $in
 1357      ##" .join("\n     ", @errorLines). "
 1358      ##</PRE>$BR
 1359      ";
 1360      $out ="$PAR $BBOLD  $in $EBOLD $PAR";
 1361 
 1362 
 1363   }
 1364 
 1365   ($out,$PG_eval_errors,$PG_full_error_report);
 1366 }
 1367 
 1368 sub FEQ   {    # Format EQuations
 1369   my $in = shift;
 1370    # formatting numbers -- the ?{} and !{} constructions
 1371   $in =~s/\?\s*\{([.\-\$\w\d]+):?([%.\da-z]*)\}/${ \( &sspf($1,$2) )}/g;
 1372   $in =~s/\!\s*\{([.\-\$\w\d]+):?([%.\da-z]*)\}/${ \( &spf($1,$2) )}/g;
 1373 
 1374   # more formatting numbers -- {number:format} constructions
 1375   $in =~ s/\{(\s*[\+\-\d\.]+[eE]*[\+\-]*\d*):(\%\d*.\d*\w)}/${ \( &spf($1,$2) )}/g;
 1376   $in =~ s/\+\s*\-/ - /g;
 1377   $in =~ s/\-\s*\+/ - /g;
 1378   $in =~ s/\+\s*\+/ + /g;
 1379   $in =~ s/\-\s*\-/ + /g;
 1380   $in;
 1381 }
 1382 
 1383 #sub math_ev3 {
 1384 # my $in = shift; #print "in=$in<BR>";
 1385 # my ($out,$PG_eval_errors,$PG_full_error_report);
 1386 # $in = FEQ($in);
 1387 # $in =~ s/%/\\%/g;   #  % causes trouble in TeX and HTML_tth it usually (always?) indicates an error, not comment
 1388 # return("$BM $in $EM") unless ($displayMode eq 'HTML_tth');
 1389 # $in = "\\(" . $in . "\\)";
 1390 # $out = tth($in);
 1391 # ($out,$PG_eval_errors,$PG_full_error_report);
 1392 #
 1393 #}
 1394 #
 1395 #sub display_math_ev3 {
 1396 # my $in = shift; #print "in=$in<BR>";
 1397 # my ($out,$PG_eval_errors,$PG_full_error_report);
 1398 # $in = FEQ($in);
 1399 # $in =~ s/%/\\%/g;
 1400 # return("$main::BDM $in $main::EDM") unless $displayMode eq 'HTML_tth' ;
 1401 # $in = "\\[" . $in . "\\]";
 1402 # $out =tth($in);
 1403 # ($out,$PG_eval_errors,$PG_full_error_report);
 1404 #}
 1405 
 1406 sub math_ev3 {
 1407   my $in = shift;
 1408   return general_math_ev3($in, "inline");
 1409 }
 1410 
 1411 sub display_math_ev3 {
 1412   my $in = shift;
 1413   return general_math_ev3($in, "display");
 1414 }
 1415 
 1416 sub general_math_ev3 {
 1417   my $in = shift;
 1418   my $mode = shift || "inline";
 1419 
 1420   $in = FEQ($in); # Format EQuations
 1421   $in =~ s/%/\\%/g; # avoid % becoming TeX comments
 1422 
 1423   ## remove leading and trailing spaces so that HTML mode will
 1424   ## not include unwanted spaces as per Davide Cervone.
 1425   $in =~ s/^\s+//;
 1426   $in =~ s/\s+$//;
 1427 
 1428   # some modes want the delimiters, some don't
 1429   my $in_delim = $mode eq "inline"
 1430     ? "\\($in\\)"
 1431     : "\\[$in\\]";
 1432 
 1433   my $out;
 1434   if($displayMode eq "HTML_tth") {
 1435     $out = tth($in_delim);
 1436     ## remove leading and trailing spaces as per Davide Cervone.
 1437     $in =~ s/^\s+//;
 1438     $in =~ s/\s+$//;
 1439   } elsif ($displayMode eq "HTML_dpng") {
 1440     # for jj's version of ImageGenerator
 1441     $out = $envir->{'imagegen'}->add($in_delim);
 1442     # for my version of ImageGenerator
 1443     #$out = $envir->{'imagegen'}->add($in, $mode);
 1444   } elsif ($displayMode eq "HTML_img") {
 1445     $out = math2img($in, $mode);
 1446   } else {
 1447     $out = "\\($in\\)" if $mode eq "inline";
 1448     $out = "\\[$in\\]" if $mode eq "display";
 1449   }
 1450   return $out;
 1451 }
 1452 
 1453 sub EV2 {
 1454   my $string = join(" ",@_);
 1455   # evaluate code inside of \{  \}  (no nesting allowed)
 1456     $string = ev_substring($string,"\\{","\\}",\&old_safe_ev);
 1457     $string = ev_substring($string,"\\<","\\>",\&old_safe_ev);
 1458   $string = ev_substring($string,"\\(","\\)",\&math_ev3);
 1459   $string = ev_substring($string,"\\[","\\]",\&display_math_ev3);
 1460   # macros for displaying math
 1461   $string =~ s/\\\(/$BM/g;
 1462   $string =~ s/\\\)/$EM/g;
 1463   $string =~ s/\\\[/$BDM/g;
 1464   $string =~ s/\\\]/$EDM/g;
 1465   $string;
 1466 }
 1467 
 1468 sub EV3{
 1469   my $string = join(" ",@_);
 1470   # evaluate code inside of \{  \}  (no nesting allowed)
 1471     $string = ev_substring($string,"\\\\{","\\\\}",\&safe_ev);  # handles \{ \} in single quoted strings of PG files
 1472   # interpolate variables
 1473   my ($evaluated_string,$PG_eval_errors,$PG_full_errors) = PG_restricted_eval("<<END_OF_EVALUATION_STRING\n$string\nEND_OF_EVALUATION_STRING\n");
 1474   if ($PG_eval_errors) {
 1475       my @errorLines = split("\n",$PG_eval_errors);
 1476       $string =~ s/</&lt;/g; $string =~ s/>/&gt;/g;
 1477     $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> ";
 1478     $@="";
 1479   }
 1480   $string = $evaluated_string;
 1481   $string = ev_substring($string,"\\(","\\)",\&math_ev3);
 1482     $string = ev_substring($string,"\\[","\\]",\&display_math_ev3);
 1483   $string;
 1484 }
 1485 
 1486 =head2 Formatting macros
 1487 
 1488   beginproblem()  # generates text listing number and the point value of
 1489                   # the problem. It will also print the file name containing
 1490                   # the problem for users listed in the PRINT_FILE_NAMES_FOR PG_environment
 1491                   # variable.
 1492   OL(@array)      # formats the array as an Ordered List ( <OL> </OL> ) enumerated by letters.
 1493 
 1494   htmlLink($url, $text)
 1495                   # Places a reference to the URL with the specified text in the problem.
 1496                   # A common usage is \{ htmlLink(alias('prob1_help.html') \}, 'for help')
 1497                   # where alias finds the full address of the prob1_help.html file in the same directory
 1498                   # as the problem file
 1499   appletLink($url, $parameters)
 1500                   # For example
 1501                   # appletLink(q!  archive="http: //webwork.math.rochester.edu/gage/xFunctions/xFunctions.zip"
 1502                                   code="xFunctionsLauncher.class"  width=100 height=14!,
 1503                   " parameter text goes here")
 1504                   # will link to xFunctions.
 1505 
 1506   low level:
 1507 
 1508   spf($number, $format)   # prints the number with the given format
 1509   sspf($number, $format)  # prints the number with the given format, always including a sign.
 1510   protect_underbar($string) # protects the underbar (class_name) in strings which may have to pass through TeX.
 1511 
 1512 =cut
 1513 
 1514 sub beginproblem {
 1515   my $out = "";
 1516   my $problemValue = $envir->{problemValue};
 1517   my $fileName     = $envir->{fileName};
 1518   my $probNum      = $envir->{probNum};
 1519     my $TeXFileName = protect_underbar($envir->{fileName});
 1520     my $l2hFileName = protect_underbar($envir->{fileName});
 1521   my %inlist;
 1522   my $points ='pts';
 1523 
 1524   $points = 'pt' if $problemValue == 1;
 1525   ##    Prepare header for the problem
 1526   grep($inlist{$_}++,@{ $envir->{'PRINT_FILE_NAMES_FOR'} });
 1527   if ( defined($inlist{$envir->{studentLogin}}) and ($inlist{$envir->{studentLogin}} > 0) ) {
 1528     $out = &M3("\n\n\\medskip\\hrule\\smallskip\\par{\\bf ${probNum}.{\\footnotesize ($problemValue $points) $TeXFileName}}\\newline ",
 1529     " \\begin{rawhtml} ($problemValue $points) <B>$l2hFileName</B><BR>\\end{rawhtml}",
 1530      "($problemValue $points) <B>$fileName</B><BR>"
 1531        );
 1532   } else {
 1533     $out = &M3("\n\n\\smallskip\\hrule\\smallskip\\par{\\bf ${probNum}.}($problemValue $points) ",
 1534     "($problemValue $points) ",
 1535      "($problemValue $points) "
 1536        );
 1537   }
 1538   $out;
 1539 
 1540 }
 1541 
 1542 # kludge to clean up path names
 1543             ## allow underscore character in set and section names and also allows line breaks at /
 1544 sub protect_underbar {
 1545     my $in = shift;
 1546     if ($displayMode eq 'TeX')  {
 1547 
 1548         $in =~ s|_|\\\_|g;
 1549         $in =~ s|/|\\\-/|g;  # allows an optional hyphenation of the path (in tex)
 1550     }
 1551     $in;
 1552 }
 1553 
 1554 
 1555 # An example of a macro which prints out a list (with letters)
 1556 sub OL {
 1557   my(@array) = @_;
 1558   my $i = 0;
 1559   my  $out=   &M3(
 1560           "\\begin{enumerate}\n",
 1561           " \\begin{rawhtml} <OL TYPE=\"A\" VALUE=\"1\"> \\end{rawhtml} ",
 1562           "<OL TYPE=\"A\" VALUE=\"1\">\n"
 1563           ) ;
 1564   my $elem;
 1565   foreach $elem (@array) {
 1566                 $out .= MODES(
 1567                         TeX=>   "\\item[$ALPHABET[$i].] $elem\n",
 1568                         Latex2HTML=>    " \\begin{rawhtml} <LI> \\end{rawhtml} $elem  ",
 1569                         HTML=>  "<LI> $elem\n",
 1570                         HTML_dpng=>     "<LI> $elem <br /> <br /> \n"
 1571                                         );
 1572     $i++;
 1573   }
 1574   $out .= &M3(
 1575         "\\end{enumerate}\n",
 1576         " \\begin{rawhtml} </OL>\n \\end{rawhtml} ",
 1577         "</OL>\n"
 1578         ) ;
 1579 }
 1580 
 1581 sub htmlLink {
 1582   my $url = shift;
 1583   my $text = shift;
 1584   my $options = shift;
 1585   $options = "" unless defined($options);
 1586   return "$BBOLD\[ broken link:  $text \] $EBOLD" unless defined($url);
 1587   M3( "{\\bf \\underline{$text}  }",
 1588       "\\begin{rawhtml} <A HREF=\"$url\" $options> $text </A>\\end{rawhtml}",
 1589       "<A HREF=\"$url\" $options> $text </A>"
 1590       );
 1591 }
 1592 
 1593 sub appletLink {
 1594   my $url = shift;
 1595   my $options = shift;
 1596   $options = "" unless defined($options);
 1597   M3( "{\\bf \\underline{APPLET}  }",
 1598       "\\begin{rawhtml} <APPLET $url> $options </APPLET>\\end{rawhtml}",
 1599       "<APPLET $url> $options </APPLET>"
 1600       );
 1601 }
 1602 sub spf {
 1603   my($number,$format) = @_;  # attention, the order of format and number are reversed
 1604   $format = "%4.3g" unless $format;   # default value for format
 1605   sprintf($format, $number);
 1606   }
 1607 sub sspf {
 1608   my($number,$format) = @_;  # attention, the order of format and number are reversed
 1609   $format = "%4.3g" unless $format;   # default value for format
 1610   my $sign = $number>=0 ? " + " : " - ";
 1611   $number = $number>=0 ? $number : -$number;
 1612   $sign .sprintf($format, $number);
 1613   }
 1614 
 1615 =head2  Sorting and other list macros
 1616 
 1617 
 1618 
 1619   Usage:
 1620   lex_sort(@list);   # outputs list in lexigraphic (alphabetical) order
 1621   num_sort(@list);   # outputs list in numerical order
 1622   uniq( @list);      # outputs a list with no duplicates.  Order is unspecified.
 1623 
 1624   PGsort( \&sort_subroutine, @list);
 1625   # &sort_subroutine defines order. It's output must be -1,0 or 1.
 1626 
 1627 =cut
 1628 
 1629 #  uniq gives unique elements of a list:
 1630  sub uniq {
 1631    my (@in) =@_;
 1632    my %temp = ();
 1633    while (@in) {
 1634           $temp{shift(@in)}++;
 1635       }
 1636    my @out =  keys %temp;  # sort is causing trouble with Safe.??
 1637    @out;
 1638 }
 1639 
 1640 sub lex_sort {
 1641   PGsort sub {$_[0] cmp $_[1]}, @_;
 1642 }
 1643 sub num_sort {
 1644   PGsort sub {$_[0] <=> $_[1]}, @_;
 1645 }
 1646 
 1647 
 1648 =head2 Macros for handling tables
 1649 
 1650   Usage:
 1651   begintable( number_of_columns_in_table)
 1652   row(@dataelements)
 1653   endtable()
 1654 
 1655 Example of useage:
 1656 
 1657   BEGIN_TEXT
 1658     This problem tests calculating new functions from old ones:$BR
 1659     From the table below calculate the quantities asked for:$BR
 1660     \{begintable(scalar(@firstrow)+1)\}
 1661     \{row(" \(x\) ",@firstrow)\}
 1662     \{row(" \(f(x)\) ", @secondrow)\}
 1663     \{row(" \(g(x)\) ", @thirdrow)\}
 1664     \{row(" \(f'(x)\) ", @fourthrow)\}
 1665     \{row(" \(g'(x)\) ", @fifthrow)\}
 1666     \{endtable()\}
 1667 
 1668    (The arrays contain numbers which are placed in the table.)
 1669 
 1670   END_TEXT
 1671 
 1672 =cut
 1673 
 1674 sub begintable {
 1675   my ($number)=shift;   #number of columns in table
 1676   my %options = @_;
 1677   warn "begintable(cols) requires a number indicating the number of columns" unless defined($number);
 1678   my $out = "";
 1679   if ($displayMode eq 'TeX') {
 1680     $out .= "\n\\par\\smallskip\\begin{center}\\begin{tabular}{"  .  "|c" x $number .  "|} \\hline\n";
 1681     }
 1682   elsif ($displayMode eq 'Latex2HTML') {
 1683     $out .= "\n\\begin{rawhtml} <TABLE , BORDER=1>\n\\end{rawhtml}";
 1684     }
 1685   elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng' || $displayMode eq 'HTML_img') {
 1686     $out .= "<TABLE BORDER=1>\n"
 1687   }
 1688   else {
 1689     $out = "Error: PGbasicmacros: begintable: Unknown displayMode: $displayMode.\n";
 1690     }
 1691   $out;
 1692   }
 1693 
 1694 sub endtable {
 1695   my $out = "";
 1696   if ($displayMode eq 'TeX') {
 1697     $out .= "\n\\end {tabular}\\end{center}\\par\\smallskip\n";
 1698     }
 1699   elsif ($displayMode eq 'Latex2HTML') {
 1700     $out .= "\n\\begin{rawhtml} </TABLE >\n\\end{rawhtml}";
 1701     }
 1702   elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng' ||$displayMode eq 'HTML_img') {
 1703     $out .= "</TABLE>\n";
 1704     }
 1705   else {
 1706     $out = "Error: PGbasicmacros: endtable: Unknown displayMode: $displayMode.\n";
 1707     }
 1708   $out;
 1709   }
 1710 
 1711 
 1712 sub row {
 1713   my @elements = @_;
 1714   my $out = "";
 1715   if ($displayMode eq 'TeX') {
 1716     while (@elements) {
 1717       $out .= shift(@elements) . " &";
 1718       }
 1719      chop($out); # remove last &
 1720      $out .= "\\\\ \\hline \n";
 1721      # carriage returns must be added manually for tex
 1722     }
 1723   elsif ($displayMode eq 'Latex2HTML') {
 1724     $out .= "\n\\begin{rawhtml}\n<TR>\n\\end{rawhtml}\n";
 1725     while (@elements) {
 1726       $out .= " \n\\begin{rawhtml}\n<TD> \n\\end{rawhtml}\n" . shift(@elements) . " \n\\begin{rawhtml}\n</TD> \n\\end{rawhtml}\n";
 1727       }
 1728     $out .= " \n\\begin{rawhtml}\n</TR> \n\\end{rawhtml}\n";
 1729   }
 1730   elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng'||$displayMode eq 'HTML_img') {
 1731     $out .= "<TR>\n";
 1732     while (@elements) {
 1733       $out .= "<TD>" . shift(@elements) . "</TD>";
 1734       }
 1735     $out .= "\n</TR>\n";
 1736   }
 1737   else {
 1738     $out = "Error: PGbasicmacros: row: Unknown displayMode: $displayMode.\n";
 1739     }
 1740   $out;
 1741 }
 1742 
 1743 =head2 Macros for displaying static images
 1744 
 1745   Usage:
 1746   $string = image($image, width => 100, height => 100, tex_size => 800)
 1747   $string = image([$image1, $image2], width => 100, height => 100, tex_size => 800)
 1748   $string = caption($string);
 1749   $string = imageRow([$image1, $image2 ], [$caption1, $caption2]);
 1750            # produces a complete table with rows of pictures.
 1751 
 1752 
 1753 =cut
 1754 
 1755 #   More advanced macros
 1756 sub image {
 1757   my $image_ref  = shift;
 1758   my @opt = @_;
 1759   unless (scalar(@opt) % 2 == 0 ) {
 1760     warn "ERROR in image macro.  A list of macros must be inclosed in square brackets.";
 1761   }
 1762   my %in_options = @opt;
 1763   my %known_options = (
 1764     width    => 100,
 1765     height   => 100,
 1766     tex_size => 800,
 1767   );
 1768   # handle options
 1769   my %out_options = %known_options;
 1770   foreach my $opt_name (keys %in_options) {
 1771     if ( exists( $known_options{$opt_name} ) ) {
 1772       $out_options{$opt_name} = $in_options{$opt_name} if exists( $in_options{$opt_name} ) ;
 1773     } else {
 1774       die "Option $opt_name not defined for image. " .
 1775           "Default options are:<BR> ", display_options2(%known_options);
 1776     }
 1777   }
 1778   my $width       = $out_options{width};
 1779   my $height      = $out_options{height};
 1780   my $tex_size    = $out_options{tex_size};
 1781   my $width_ratio = $tex_size*(.001);
 1782   my @image_list  = ();
 1783 
 1784   if (ref($image_ref) =~ /ARRAY/ ) {
 1785     @image_list = @{$image_ref};
 1786   } else {
 1787     push(@image_list,$image_ref);
 1788   }
 1789 
 1790   my @output_list = ();
 1791     while(@image_list) {
 1792     my $imageURL = alias(shift @image_list);
 1793     my $out="";
 1794 
 1795     if ($displayMode eq 'TeX') {
 1796       my $imagePath = $imageURL; # in TeX mode, alias gives us a path, not a URL
 1797       if ($envir->{texDisposition} eq "pdf") {
 1798         # We're going to create PDF files with our TeX (using pdflatex), so
 1799         # alias should have given us the path to a PNG image. What we need
 1800         # to do is find out the dimmensions of this image, since pdflatex
 1801         # is too dumb to live.
 1802 
 1803         #my ($height, $width) = getImageDimmensions($imagePath);
 1804         ##warn "&image: $imagePath $height $width\n";
 1805         #unless ($height and $width) {
 1806         # warn "Couldn't get the dimmensions of image $imagePath.\n"
 1807         #}
 1808         #$out = "\\includegraphics[bb=0 0 $height $width,width=$width_ratio\\linewidth]{$imagePath}\n";
 1809         $out = "\\includegraphics[width=$width_ratio\\linewidth]{$imagePath}\n";
 1810       } else {
 1811         # Since we're not creating PDF files, alias should have given us the
 1812         # path to an EPS file. latex can get its dimmensions no problem!
 1813 
 1814         $out = "\\includegraphics[width=$width_ratio\\linewidth]{$imagePath}\n";
 1815       }
 1816     } elsif ($displayMode eq 'Latex2HTML') {
 1817       $out = qq!\\begin{rawhtml}\n<A HREF= "$imageURL" TARGET="ZOOM"><IMG SRC="$imageURL"  WIDTH="$width" HEIGHT="$height"></A>\n
 1818       \\end{rawhtml}\n !
 1819     } elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng' || $displayMode eq 'HTML_img') {
 1820       $out = qq!<A HREF= "$imageURL" TARGET="ZOOM"><IMG SRC="$imageURL"  WIDTH="$width" HEIGHT="$height"></A>
 1821       !
 1822     } else {
 1823       $out = "Error: PGbasicmacros: image: Unknown displayMode: $displayMode.\n";
 1824     }
 1825     push(@output_list, $out);
 1826   }
 1827   return wantarray ? @output_list : $output_list[0];
 1828 }
 1829 
 1830 # This is legacy code.
 1831 sub images {
 1832   my @in = @_;
 1833   my @outlist = ();
 1834   while (@in) {
 1835      push(@outlist,&image( shift(@in) ) );
 1836    }
 1837   @outlist;
 1838 }
 1839 
 1840 
 1841 sub caption {
 1842   my ($out) = @_;
 1843   $out = " $out \n" if $displayMode eq 'TeX';
 1844   $out = " $out  " if $displayMode eq 'HTML';
 1845   $out = " $out  " if $displayMode eq 'HTML_tth';
 1846   $out = " $out  " if $displayMode eq 'HTML_dpng';
 1847   $out = " $out  " if $displayMode eq 'HTML_img';
 1848   $out = " $out  " if $displayMode eq 'Latex2HTML';
 1849     $out;
 1850 }
 1851 
 1852 sub captions {
 1853   my @in = @_;
 1854   my @outlist = ();
 1855   while (@in) {
 1856      push(@outlist,&caption( shift(@in) ) );
 1857   }
 1858   @outlist;
 1859 }
 1860 
 1861 sub imageRow {
 1862 
 1863   my $pImages = shift;
 1864   my $pCaptions=shift;
 1865   my $out = "";
 1866   my @images = @$pImages;
 1867   my @captions = @$pCaptions;
 1868   my $number = @images;
 1869   # standard options
 1870   my %options = ( 'tex_size' => 200,  # width for fitting 4 across
 1871                   'height' => 100,
 1872                   'width' => 100,
 1873                   @_            # overwrite any default options
 1874                 );
 1875 
 1876   if ($displayMode eq 'TeX') {
 1877     $out .= "\n\\par\\smallskip\\begin{center}\\begin{tabular}{"  .  "|c" x $number .  "|} \\hline\n";
 1878     while (@images) {
 1879       $out .= &image( shift(@images),%options ) . '&';
 1880     }
 1881     chop($out);
 1882     $out .= "\\\\ \\hline \n";
 1883     while (@captions) {
 1884       $out .= &caption( shift(@captions) ) . '&';
 1885     }
 1886     chop($out);
 1887     $out .= "\\\\ \\hline \n\\end {tabular}\\end{center}\\par\\smallskip\n";
 1888   } elsif ($displayMode eq 'Latex2HTML'){
 1889 
 1890     $out .= "\n\\begin{rawhtml} <TABLE  BORDER=1><TR>\n\\end{rawhtml}\n";
 1891     while (@images) {
 1892       $out .= "\n\\begin{rawhtml} <TD>\n\\end{rawhtml}\n" . &image( shift(@images),%options )
 1893               . "\n\\begin{rawhtml} </TD>\n\\end{rawhtml}\n" ;
 1894     }
 1895 
 1896     $out .= "\n\\begin{rawhtml}</TR><TR>\\end{rawhtml}\n";
 1897     while (@captions) {
 1898       $out .= "\n\\begin{rawhtml} <TH>\n\\end{rawhtml}\n".&caption( shift(@captions) )
 1899               . "\n\\begin{rawhtml} </TH>\n\\end{rawhtml}\n" ;
 1900     }
 1901 
 1902     $out .= "\n\\begin{rawhtml} </TR> </TABLE >\n\\end{rawhtml}";
 1903   } elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng'|| $displayMode eq 'HTML_img'){
 1904     $out .= "<P>\n <TABLE BORDER=2 CELLPADDING=3 CELLSPACING=2 ><TR ALIGN=CENTER    VALIGN=MIDDLE>\n";
 1905     while (@images) {
 1906       $out .= " \n<TD>". &image( shift(@images),%options ) ."</TD>";
 1907     }
 1908     $out .= "</TR>\n<TR>";
 1909     while (@captions) {
 1910       $out .= " <TH>". &caption( shift(@captions) ) ."</TH>";
 1911     }
 1912     $out .= "\n</TR></TABLE></P>\n"
 1913   }
 1914   else {
 1915     $out = "Error: PGbasicmacros: imageRow: Unknown languageMode: $displayMode.\n";
 1916     warn $out;
 1917   }
 1918   $out;
 1919 }
 1920 
 1921 
 1922 ###########
 1923 # Auxiliary macros
 1924 
 1925 sub display_options2{
 1926   my %options = @_;
 1927   my $out_string = "";
 1928   foreach my $key (keys %options) {
 1929     $out_string .= " $key => $options{$key},<BR>";
 1930   }
 1931   $out_string;
 1932 }
 1933 
 1934 
 1935 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9