[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 1050 - (view) (download) (as text)

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9