[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 1158 - (download) (as text) (annotate)
Fri Jun 13 17:12:18 2003 UTC (16 years, 6 months ago) by sh002i
File size: 58530 byte(s)
rollback change to the way ImageGenerator::add is called.
-sam

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9