[system] / trunk / pg / macros / PGbasicmacros.pl Repository:
ViewVC logotype

Annotation of /trunk/pg/macros/PGbasicmacros.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2215 - (view) (download) (as text)

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9