| … | |
… | |
| 19 | |
19 | |
| 20 | =cut |
20 | =cut |
| 21 | |
21 | |
| 22 | # this is equivalent to use strict, but can be used within the Safe compartment. |
22 | # this is equivalent to use strict, but can be used within the Safe compartment. |
| 23 | BEGIN{ |
23 | BEGIN{ |
| 24 | main::be_strict; |
24 | be_strict; |
| 25 | } |
25 | } |
| 26 | |
26 | |
| 27 | |
27 | |
| 28 | my $displayMode; |
28 | my $displayMode; |
| 29 | |
29 | |
| … | |
… | |
| 63 | $PI, |
63 | $PI, |
| 64 | $E, |
64 | $E, |
| 65 | @ALPHABET, |
65 | @ALPHABET, |
| 66 | $envir, |
66 | $envir, |
| 67 | $PG_random_generator, |
67 | $PG_random_generator, |
|
|
68 | $inputs_ref, |
| 68 | ); |
69 | ); |
| 69 | |
70 | |
| 70 | sub _PGbasicmacros_init { |
71 | sub _PGbasicmacros_init { |
| 71 | |
72 | |
| 72 | # The big problem is that at compile time in the cached Safe compartment |
73 | # The big problem is that at compile time in the cached Safe compartment |
| … | |
… | |
| 80 | $displayMode = main::PG_restricted_eval(q!$main::displayMode!); |
81 | $displayMode = main::PG_restricted_eval(q!$main::displayMode!); |
| 81 | |
82 | |
| 82 | # This is initializes the remaining variables in the runtime main:: compartment. |
83 | # This is initializes the remaining variables in the runtime main:: compartment. |
| 83 | |
84 | |
| 84 | main::PG_restricted_eval( <<'EndOfFile'); |
85 | main::PG_restricted_eval( <<'EndOfFile'); |
| 85 | $displayMode = $main::displayMode; |
86 | $displayMode = $displayMode; |
| 86 | |
87 | |
| 87 | $main::PAR = PAR(); |
88 | $PAR = PAR(); |
| 88 | $main::BR = BR(); |
89 | $BR = BR(); |
| 89 | $main::LQ = LQ(); |
90 | $main::LQ = LQ(); |
| 90 | $main::RQ = RQ(); |
91 | $main::RQ = RQ(); |
| 91 | $main::BM = BM(); |
92 | $BM = BM(); |
| 92 | $main::EM = EM(); |
93 | $EM = EM(); |
| 93 | $main::BDM = BDM(); |
94 | $main::BDM = BDM(); |
| 94 | $main::EDM = EDM(); |
95 | $main::EDM = EDM(); |
| 95 | $main::LTS = LTS(); |
96 | $main::LTS = LTS(); |
| 96 | $main::GTS = GTS(); |
97 | $main::GTS = GTS(); |
| 97 | $main::LTE = LTE(); |
98 | $main::LTE = LTE(); |
| … | |
… | |
| 101 | $main::SOL = SOLUTION_HEADING(); |
102 | $main::SOL = SOLUTION_HEADING(); |
| 102 | $main::SOLUTION = SOLUTION_HEADING(); |
103 | $main::SOLUTION = SOLUTION_HEADING(); |
| 103 | $main::HINT = HINT_HEADING(); |
104 | $main::HINT = HINT_HEADING(); |
| 104 | $main::US = US(); |
105 | $main::US = US(); |
| 105 | $main::SPACE = SPACE(); |
106 | $main::SPACE = SPACE(); |
| 106 | $main::BBOLD = BBOLD(); |
107 | $BBOLD = BBOLD(); |
| 107 | $main::EBOLD = EBOLD(); |
108 | $EBOLD = EBOLD(); |
| 108 | $main::BITALIC = BITALIC(); |
109 | $main::BITALIC = BITALIC(); |
| 109 | $main::EITALIC = EITALIC(); |
110 | $main::EITALIC = EITALIC(); |
| 110 | $main::BCENTER = BCENTER(); |
111 | $main::BCENTER = BCENTER(); |
| 111 | $main::ECENTER = ECENTER(); |
112 | $main::ECENTER = ECENTER(); |
| 112 | $main::HR = HR(); |
113 | $main::HR = HR(); |
| … | |
… | |
| 127 | |
128 | |
| 128 | # Next we transfer the correct definitions in the main:: compartment to the local my variables |
129 | # Next we transfer the correct definitions in the main:: compartment to the local my variables |
| 129 | # This can't be done inside the eval above because my variables seem to be invisible inside the eval |
130 | # This can't be done inside the eval above because my variables seem to be invisible inside the eval |
| 130 | |
131 | |
| 131 | |
132 | |
| 132 | $PAR = $main::PAR; |
133 | $PAR = $PAR; |
| 133 | $BR = $main::BR; |
134 | $BR = $BR; |
| 134 | $LQ = $main::LQ; |
135 | $LQ = $main::LQ; |
| 135 | $RQ = $main::RQ; |
136 | $RQ = $main::RQ; |
| 136 | $BM = $main::BM; |
137 | $BM = $BM; |
| 137 | $EM = $main::EM; |
138 | $EM = $EM; |
| 138 | $BDM = $main::BDM; |
139 | $BDM = $main::BDM; |
| 139 | $EDM = $main::EDM; |
140 | $EDM = $main::EDM; |
| 140 | $LTS = $main::LTS; |
141 | $LTS = $main::LTS; |
| 141 | $GTS = $main::GTS; |
142 | $GTS = $main::GTS; |
| 142 | $LTE = $main::LTE; |
143 | $LTE = $main::LTE; |
| … | |
… | |
| 146 | $SOL = $main::SOLUTION_HEADING; |
147 | $SOL = $main::SOLUTION_HEADING; |
| 147 | $SOLUTION = $main::SOLUTION_HEADING; |
148 | $SOLUTION = $main::SOLUTION_HEADING; |
| 148 | $HINT = $main::HINT_HEADING; |
149 | $HINT = $main::HINT_HEADING; |
| 149 | $US = $main::US; |
150 | $US = $main::US; |
| 150 | $SPACE = $main::SPACE; |
151 | $SPACE = $main::SPACE; |
| 151 | $BBOLD = $main::BBOLD; |
152 | $BBOLD = $BBOLD; |
| 152 | $EBOLD = $main::EBOLD; |
153 | $EBOLD = $EBOLD; |
| 153 | $HR = $main::HR; |
154 | $HR = $main::HR; |
| 154 | $LBRACE = $main::LBRACE; |
155 | $LBRACE = $main::LBRACE; |
| 155 | $RBRACE = $main::RBRACE; |
156 | $RBRACE = $main::RBRACE; |
| 156 | $LB = $main::LB; |
157 | $LB = $main::LB; |
| 157 | $RB = $main::RB; |
158 | $RB = $main::RB; |
| … | |
… | |
| 165 | # We initialize a local reference to the environment hash rather than transfer the entire hash |
166 | # We initialize a local reference to the environment hash rather than transfer the entire hash |
| 166 | # This way is slightly more efficient. |
167 | # This way is slightly more efficient. |
| 167 | |
168 | |
| 168 | $envir = PG_restricted_eval(q!\%main::envir!); |
169 | $envir = PG_restricted_eval(q!\%main::envir!); |
| 169 | $PG_random_generator = PG_restricted_eval(q!$main::PG_random_generator!); |
170 | $PG_random_generator = PG_restricted_eval(q!$main::PG_random_generator!); |
|
|
171 | $inputs_ref = $envir{inputs_ref}; |
| 170 | |
172 | |
| 171 | } |
173 | } |
| 172 | |
174 | |
| 173 | =head2 Answer blank macros: |
175 | =head2 Answer blank macros: |
| 174 | |
176 | |
| … | |
… | |
| 249 | ANS_RADIO_OPTION( question_number, value,tag ); # equivalent to NAMED_ANS_RADIO_EXTENSION( ANS_NUM_TO_NAME(number), value,tag) |
251 | ANS_RADIO_OPTION( question_number, value,tag ); # equivalent to NAMED_ANS_RADIO_EXTENSION( ANS_NUM_TO_NAME(number), value,tag) |
| 250 | |
252 | |
| 251 | |
253 | |
| 252 | =cut |
254 | =cut |
| 253 | |
255 | |
|
|
256 | |
|
|
257 | |
| 254 | sub labeled_ans_rule { # syntactic sugar for NAMED_ANS_RULE |
258 | sub labeled_ans_rule { # syntactic sugar for NAMED_ANS_RULE |
| 255 | my($name,$col) = @_; |
259 | my($name,$col) = @_; |
| 256 | $col = 20 unless defined($col); |
260 | $col = 20 unless defined($col); |
| 257 | NAMED_ANS_RULE($name,$col); |
261 | NAMED_ANS_RULE($name,$col); |
| 258 | } |
262 | } |
| 259 | |
263 | |
| 260 | sub NAMED_ANS_RULE { |
264 | sub NAMED_ANS_RULE { |
| 261 | my($name,$col) = @_; |
265 | my($name,$col) = @_; |
| 262 | my $len = 0.07*$col; |
266 | my $len = 0.07*$col; |
| 263 | my $answer_value = ''; |
267 | my $answer_value = ''; |
| 264 | $answer_value = ${$main::inputs_ref}{$name} if defined(${$main::inputs_ref}{$name}); |
268 | $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name}); |
| 265 | if ($answer_value =~ /\0/ ) { |
269 | if ($answer_value =~ /\0/ ) { |
| 266 | my @answers = split("\0", $answer_value); |
270 | my @answers = split("\0", $answer_value); |
| 267 | $answer_value = shift(@answers); # use up the first answer |
271 | $answer_value = shift(@answers); # use up the first answer |
| 268 | $main::rh_sticky_answers{$name}=\@answers; # store the rest |
272 | PG_restricted_eval(q!$main::rh_sticky_answers{$name}=\@answers;!); |
|
|
273 | # store the rest -- beacuse this stores to a main:; variable |
|
|
274 | # it must be evaluated at run time |
| 269 | $answer_value= '' unless defined($answer_value); |
275 | $answer_value= '' unless defined($answer_value); |
| 270 | } elsif (ref($answer_value) eq 'ARRAY') { |
276 | } elsif (ref($answer_value) eq 'ARRAY') { |
| 271 | my @answers = @{ $answer_value}; |
277 | my @answers = @{ $answer_value}; |
| 272 | $answer_value = shift(@answers); # use up the first answer |
278 | $answer_value = shift(@answers); # use up the first answer |
| 273 | $main::rh_sticky_answers{$name}=\@answers; # store the rest |
279 | PG_restricted_eval(q!$main::rh_sticky_answers{$name}=\@answers;!); |
|
|
280 | # store the rest -- beacuse this stores to a main:; variable |
|
|
281 | # it must be evaluated at run time |
| 274 | $answer_value= '' unless defined($answer_value); |
282 | $answer_value= '' unless defined($answer_value); |
| 275 | } |
283 | } |
| 276 | |
284 | |
| 277 | $answer_value =~ tr/$@`//d; ## make sure student answers can not be interpolated by e.g. EV3 |
285 | $answer_value =~ tr/$@`//d; ## make sure student answers can not be interpolated by e.g. EV3 |
| 278 | $name = RECORD_ANS_NAME($name); |
286 | $name = RECORD_ANS_NAME($name); |
| … | |
… | |
| 289 | |
297 | |
| 290 | sub NAMED_ANS_RULE_EXTENSION { |
298 | sub NAMED_ANS_RULE_EXTENSION { |
| 291 | my($name,$col) = @_; |
299 | my($name,$col) = @_; |
| 292 | my $len = 0.07*$col; |
300 | my $len = 0.07*$col; |
| 293 | my $answer_value = ''; |
301 | my $answer_value = ''; |
| 294 | $answer_value = ${$main::inputs_ref}{$name} if defined(${$main::inputs_ref}{$name}); |
302 | $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name}); |
| 295 | if ( defined($main::rh_sticky_answers{$name}) ) { |
303 | if ( defined(PG_restricted_eval(q!$main::rh_sticky_answers{$name}!)) ) { |
| 296 | $answer_value = shift( @{$main::rh_sticky_answers{$name}}); |
304 | $answer_value = shift( @{PG_restricted_eval(q!$main::rh_sticky_answers{$name}!)}); |
| 297 | $answer_value = '' unless defined($answer_value); |
305 | $answer_value = '' unless defined($answer_value); |
| 298 | } |
306 | } |
| 299 | $answer_value =~ tr/$@//d; ## make sure student answers can not be interpolated by e.g. EV3 |
307 | $answer_value =~ tr/$@//d; ## make sure student answers can not be interpolated by e.g. EV3 |
| 300 | MODES( |
308 | MODES( |
| 301 | TeX => '\\hrulefill\\quad ', |
309 | TeX => '\\hrulefill\\quad ', |
| … | |
… | |
| 317 | $col = 80 unless defined($col); |
325 | $col = 80 unless defined($col); |
| 318 | $name = RECORD_ANS_NAME($name); |
326 | $name = RECORD_ANS_NAME($name); |
| 319 | my $len = 0.07*$col; |
327 | my $len = 0.07*$col; |
| 320 | my $height = .07*$row; |
328 | my $height = .07*$row; |
| 321 | my $answer_value = ''; |
329 | my $answer_value = ''; |
| 322 | $answer_value = $main::inputs_ref->{$name} if defined( $main::inputs_ref->{$name} ); |
330 | $answer_value = $inputs_ref->{$name} if defined( $inputs_ref->{$name} ); |
| 323 | $answer_value =~ tr/$@//d; ## make sure student answers can not be interpolated by e.g. EV3 |
331 | $answer_value =~ tr/$@//d; ## make sure student answers can not be interpolated by e.g. EV3 |
| 324 | my $out = M3( |
332 | my $out = M3( |
| 325 | qq!\\vskip $height in \\hrulefill\\quad !, |
333 | qq!\\vskip $height in \\hrulefill\\quad !, |
| 326 | qq!\\begin{rawhtml}<TEXTAREA NAME="$name" ROWS="$row" COLS="$col" |
334 | qq!\\begin{rawhtml}<TEXTAREA NAME="$name" ROWS="$row" COLS="$col" |
| 327 | WRAP="VIRTUAL">$answer_value</TEXTAREA>\\end{rawhtml}!, |
335 | WRAP="VIRTUAL">$answer_value</TEXTAREA>\\end{rawhtml}!, |
| … | |
… | |
| 345 | my $checked = ''; |
353 | my $checked = ''; |
| 346 | if ($value =~/^\%/) { |
354 | if ($value =~/^\%/) { |
| 347 | $value =~ s/^\%//; |
355 | $value =~ s/^\%//; |
| 348 | $checked = 'CHECKED' |
356 | $checked = 'CHECKED' |
| 349 | } |
357 | } |
| 350 | if (defined($main::inputs_ref->{$name}) ) { |
358 | if (defined($inputs_ref->{$name}) ) { |
| 351 | if ($main::inputs_ref->{$name} eq $value) { |
359 | if ($inputs_ref->{$name} eq $value) { |
| 352 | $checked = 'CHECKED' |
360 | $checked = 'CHECKED' |
| 353 | } else { |
361 | } else { |
| 354 | $checked = ''; |
362 | $checked = ''; |
| 355 | } |
363 | } |
| 356 | |
364 | |
| … | |
… | |
| 377 | my $checked = ''; |
385 | my $checked = ''; |
| 378 | if ($value =~/^\%/) { |
386 | if ($value =~/^\%/) { |
| 379 | $value =~ s/^\%//; |
387 | $value =~ s/^\%//; |
| 380 | $checked = 'CHECKED' |
388 | $checked = 'CHECKED' |
| 381 | } |
389 | } |
| 382 | if (defined($main::inputs_ref->{$name}) ) { |
390 | if (defined($inputs_ref->{$name}) ) { |
| 383 | if ($main::inputs_ref->{$name} eq $value) { |
391 | if ($inputs_ref->{$name} eq $value) { |
| 384 | $checked = 'CHECKED' |
392 | $checked = 'CHECKED' |
| 385 | } else { |
393 | } else { |
| 386 | $checked = ''; |
394 | $checked = ''; |
| 387 | } |
395 | } |
| 388 | |
396 | |
| … | |
… | |
| 454 | if ($value =~/^\%/) { |
462 | if ($value =~/^\%/) { |
| 455 | $value =~ s/^\%//; |
463 | $value =~ s/^\%//; |
| 456 | $checked = 'CHECKED' |
464 | $checked = 'CHECKED' |
| 457 | } |
465 | } |
| 458 | |
466 | |
| 459 | if (defined($main::inputs_ref->{$name}) ) { |
467 | if (defined($inputs_ref->{$name}) ) { |
| 460 | if ($main::inputs_ref->{$name} eq $value) { |
468 | if ($inputs_ref->{$name} eq $value) { |
| 461 | $checked = 'CHECKED' |
469 | $checked = 'CHECKED' |
| 462 | } |
470 | } |
| 463 | else { |
471 | else { |
| 464 | $checked = ''; |
472 | $checked = ''; |
| 465 | } |
473 | } |
| … | |
… | |
| 483 | if ($value =~/^\%/) { |
491 | if ($value =~/^\%/) { |
| 484 | $value =~ s/^\%//; |
492 | $value =~ s/^\%//; |
| 485 | $checked = 'CHECKED' |
493 | $checked = 'CHECKED' |
| 486 | } |
494 | } |
| 487 | |
495 | |
| 488 | if (defined($main::inputs_ref->{$name}) ) { |
496 | if (defined($inputs_ref->{$name}) ) { |
| 489 | if ($main::inputs_ref->{$name} eq $value) { |
497 | if ($inputs_ref->{$name} eq $value) { |
| 490 | $checked = 'CHECKED' |
498 | $checked = 'CHECKED' |
| 491 | } |
499 | } |
| 492 | else { |
500 | else { |
| 493 | $checked = ''; |
501 | $checked = ''; |
| 494 | } |
502 | } |
| … | |
… | |
| 556 | } |
564 | } |
| 557 | |
565 | |
| 558 | sub ans_rule { |
566 | sub ans_rule { |
| 559 | my $len = shift; # gives the optional length of the answer blank |
567 | my $len = shift; # gives the optional length of the answer blank |
| 560 | $len = 20 unless $len ; |
568 | $len = 20 unless $len ; |
| 561 | my $name = NEW_ANS_NAME(++$main::ans_rule_count); |
569 | my $name = NEW_ANS_NAME(inc_ans_rule_count()); |
| 562 | NAMED_ANS_RULE($name ,$len); |
570 | NAMED_ANS_RULE($name ,$len); |
| 563 | } |
571 | } |
| 564 | sub ans_rule_extension { |
572 | sub ans_rule_extension { |
| 565 | my $len = shift; |
573 | my $len = shift; |
| 566 | $len = 20 unless $len ; |
574 | $len = 20 unless $len ; |
| 567 | my $name = NEW_ANS_NAME($main::ans_rule_count); # don't update the answer name |
575 | my $name = NEW_ANS_NAME(PG_restricted_eval(q!$main::ans_rule_count!)); # don't update the answer name |
| 568 | NAMED_ANS_RULE($name ,$len); |
576 | NAMED_ANS_RULE($name ,$len); |
| 569 | } |
577 | } |
| 570 | sub ans_radio_buttons { |
578 | sub ans_radio_buttons { |
| 571 | my $name = NEW_ANS_NAME(++$main::ans_rule_count); |
579 | my $name = NEW_ANS_NAME(inc_ans_rule_count()); |
| 572 | my @radio_buttons = NAMED_ANS_RADIO_BUTTONS($name, @_); |
580 | my @radio_buttons = NAMED_ANS_RADIO_BUTTONS($name, @_); |
| 573 | |
581 | |
| 574 | if ($displayMode eq 'TeX') { |
582 | if ($displayMode eq 'TeX') { |
| 575 | $radio_buttons[0] = "\n\\begin{itemize}\n" . $radio_buttons[0]; |
583 | $radio_buttons[0] = "\n\\begin{itemize}\n" . $radio_buttons[0]; |
| 576 | $radio_buttons[$#radio_buttons] .= "\n\\end{itemize}\n"; |
584 | $radio_buttons[$#radio_buttons] .= "\n\\end{itemize}\n"; |
| … | |
… | |
| 579 | (wantarray) ? @radio_buttons: join(" ", @radio_buttons); |
587 | (wantarray) ? @radio_buttons: join(" ", @radio_buttons); |
| 580 | } |
588 | } |
| 581 | |
589 | |
| 582 | #added 6/14/2000 by David Etlinger |
590 | #added 6/14/2000 by David Etlinger |
| 583 | sub ans_checkbox { |
591 | sub ans_checkbox { |
| 584 | my $name = NEW_ANS_NAME( ++$main::ans_rule_count ); |
592 | my $name = NEW_ANS_NAME( inc_ans_rule_count() ); |
| 585 | my @checkboxes = NAMED_ANS_CHECKBOX_BUTTONS( $name, @_ ); |
593 | my @checkboxes = NAMED_ANS_CHECKBOX_BUTTONS( $name, @_ ); |
| 586 | |
594 | |
| 587 | if ($displayMode eq 'TeX') { |
595 | if ($displayMode eq 'TeX') { |
| 588 | $checkboxes[0] = "\n\\begin{itemize}\n" . $checkboxes[0]; |
596 | $checkboxes[0] = "\n\\begin{itemize}\n" . $checkboxes[0]; |
| 589 | $checkboxes[$#checkboxes] .= "\n\\end{itemize}\n"; |
597 | $checkboxes[$#checkboxes] .= "\n\\end{itemize}\n"; |
| … | |
… | |
| 598 | ## This will not work with latex2HTML mode since it creates gif equations. |
606 | ## This will not work with latex2HTML mode since it creates gif equations. |
| 599 | |
607 | |
| 600 | sub tex_ans_rule { |
608 | sub tex_ans_rule { |
| 601 | my $len = shift; |
609 | my $len = shift; |
| 602 | $len = 20 unless $len ; |
610 | $len = 20 unless $len ; |
| 603 | my $name = NEW_ANS_NAME(++$main::ans_rule_count); |
611 | my $name = NEW_ANS_NAME(inc_ans_rule_count()); |
| 604 | my $answer_rule = NAMED_ANS_RULE($name ,$len); # we don't want to create three answer rules in different modes. |
612 | my $answer_rule = NAMED_ANS_RULE($name ,$len); # we don't want to create three answer rules in different modes. |
| 605 | my $out = MODES( |
613 | my $out = MODES( |
| 606 | 'TeX' => $answer_rule, |
614 | 'TeX' => $answer_rule, |
| 607 | 'Latex2HTML' => '\\fbox{Answer boxes cannot be placed inside typeset equations}', |
615 | 'Latex2HTML' => '\\fbox{Answer boxes cannot be placed inside typeset equations}', |
| 608 | 'HTML_tth' => '\\begin{rawhtml} '. $answer_rule.'\\end{rawhtml}', |
616 | 'HTML_tth' => '\\begin{rawhtml} '. $answer_rule.'\\end{rawhtml}', |
| … | |
… | |
| 613 | $out; |
621 | $out; |
| 614 | } |
622 | } |
| 615 | sub tex_ans_rule_extension { |
623 | sub tex_ans_rule_extension { |
| 616 | my $len = shift; |
624 | my $len = shift; |
| 617 | $len = 20 unless $len ; |
625 | $len = 20 unless $len ; |
| 618 | my $name = NEW_ANS_NAME($main::ans_rule_count); |
626 | my $name = NEW_ANS_NAME(PG_restricted_eval(q!$main::ans_rule_count!)); |
| 619 | my $answer_rule = NAMED_ANS_RULE($name ,$len); # we don't want to create three answer rules in different modes. |
627 | my $answer_rule = NAMED_ANS_RULE($name ,$len); # we don't want to create three answer rules in different modes. |
| 620 | my $out = MODES( |
628 | my $out = MODES( |
| 621 | 'TeX' => $answer_rule, |
629 | 'TeX' => $answer_rule, |
| 622 | 'Latex2HTML' => '\fbox{Answer boxes cannot be placed inside typeset equations}', |
630 | 'Latex2HTML' => '\fbox{Answer boxes cannot be placed inside typeset equations}', |
| 623 | 'HTML_tth' => '\\begin{rawhtml} '. $answer_rule.'\\end{rawhtml}', |
631 | 'HTML_tth' => '\\begin{rawhtml} '. $answer_rule.'\\end{rawhtml}', |
| … | |
… | |
| 661 | sub ans_box { |
669 | sub ans_box { |
| 662 | my $row = shift; |
670 | my $row = shift; |
| 663 | my $col =shift; |
671 | my $col =shift; |
| 664 | $row = 5 unless $row; |
672 | $row = 5 unless $row; |
| 665 | $col = 80 unless $col; |
673 | $col = 80 unless $col; |
| 666 | my $name = NEW_ANS_NAME(++$main::ans_rule_count); |
674 | my $name = NEW_ANS_NAME(inc_ans_rule_count()); |
| 667 | NAMED_ANS_BOX($name ,$row,$col); |
675 | NAMED_ANS_BOX($name ,$row,$col); |
| 668 | } |
676 | } |
| 669 | |
677 | |
| 670 | #this is legacy code; use ans_checkbox instead |
678 | #this is legacy code; use ans_checkbox instead |
| 671 | sub checkbox { |
679 | sub checkbox { |
| … | |
… | |
| 677 | sub NAMED_POP_UP_LIST { |
685 | sub NAMED_POP_UP_LIST { |
| 678 | my $name = shift; |
686 | my $name = shift; |
| 679 | my @list = @_; |
687 | my @list = @_; |
| 680 | $name = RECORD_ANS_NAME($name); # record answer name |
688 | $name = RECORD_ANS_NAME($name); # record answer name |
| 681 | my $answer_value = ''; |
689 | my $answer_value = ''; |
| 682 | $answer_value = ${$main::inputs_ref}{$name} if defined(${$main::inputs_ref}{$name}); |
690 | $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name}); |
| 683 | my $out = ""; |
691 | my $out = ""; |
| 684 | if ($displayMode eq 'HTML' or $displayMode eq 'HTML_tth' or |
692 | if ($displayMode eq 'HTML' or $displayMode eq 'HTML_tth' or |
| 685 | $displayMode eq 'HTML_dpng' or $displayMode eq 'HTML_img') { |
693 | $displayMode eq 'HTML_dpng' or $displayMode eq 'HTML_img') { |
| 686 | $out = qq!<SELECT NAME = "$name" SIZE=1> \n!; |
694 | $out = qq!<SELECT NAME = "$name" SIZE=1> \n!; |
| 687 | my $i; |
695 | my $i; |
| … | |
… | |
| 704 | |
712 | |
| 705 | } |
713 | } |
| 706 | |
714 | |
| 707 | sub pop_up_list { |
715 | sub pop_up_list { |
| 708 | my @list = @_; |
716 | my @list = @_; |
| 709 | my $name = NEW_ANS_NAME(++$main::ans_rule_count); # get new answer name |
717 | my $name = NEW_ANS_NAME(inc_ans_rule_count()); # get new answer name |
| 710 | NAMED_POP_UP_LIST($name, @list); |
718 | NAMED_POP_UP_LIST($name, @list); |
| 711 | } |
719 | } |
| 712 | |
720 | |
| 713 | |
721 | |
| 714 | |
722 | |
| … | |
… | |
| 759 | my $name = shift; |
767 | my $name = shift; |
| 760 | my $col = shift; |
768 | my $col = shift; |
| 761 | $col = 20 unless $col; |
769 | $col = 20 unless $col; |
| 762 | my $answer_value = ''; |
770 | my $answer_value = ''; |
| 763 | |
771 | |
| 764 | $answer_value = ${$main::inputs_ref}{$name} if defined(${$main::inputs_ref}{$name}); |
772 | $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name}); |
| 765 | if ($answer_value =~ /\0/ ) { |
773 | if ($answer_value =~ /\0/ ) { |
| 766 | my @answers = split("\0", $answer_value); |
774 | my @answers = split("\0", $answer_value); |
| 767 | $answer_value = shift(@answers); |
775 | $answer_value = shift(@answers); |
| 768 | $answer_value= '' unless defined($answer_value); |
776 | $answer_value= '' unless defined($answer_value); |
| 769 | } elsif (ref($answer_value) eq 'ARRAY') { |
777 | } elsif (ref($answer_value) eq 'ARRAY') { |
| … | |
… | |
| 783 | sub ans_array{ |
791 | sub ans_array{ |
| 784 | my $m = shift; |
792 | my $m = shift; |
| 785 | my $n = shift; |
793 | my $n = shift; |
| 786 | my $col = shift; |
794 | my $col = shift; |
| 787 | $col = 20 unless $col; |
795 | $col = 20 unless $col; |
| 788 | my $num = ++$main::ans_rule_count ; |
796 | my $num = inc_ans_rule_count() ; |
| 789 | my $name = NEW_ANS_ARRAY_NAME($num,0,0); |
797 | my $name = NEW_ANS_ARRAY_NAME($num,0,0); |
| 790 | my @options = @_; |
798 | my @options = @_; |
| 791 | my @array=(); |
799 | my @array=(); |
| 792 | my $string; |
800 | my $string; |
| 793 | my $answer_value = ""; |
801 | my $answer_value = ""; |
| … | |
… | |
| 819 | sub ans_array_extension{ |
827 | sub ans_array_extension{ |
| 820 | my $m = shift; |
828 | my $m = shift; |
| 821 | my $n = shift; |
829 | my $n = shift; |
| 822 | my $col = shift; |
830 | my $col = shift; |
| 823 | $col = 20 unless $col; |
831 | $col = 20 unless $col; |
| 824 | my $num = $main::ans_rule_count; |
832 | my $num = PG_restricted_eval(q!$main::ans_rule_count!); |
| 825 | my @options = @_; |
833 | my @options = @_; |
| 826 | my $name; |
834 | my $name; |
| 827 | my @array=(); |
835 | my @array=(); |
| 828 | my $string; |
836 | my $string; |
| 829 | my $answer_value = ""; |
837 | my $answer_value = ""; |
| … | |
… | |
| 879 | |
887 | |
| 880 | |
888 | |
| 881 | sub solution { |
889 | sub solution { |
| 882 | my @in = @_; |
890 | my @in = @_; |
| 883 | my $out = ''; |
891 | my $out = ''; |
| 884 | $main::solutionExists =1; |
892 | PG_restricted_eval(q!$main::solutionExists =1!); |
| 885 | if ($main::envir{'displaySolutionsQ'}) {$out = join(' ',@in);} |
893 | if (PG_restricted_eval(q!$main::envir{'displaySolutionsQ'}!)) {$out = join(' ',@in);} |
| 886 | $out; |
894 | $out; |
| 887 | } |
895 | } |
| 888 | |
896 | |
| 889 | |
897 | |
| 890 | sub SOLUTION { |
898 | sub SOLUTION { |
| … | |
… | |
| 895 | |
903 | |
| 896 | sub hint { |
904 | sub hint { |
| 897 | my @in = @_; |
905 | my @in = @_; |
| 898 | my $out = ''; |
906 | my $out = ''; |
| 899 | |
907 | |
| 900 | $main::hintExists =1; |
908 | PG_restricted_eval(q!$main::hintExists =1; |
| 901 | $main::numOfAttempts = 0 unless defined($main::numOfAttempts); |
909 | $main::numOfAttempts = 0 unless defined($main::numOfAttempts); |
|
|
910 | !); |
| 902 | |
911 | |
| 903 | if ($main::displayMode eq 'TeX') { |
912 | if ($displayMode eq 'TeX') { |
| 904 | $out = ''; # do nothing since hints are not available for download |
913 | $out = ''; # do nothing since hints are not available for download |
| 905 | } elsif (($main::envir{'displayHintsQ'}) and ($main::numOfAttempts >= $main::showHint)) |
914 | } elsif (($envir->{'displayHintsQ'}) and |
|
|
915 | PG_restricted_eval(q!($main::numOfAttempts >= $main::showHint)!)) |
| 906 | |
916 | |
| 907 | ## the second test above prevents a hint being shown if a doctored form is submitted |
917 | ## the second test above prevents a hint being shown if a doctored form is submitted |
| 908 | |
918 | |
| 909 | {$out = join(' ',@in);} # show hint |
919 | {$out = join(' ',@in);} # show hint |
| 910 | |
920 | |
| 911 | $out ; |
921 | $out ; |
| 912 | } |
922 | } |
| 913 | |
923 | |
| 914 | |
924 | |
| 915 | sub HINT { |
925 | sub HINT { |
| 916 | TEXT("$main::BR" . hint(@_) . "$main::BR") if hint(@_); |
926 | TEXT("$BR" . hint(@_) . "$BR") if hint(@_); |
| 917 | } |
927 | } |
| 918 | |
928 | |
| 919 | |
929 | |
| 920 | |
930 | |
| 921 | # End hints and solutions macros |
931 | # End hints and solutions macros |
| … | |
… | |
| 945 | =cut |
955 | =cut |
| 946 | |
956 | |
| 947 | |
957 | |
| 948 | sub random { |
958 | sub random { |
| 949 | my ($begin, $end, $incr) = @_; |
959 | my ($begin, $end, $incr) = @_; |
| 950 | $main::PG_random_generator->random($begin,$end,$incr); |
960 | $PG_random_generator->random($begin,$end,$incr); |
| 951 | } |
961 | } |
| 952 | |
962 | |
| 953 | |
963 | |
| 954 | sub non_zero_random { ##gives a non-zero random number |
964 | sub non_zero_random { ##gives a non-zero random number |
| 955 | my (@arguments)=@_; |
965 | my (@arguments)=@_; |
| … | |
… | |
| 1295 | #print "$start_delim $end_delim evaluate_string=$1<BR>"; |
1305 | #print "$start_delim $end_delim evaluate_string=$1<BR>"; |
| 1296 | ($eval_out,$PG_eval_errors,$PG_full_error_report) = &$actionRef($1); |
1306 | ($eval_out,$PG_eval_errors,$PG_full_error_report) = &$actionRef($1); |
| 1297 | $eval_out = "$start_delim $eval_out $end_delim" if $PG_full_error_report; |
1307 | $eval_out = "$start_delim $eval_out $end_delim" if $PG_full_error_report; |
| 1298 | $out = $out . $eval_out; |
1308 | $out = $out . $eval_out; |
| 1299 | #print "$start_delim $end_delim new substring_out=$out<BR><p><BR>"; |
1309 | #print "$start_delim $end_delim new substring_out=$out<BR><p><BR>"; |
| 1300 | $out .="$main::PAR ERROR $0 in ev_substring, PGbasicmacros.pl:$main::PAR <PRE> $@ </PRE>$main::PAR" if $@; |
1310 | $out .="$PAR ERROR $0 in ev_substring, PGbasicmacros.pl:$PAR <PRE> $@ </PRE>$PAR" if $@; |
| 1301 | } |
1311 | } |
| 1302 | else { |
1312 | else { |
| 1303 | $out .= $string; # flush the last part of the string |
1313 | $out .= $string; # flush the last part of the string |
| 1304 | last; |
1314 | last; |
| 1305 | } |
1315 | } |
| … | |
… | |
| 1317 | my $in = shift; |
1327 | my $in = shift; |
| 1318 | my ($out,$PG_eval_errors,$PG_full_error_report) = PG_restricted_eval("$in;"); |
1328 | my ($out,$PG_eval_errors,$PG_full_error_report) = PG_restricted_eval("$in;"); |
| 1319 | # the addition of the ; seems to provide better error reporting |
1329 | # the addition of the ; seems to provide better error reporting |
| 1320 | if ($PG_eval_errors) { |
1330 | if ($PG_eval_errors) { |
| 1321 | my @errorLines = split("\n",$PG_eval_errors); |
1331 | my @errorLines = split("\n",$PG_eval_errors); |
| 1322 | #$out = "<PRE>$main::PAR % ERROR in $0:old_safe_ev, PGbasicmacros.pl: $main::PAR % There is an error occuring inside evaluation brackets \\{ ...code... \\} $main::BR % somewhere in an EV2 or EV3 or BEGIN_TEXT block. $main::BR % Code evaluated:$main::BR $in $main::BR % $main::BR % $errorLines[0]\n % $errorLines[1]$main::BR % $main::BR % $main::BR </PRE> "; |
1332 | #$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> "; |
| 1323 | warn " ERROR in old_safe_ev, PGbasicmacros.pl: <PRE> |
1333 | warn " ERROR in old_safe_ev, PGbasicmacros.pl: <PRE> |
| 1324 | ## There is an error occuring inside evaluation brackets \\{ ...code... \\} |
1334 | ## There is an error occuring inside evaluation brackets \\{ ...code... \\} |
| 1325 | ## somewhere in an EV2 or EV3 or BEGIN_TEXT block. |
1335 | ## somewhere in an EV2 or EV3 or BEGIN_TEXT block. |
| 1326 | ## Code evaluated: |
1336 | ## Code evaluated: |
| 1327 | ## $in |
1337 | ## $in |
| 1328 | ##" .join("\n ", @errorLines). " |
1338 | ##" .join("\n ", @errorLines). " |
| 1329 | ##</PRE>$main::BR |
1339 | ##</PRE>$BR |
| 1330 | "; |
1340 | "; |
| 1331 | $out ="$main::PAR $main::BBOLD $in $main::EBOLD $main::PAR"; |
1341 | $out ="$PAR $BBOLD $in $EBOLD $PAR"; |
| 1332 | |
1342 | |
| 1333 | |
1343 | |
| 1334 | } |
1344 | } |
| 1335 | |
1345 | |
| 1336 | ($out,$PG_eval_errors,$PG_full_error_report); |
1346 | ($out,$PG_eval_errors,$PG_full_error_report); |
| … | |
… | |
| 1354 | #sub math_ev3 { |
1364 | #sub math_ev3 { |
| 1355 | # my $in = shift; #print "in=$in<BR>"; |
1365 | # my $in = shift; #print "in=$in<BR>"; |
| 1356 | # my ($out,$PG_eval_errors,$PG_full_error_report); |
1366 | # my ($out,$PG_eval_errors,$PG_full_error_report); |
| 1357 | # $in = FEQ($in); |
1367 | # $in = FEQ($in); |
| 1358 | # $in =~ s/%/\\%/g; # % causes trouble in TeX and HTML_tth it usually (always?) indicates an error, not comment |
1368 | # $in =~ s/%/\\%/g; # % causes trouble in TeX and HTML_tth it usually (always?) indicates an error, not comment |
| 1359 | # return("$main::BM $in $main::EM") unless ($displayMode eq 'HTML_tth'); |
1369 | # return("$BM $in $EM") unless ($displayMode eq 'HTML_tth'); |
| 1360 | # $in = "\\(" . $in . "\\)"; |
1370 | # $in = "\\(" . $in . "\\)"; |
| 1361 | # $out = tth($in); |
1371 | # $out = tth($in); |
| 1362 | # ($out,$PG_eval_errors,$PG_full_error_report); |
1372 | # ($out,$PG_eval_errors,$PG_full_error_report); |
| 1363 | # |
1373 | # |
| 1364 | #} |
1374 | #} |
| … | |
… | |
| 1419 | $string = ev_substring($string,"\\{","\\}",\&old_safe_ev); |
1429 | $string = ev_substring($string,"\\{","\\}",\&old_safe_ev); |
| 1420 | $string = ev_substring($string,"\\<","\\>",\&old_safe_ev); |
1430 | $string = ev_substring($string,"\\<","\\>",\&old_safe_ev); |
| 1421 | $string = ev_substring($string,"\\(","\\)",\&math_ev3); |
1431 | $string = ev_substring($string,"\\(","\\)",\&math_ev3); |
| 1422 | $string = ev_substring($string,"\\[","\\]",\&display_math_ev3); |
1432 | $string = ev_substring($string,"\\[","\\]",\&display_math_ev3); |
| 1423 | # macros for displaying math |
1433 | # macros for displaying math |
| 1424 | $string =~ s/\\\(/$main::BM/g; |
1434 | $string =~ s/\\\(/$BM/g; |
| 1425 | $string =~ s/\\\)/$main::EM/g; |
1435 | $string =~ s/\\\)/$EM/g; |
| 1426 | $string =~ s/\\\[/$main::BDM/g; |
1436 | $string =~ s/\\\[/$BDM/g; |
| 1427 | $string =~ s/\\\]/$main::EDM/g; |
1437 | $string =~ s/\\\]/$EDM/g; |
| 1428 | $string; |
1438 | $string; |
| 1429 | } |
1439 | } |
| 1430 | |
1440 | |
| 1431 | sub EV3{ |
1441 | sub EV3{ |
| 1432 | my $string = join(" ",@_); |
1442 | my $string = join(" ",@_); |
| … | |
… | |
| 1435 | # interpolate variables |
1445 | # interpolate variables |
| 1436 | my ($evaluated_string,$PG_eval_errors,$PG_full_errors) = PG_restricted_eval("<<END_OF_EVALUATION_STRING\n$string\nEND_OF_EVALUATION_STRING\n"); |
1446 | my ($evaluated_string,$PG_eval_errors,$PG_full_errors) = PG_restricted_eval("<<END_OF_EVALUATION_STRING\n$string\nEND_OF_EVALUATION_STRING\n"); |
| 1437 | if ($PG_eval_errors) { |
1447 | if ($PG_eval_errors) { |
| 1438 | my @errorLines = split("\n",$PG_eval_errors); |
1448 | my @errorLines = split("\n",$PG_eval_errors); |
| 1439 | $string =~ s/</</g; $string =~ s/>/>/g; |
1449 | $string =~ s/</</g; $string =~ s/>/>/g; |
| 1440 | $evaluated_string = "<PRE>$main::PAR % ERROR in $0:EV3, PGbasicmacros.pl: $main::PAR % There is an error occuring in the following code:$main::BR $string $main::BR % $main::BR % $errorLines[0]\n % $errorLines[1]$main::BR % $main::BR % $main::BR </PRE> "; |
1450 | $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> "; |
| 1441 | $@=""; |
1451 | $@=""; |
| 1442 | } |
1452 | } |
| 1443 | $string = $evaluated_string; |
1453 | $string = $evaluated_string; |
| 1444 | $string = ev_substring($string,"\\(","\\)",\&math_ev3); |
1454 | $string = ev_substring($string,"\\(","\\)",\&math_ev3); |
| 1445 | $string = ev_substring($string,"\\[","\\]",\&display_math_ev3); |
1455 | $string = ev_substring($string,"\\[","\\]",\&display_math_ev3); |
| … | |
… | |
| 1474 | |
1484 | |
| 1475 | =cut |
1485 | =cut |
| 1476 | |
1486 | |
| 1477 | sub beginproblem { |
1487 | sub beginproblem { |
| 1478 | my $out = ""; |
1488 | my $out = ""; |
|
|
1489 | my $problemValue = $envir->{problemValue}; |
|
|
1490 | my $fileName = $envir->{problemValue}; |
|
|
1491 | my $probNum = $envir->{probNum}; |
| 1479 | my $TeXFileName = protect_underbar($main::fileName); |
1492 | my $TeXFileName = protect_underbar($envir->{fileName}); |
| 1480 | my $l2hFileName = protect_underbar($main::fileName); |
1493 | my $l2hFileName = protect_underbar($envir->{fileName}); |
| 1481 | my %inlist; |
1494 | my %inlist; |
| 1482 | my $points ='pts'; |
1495 | my $points ='pts'; |
|
|
1496 | |
| 1483 | $points = 'pt' if $main::problemValue == 1; |
1497 | $points = 'pt' if $problemValue == 1; |
| 1484 | ## Prepare header for the problem |
1498 | ## Prepare header for the problem |
| 1485 | grep($inlist{$_}++,@{ $envir->{'PRINT_FILE_NAMES_FOR'} }); |
1499 | grep($inlist{$_}++,@{ $envir->{'PRINT_FILE_NAMES_FOR'} }); |
| 1486 | if ( defined($inlist{$main::studentLogin}) and ($inlist{$main::studentLogin} > 0) ) { |
1500 | if ( defined($inlist{$envir->{studentLogin}}) and ($inlist{$envir->{studentLogin}} > 0) ) { |
| 1487 | $out = &M3("\n\n\\medskip\\hrule\\smallskip\\par{\\bf ${main::probNum}.{\\footnotesize ($main::problemValue $points) $TeXFileName}}\\newline ", |
1501 | $out = &M3("\n\n\\medskip\\hrule\\smallskip\\par{\\bf ${probNum}.{\\footnotesize ($problemValue $points) $TeXFileName}}\\newline ", |
| 1488 | " \\begin{rawhtml} ($main::problemValue $points) <B>$l2hFileName</B><BR>\\end{rawhtml}", |
1502 | " \\begin{rawhtml} ($problemValue $points) <B>$l2hFileName</B><BR>\\end{rawhtml}", |
| 1489 | "($main::problemValue $points) <B>$main::fileName</B><BR>" |
1503 | "($problemValue $points) <B>$fileName</B><BR>" |
| 1490 | ); |
1504 | ); |
| 1491 | } else { |
1505 | } else { |
| 1492 | $out = &M3("\n\n\\smallskip\\hrule\\smallskip\\par{\\bf ${main::probNum}.}($main::problemValue $points) ", |
1506 | $out = &M3("\n\n\\smallskip\\hrule\\smallskip\\par{\\bf ${probNum}.}($problemValue $points) ", |
| 1493 | "($main::problemValue $points) ", |
1507 | "($problemValue $points) ", |
| 1494 | "($main::problemValue $points) " |
1508 | "($problemValue $points) " |
| 1495 | ); |
1509 | ); |
| 1496 | } |
1510 | } |
| 1497 | $out; |
1511 | $out; |
| 1498 | |
1512 | |
| 1499 | } |
1513 | } |
| … | |
… | |
| 1521 | "<OL TYPE=\"A\" VALUE=\"1\">\n" |
1535 | "<OL TYPE=\"A\" VALUE=\"1\">\n" |
| 1522 | ) ; |
1536 | ) ; |
| 1523 | my $elem; |
1537 | my $elem; |
| 1524 | foreach $elem (@array) { |
1538 | foreach $elem (@array) { |
| 1525 | $out .= MODES( |
1539 | $out .= MODES( |
| 1526 | TeX=> "\\item[$main::ALPHABET[$i].] $elem\n", |
1540 | TeX=> "\\item[$ALPHABET[$i].] $elem\n", |
| 1527 | Latex2HTML=> " \\begin{rawhtml} <LI> \\end{rawhtml} $elem ", |
1541 | Latex2HTML=> " \\begin{rawhtml} <LI> \\end{rawhtml} $elem ", |
| 1528 | HTML=> "<LI> $elem\n", |
1542 | HTML=> "<LI> $elem\n", |
| 1529 | HTML_dpng=> "<LI> $elem <br /> <br /> \n" |
1543 | HTML_dpng=> "<LI> $elem <br /> <br /> \n" |
| 1530 | ); |
1544 | ); |
| 1531 | $i++; |
1545 | $i++; |
| … | |
… | |
| 1540 | sub htmlLink { |
1554 | sub htmlLink { |
| 1541 | my $url = shift; |
1555 | my $url = shift; |
| 1542 | my $text = shift; |
1556 | my $text = shift; |
| 1543 | my $options = shift; |
1557 | my $options = shift; |
| 1544 | $options = "" unless defined($options); |
1558 | $options = "" unless defined($options); |
| 1545 | return "${main::BBOLD}[ broken link: $text ] ${main::EBOLD}" unless defined($url); |
1559 | return "$BBOLD\[ broken link: $text \] $EBOLD" unless defined($url); |
| 1546 | M3( "{\\bf \\underline{$text} }", |
1560 | M3( "{\\bf \\underline{$text} }", |
| 1547 | "\\begin{rawhtml} <A HREF=\"$url\" $options> $text </A>\\end{rawhtml}", |
1561 | "\\begin{rawhtml} <A HREF=\"$url\" $options> $text </A>\\end{rawhtml}", |
| 1548 | "<A HREF=\"$url\" $options> $text </A>" |
1562 | "<A HREF=\"$url\" $options> $text </A>" |
| 1549 | ); |
1563 | ); |
| 1550 | } |
1564 | } |
|
|
1565 | |
| 1551 | sub appletLink { |
1566 | sub appletLink { |
| 1552 | my $url = shift; |
1567 | my $url = shift; |
| 1553 | my $options = shift; |
1568 | my $options = shift; |
| 1554 | $options = "" unless defined($options); |
1569 | $options = "" unless defined($options); |
| 1555 | M3( "{\\bf \\underline{APPLET} }", |
1570 | M3( "{\\bf \\underline{APPLET} }", |
| … | |
… | |
| 1683 | while (@elements) { |
1698 | while (@elements) { |
| 1684 | $out .= " \n\\begin{rawhtml}\n<TD> \n\\end{rawhtml}\n" . shift(@elements) . " \n\\begin{rawhtml}\n</TD> \n\\end{rawhtml}\n"; |
1699 | $out .= " \n\\begin{rawhtml}\n<TD> \n\\end{rawhtml}\n" . shift(@elements) . " \n\\begin{rawhtml}\n</TD> \n\\end{rawhtml}\n"; |
| 1685 | } |
1700 | } |
| 1686 | $out .= " \n\\begin{rawhtml}\n</TR> \n\\end{rawhtml}\n"; |
1701 | $out .= " \n\\begin{rawhtml}\n</TR> \n\\end{rawhtml}\n"; |
| 1687 | } |
1702 | } |
| 1688 | elsif ($main::displayMode eq 'HTML' || $main::displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng'||$displayMode eq 'HTML_img') { |
1703 | elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng'||$displayMode eq 'HTML_img') { |
| 1689 | $out .= "<TR>\n"; |
1704 | $out .= "<TR>\n"; |
| 1690 | while (@elements) { |
1705 | while (@elements) { |
| 1691 | $out .= "<TD>" . shift(@elements) . "</TD>"; |
1706 | $out .= "<TD>" . shift(@elements) . "</TD>"; |
| 1692 | } |
1707 | } |
| 1693 | $out .= "\n</TR>\n"; |
1708 | $out .= "\n</TR>\n"; |
| 1694 | } |
1709 | } |
| 1695 | else { |
1710 | else { |
| 1696 | $out = "Error: PGchoicemacros: row: Unknown displayMode: $main::displayMode.\n"; |
1711 | $out = "Error: PGchoicemacros: row: Unknown displayMode: $displayMode.\n"; |
| 1697 | } |
1712 | } |
| 1698 | $out; |
1713 | $out; |
| 1699 | } |
1714 | } |
| 1700 | |
1715 | |
| 1701 | =head2 Macros for displaying static images |
1716 | =head2 Macros for displaying static images |
| … | |
… | |
| 1748 | my @output_list = (); |
1763 | my @output_list = (); |
| 1749 | while(@image_list) { |
1764 | while(@image_list) { |
| 1750 | my $imageURL = alias(shift @image_list); |
1765 | my $imageURL = alias(shift @image_list); |
| 1751 | my $out=""; |
1766 | my $out=""; |
| 1752 | |
1767 | |
| 1753 | if ($main::displayMode eq 'TeX') { |
1768 | if ($displayMode eq 'TeX') { |
| 1754 | my $imagePath = $imageURL; # in TeX mode, alias gives us a path, not a URL |
1769 | my $imagePath = $imageURL; # in TeX mode, alias gives us a path, not a URL |
| 1755 | if ($envir->{texDisposition} eq "pdf") { |
1770 | if ($envir->{texDisposition} eq "pdf") { |
| 1756 | # We're going to create PDF files with our TeX (using pdflatex), so |
1771 | # We're going to create PDF files with our TeX (using pdflatex), so |
| 1757 | # alias should have given us the path to a PNG image. What we need |
1772 | # alias should have given us the path to a PNG image. What we need |
| 1758 | # to do is find out the dimmensions of this image, since pdflatex |
1773 | # to do is find out the dimmensions of this image, since pdflatex |
| … | |
… | |
| 1769 | # Since we're not creating PDF files, alias should have given us the |
1784 | # Since we're not creating PDF files, alias should have given us the |
| 1770 | # path to an EPS file. latex can get its dimmensions no problem! |
1785 | # path to an EPS file. latex can get its dimmensions no problem! |
| 1771 | |
1786 | |
| 1772 | $out = "\\includegraphics[width=$width_ratio\\linewidth]{$imagePath}\n"; |
1787 | $out = "\\includegraphics[width=$width_ratio\\linewidth]{$imagePath}\n"; |
| 1773 | } |
1788 | } |
| 1774 | } elsif ($main::displayMode eq 'Latex2HTML') { |
1789 | } elsif ($displayMode eq 'Latex2HTML') { |
| 1775 | $out = qq!\\begin{rawhtml}\n<A HREF= "$imageURL" TARGET="ZOOM"><IMG SRC="$imageURL" WIDTH="$width" HEIGHT="$height"></A>\n |
1790 | $out = qq!\\begin{rawhtml}\n<A HREF= "$imageURL" TARGET="ZOOM"><IMG SRC="$imageURL" WIDTH="$width" HEIGHT="$height"></A>\n |
| 1776 | \\end{rawhtml}\n ! |
1791 | \\end{rawhtml}\n ! |
| 1777 | } elsif ($main::displayMode eq 'HTML' || $main::displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng' || $displayMode eq 'HTML_img') { |
1792 | } elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng' || $displayMode eq 'HTML_img') { |
| 1778 | $out = qq!<A HREF= "$imageURL" TARGET="ZOOM"><IMG SRC="$imageURL" WIDTH="$width" HEIGHT="$height"></A> |
1793 | $out = qq!<A HREF= "$imageURL" TARGET="ZOOM"><IMG SRC="$imageURL" WIDTH="$width" HEIGHT="$height"></A> |
| 1779 | ! |
1794 | ! |
| 1780 | } else { |
1795 | } else { |
| 1781 | $out = "Error: PGchoicemacros: image: Unknown displayMode: $main::displayMode.\n"; |
1796 | $out = "Error: PGchoicemacros: image: Unknown displayMode: $displayMode.\n"; |
| 1782 | } |
1797 | } |
| 1783 | push(@output_list, $out); |
1798 | push(@output_list, $out); |
| 1784 | } |
1799 | } |
| 1785 | return wantarray ? @output_list : $output_list[0]; |
1800 | return wantarray ? @output_list : $output_list[0]; |
| 1786 | } |
1801 | } |
| … | |
… | |
| 1796 | } |
1811 | } |
| 1797 | |
1812 | |
| 1798 | |
1813 | |
| 1799 | sub caption { |
1814 | sub caption { |
| 1800 | my ($out) = @_; |
1815 | my ($out) = @_; |
| 1801 | $out = " $out \n" if $main::displayMode eq 'TeX'; |
1816 | $out = " $out \n" if $displayMode eq 'TeX'; |
| 1802 | $out = " $out " if $main::displayMode eq 'HTML'; |
1817 | $out = " $out " if $displayMode eq 'HTML'; |
| 1803 | $out = " $out " if $main::displayMode eq 'HTML_tth'; |
1818 | $out = " $out " if $displayMode eq 'HTML_tth'; |
| 1804 | $out = " $out " if $main::displayMode eq 'HTML_dpng'; |
1819 | $out = " $out " if $displayMode eq 'HTML_dpng'; |
| 1805 | $out = " $out " if $main::displayMode eq 'HTML_img'; |
1820 | $out = " $out " if $displayMode eq 'HTML_img'; |
| 1806 | $out = " $out " if $main::displayMode eq 'Latex2HTML'; |
1821 | $out = " $out " if $displayMode eq 'Latex2HTML'; |
| 1807 | $out; |
1822 | $out; |
| 1808 | } |
1823 | } |
| 1809 | |
1824 | |
| 1810 | sub captions { |
1825 | sub captions { |
| 1811 | my @in = @_; |
1826 | my @in = @_; |
| … | |
… | |
| 1829 | 'height' => 100, |
1844 | 'height' => 100, |
| 1830 | 'width' => 100, |
1845 | 'width' => 100, |
| 1831 | @_ # overwrite any default options |
1846 | @_ # overwrite any default options |
| 1832 | ); |
1847 | ); |
| 1833 | |
1848 | |
| 1834 | if ($main::displayMode eq 'TeX') { |
1849 | if ($displayMode eq 'TeX') { |
| 1835 | $out .= "\n\\par\\smallskip\\begin{center}\\begin{tabular}{" . "|c" x $number . "|} \\hline\n"; |
1850 | $out .= "\n\\par\\smallskip\\begin{center}\\begin{tabular}{" . "|c" x $number . "|} \\hline\n"; |
| 1836 | while (@images) { |
1851 | while (@images) { |
| 1837 | $out .= &image( shift(@images),%options ) . '&'; |
1852 | $out .= &image( shift(@images),%options ) . '&'; |
| 1838 | } |
1853 | } |
| 1839 | chop($out); |
1854 | chop($out); |
| … | |
… | |
| 1841 | while (@captions) { |
1856 | while (@captions) { |
| 1842 | $out .= &caption( shift(@captions) ) . '&'; |
1857 | $out .= &caption( shift(@captions) ) . '&'; |
| 1843 | } |
1858 | } |
| 1844 | chop($out); |
1859 | chop($out); |
| 1845 | $out .= "\\\\ \\hline \n\\end {tabular}\\end{center}\\par\\smallskip\n"; |
1860 | $out .= "\\\\ \\hline \n\\end {tabular}\\end{center}\\par\\smallskip\n"; |
| 1846 | } elsif ($main::displayMode eq 'Latex2HTML'){ |
1861 | } elsif ($displayMode eq 'Latex2HTML'){ |
| 1847 | |
1862 | |
| 1848 | $out .= "\n\\begin{rawhtml} <TABLE BORDER=1><TR>\n\\end{rawhtml}\n"; |
1863 | $out .= "\n\\begin{rawhtml} <TABLE BORDER=1><TR>\n\\end{rawhtml}\n"; |
| 1849 | while (@images) { |
1864 | while (@images) { |
| 1850 | $out .= "\n\\begin{rawhtml} <TD>\n\\end{rawhtml}\n" . &image( shift(@images),%options ) |
1865 | $out .= "\n\\begin{rawhtml} <TD>\n\\end{rawhtml}\n" . &image( shift(@images),%options ) |
| 1851 | . "\n\\begin{rawhtml} </TD>\n\\end{rawhtml}\n" ; |
1866 | . "\n\\begin{rawhtml} </TD>\n\\end{rawhtml}\n" ; |
| … | |
… | |
| 1856 | $out .= "\n\\begin{rawhtml} <TH>\n\\end{rawhtml}\n".&caption( shift(@captions) ) |
1871 | $out .= "\n\\begin{rawhtml} <TH>\n\\end{rawhtml}\n".&caption( shift(@captions) ) |
| 1857 | . "\n\\begin{rawhtml} </TH>\n\\end{rawhtml}\n" ; |
1872 | . "\n\\begin{rawhtml} </TH>\n\\end{rawhtml}\n" ; |
| 1858 | } |
1873 | } |
| 1859 | |
1874 | |
| 1860 | $out .= "\n\\begin{rawhtml} </TR> </TABLE >\n\\end{rawhtml}"; |
1875 | $out .= "\n\\begin{rawhtml} </TR> </TABLE >\n\\end{rawhtml}"; |
| 1861 | } elsif ($main::displayMode eq 'HTML' || $main::displayMode eq 'HTML_tth' || $main::displayMode eq 'HTML_dpng'|| $main::displayMode eq 'HTML_img'){ |
1876 | } elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng'|| $displayMode eq 'HTML_img'){ |
| 1862 | $out .= "<P>\n <TABLE BORDER=2 CELLPADDING=3 CELLSPACING=2 ><TR ALIGN=CENTER VALIGN=MIDDLE>\n"; |
1877 | $out .= "<P>\n <TABLE BORDER=2 CELLPADDING=3 CELLSPACING=2 ><TR ALIGN=CENTER VALIGN=MIDDLE>\n"; |
| 1863 | while (@images) { |
1878 | while (@images) { |
| 1864 | $out .= " \n<TD>". &image( shift(@images),%options ) ."</TD>"; |
1879 | $out .= " \n<TD>". &image( shift(@images),%options ) ."</TD>"; |
| 1865 | } |
1880 | } |
| 1866 | $out .= "</TR>\n<TR>"; |
1881 | $out .= "</TR>\n<TR>"; |
| … | |
… | |
| 1868 | $out .= " <TH>". &caption( shift(@captions) ) ."</TH>"; |
1883 | $out .= " <TH>". &caption( shift(@captions) ) ."</TH>"; |
| 1869 | } |
1884 | } |
| 1870 | $out .= "\n</TR></TABLE></P>\n" |
1885 | $out .= "\n</TR></TABLE></P>\n" |
| 1871 | } |
1886 | } |
| 1872 | else { |
1887 | else { |
| 1873 | $out = "Error: PGchoicemacros: imageRow: Unknown languageMode: $main::displayMode.\n"; |
1888 | $out = "Error: PGchoicemacros: imageRow: Unknown languageMode: $displayMode.\n"; |
| 1874 | warn $out; |
1889 | warn $out; |
| 1875 | } |
1890 | } |
| 1876 | $out; |
1891 | $out; |
| 1877 | } |
1892 | } |
| 1878 | |
1893 | |
Parent Directory
| 
Revision Log
| 
Patch