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

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

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9