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

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9