[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 3553 - (download) (as text) (annotate)
Tue Aug 23 22:56:50 2005 UTC (14 years, 3 months ago) by jj
File size: 67701 byte(s)
This adds wiring to the pg side for special bits of html to be included before/after the body of a problem.  You also need to update global.conf (and probably want to update Tasks.pm).

A commented out example in global.conf.dist shows how to use this to produce boxed problems a la the Union College server.  In this approach, the added parts are not used for problems rendered in the Library Browser or Problem Set Detail.

This addresses bug 817.  This solution may not be suitable for inclusion of needed bits for modes such as asciimath or tth because the those bits of html are probably needed for display in the Library Browser.  It is hard to distinguish bits which are always wanted, and those which are only wanted for use by Problem.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9