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

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9