[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 1314 - (download) (as text) (annotate)
Wed Jul 2 15:27:59 2003 UTC (16 years, 6 months ago) by apizer
File size: 60236 byte(s)
Add backslash to list of characters filtered out of sticky answers

Arnie

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9