[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 1784 - (download) (as text) (annotate)
Mon Feb 9 17:09:06 2004 UTC (15 years, 11 months ago) by gage
File size: 63419 byte(s)
Made changes to the check box macros so that they will remain
sticky when more than one check box is checked.
Involves splitting a null separated string ( or perhaps converting
a reference to an array).  uses a new subroutine contained_in(elem,
array_or_arrray_ref_or_null_separated_string)

this resolves part of bug #400

--Mike

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9