[system] / trunk / pg / macros / PGbasicmacros.pl Repository:
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 1080 Revision 1267
23BEGIN{ 23BEGIN{
24 be_strict; 24 be_strict;
25} 25}
26 26
27 27
28my $displayMode=$main::displayMode; 28my $displayMode;
29 29
30my ($PAR, 30my ($PAR,
31 $BR, 31 $BR,
32 $LQ, 32 $LQ,
33 $RQ, 33 $RQ,
61 $PERCENT, 61 $PERCENT,
62 $CARET, 62 $CARET,
63 $PI, 63 $PI,
64 $E, 64 $E,
65 @ALPHABET, 65 @ALPHABET,
66 $envir,
67 $PG_random_generator,
68 $inputs_ref,
66 ); 69 );
67 70
68sub _PGbasicmacros_init { 71sub _PGbasicmacros_init {
72
73 # The big problem is that at compile time in the cached Safe compartment
74 # main:: has one definition, probably Safe::Root1::
75 # At runtime main has another definition Safe::Rootx:: where x is > 1
76
77 # It is important to
78 # initialize the my variable version of $displayMode from the "runtime" version
79 # of main::displayMode
80
81 $displayMode = main::PG_restricted_eval(q!$main::displayMode!);
82
83# This is initializes the remaining variables in the runtime main:: compartment.
84
85main::PG_restricted_eval( <<'EndOfFile');
69 $displayMode =$main::displayMode; 86 $displayMode = $displayMode;
87
70 $main::PAR = PAR(); 88 $PAR = PAR();
71 $main::BR = BR(); 89 $BR = BR();
72 $main::LQ = LQ(); 90 $main::LQ = LQ();
73 $main::RQ = RQ(); 91 $main::RQ = RQ();
74 $main::BM = BM(); 92 $BM = BM();
75 $main::EM = EM(); 93 $EM = EM();
76 $main::BDM = BDM(); 94 $main::BDM = BDM();
77 $main::EDM = EDM(); 95 $main::EDM = EDM();
78 $main::LTS = LTS(); 96 $main::LTS = LTS();
79 $main::GTS = GTS(); 97 $main::GTS = GTS();
80 $main::LTE = LTE(); 98 $main::LTE = LTE();
84 $main::SOL = SOLUTION_HEADING(); 102 $main::SOL = SOLUTION_HEADING();
85 $main::SOLUTION = SOLUTION_HEADING(); 103 $main::SOLUTION = SOLUTION_HEADING();
86 $main::HINT = HINT_HEADING(); 104 $main::HINT = HINT_HEADING();
87 $main::US = US(); 105 $main::US = US();
88 $main::SPACE = SPACE(); 106 $main::SPACE = SPACE();
89 $main::BBOLD = BBOLD(); 107 $BBOLD = BBOLD();
90 $main::EBOLD = EBOLD(); 108 $EBOLD = EBOLD();
91 $main::BITALIC = BITALIC(); 109 $main::BITALIC = BITALIC();
92 $main::EITALIC = EITALIC(); 110 $main::EITALIC = EITALIC();
93 $main::BCENTER = BCENTER(); 111 $main::BCENTER = BCENTER();
94 $main::ECENTER = ECENTER(); 112 $main::ECENTER = ECENTER();
95 $main::HR = HR(); 113 $main::HR = HR();
102 $main::CARET = CARET(); 120 $main::CARET = CARET();
103 $main::PI = PI(); 121 $main::PI = PI();
104 $main::E = E(); 122 $main::E = E();
105 @main::ALPHABET = ('A'..'ZZ'); 123 @main::ALPHABET = ('A'..'ZZ');
106 124
125
126
127EndOfFile
128
129# Next we transfer the correct definitions in the main:: compartment to the local my variables
130# This can't be done inside the eval above because my variables seem to be invisible inside the eval
131
132
107 $PAR = PAR(); 133 $PAR = $PAR;
108 $BR = BR(); 134 $BR = $BR;
109 $LQ = LQ(); 135 $LQ = $main::LQ;
110 $RQ = RQ(); 136 $RQ = $main::RQ;
111 $BM = BM(); 137 $BM = $BM;
112 $EM = EM(); 138 $EM = $EM;
113 $BDM = BDM(); 139 $BDM = $main::BDM;
114 $EDM = EDM(); 140 $EDM = $main::EDM;
115 $LTS = LTS(); 141 $LTS = $main::LTS;
116 $GTS = GTS(); 142 $GTS = $main::GTS;
117 $LTE = LTE(); 143 $LTE = $main::LTE;
118 $GTE = GTE(); 144 $GTE = $main::GTE;
119 $BEGIN_ONE_COLUMN = BEGIN_ONE_COLUMN(); 145 $BEGIN_ONE_COLUMN = $main::BEGIN_ONE_COLUMN;
120 $END_ONE_COLUMN = END_ONE_COLUMN(); 146 $END_ONE_COLUMN = $main::END_ONE_COLUMN;
121 $SOL = SOLUTION_HEADING(); 147 $SOL = $main::SOLUTION_HEADING;
122 $SOLUTION = SOLUTION_HEADING(); 148 $SOLUTION = $main::SOLUTION_HEADING;
123 $HINT = HINT_HEADING(); 149 $HINT = $main::HINT_HEADING;
124 $US = US(); 150 $US = $main::US;
125 $SPACE = SPACE(); 151 $SPACE = $main::SPACE;
126 $BBOLD = BBOLD(); 152 $BBOLD = $BBOLD;
127 $EBOLD = EBOLD(); 153 $EBOLD = $EBOLD;
128 $HR = HR(); 154 $HR = $main::HR;
129 $LBRACE = LBRACE(); 155 $LBRACE = $main::LBRACE;
130 $RBRACE = RBRACE(); 156 $RBRACE = $main::RBRACE;
131 $LB = LB(); 157 $LB = $main::LB;
132 $RB = RB(); 158 $RB = $main::RB;
133 $DOLLAR = DOLLAR(); 159 $DOLLAR = $main::DOLLAR;
134 $PERCENT = PERCENT(); 160 $PERCENT = $main::PERCENT;
135 $CARET = CARET(); 161 $CARET = $main::CARET;
136 $PI = PI(); 162 $PI = $main::PI;
137 $E = E(); 163 $E = $main::E;
138 @ALPHABET = ('A'..'ZZ'); 164 @ALPHABET = ('A'..'ZZ');
139 165
166# We initialize a local reference to the environment hash rather than transfer the entire hash
167# This way is slightly more efficient.
140 168
141 169 $envir = PG_restricted_eval(q!\%main::envir!);
170 $PG_random_generator = PG_restricted_eval(q!$main::PG_random_generator!);
171 $inputs_ref = $envir{inputs_ref};
172
142} 173}
143 174
144=head2 Answer blank macros: 175=head2 Answer blank macros:
145 176
146These produce answer blanks of various sizes or pop up lists or radio answer buttons. 177These produce answer blanks of various sizes or pop up lists or radio answer buttons.
220 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)
221 252
222 253
223=cut 254=cut
224 255
256
257
225sub labeled_ans_rule { # syntactic sugar for NAMED_ANS_RULE 258sub labeled_ans_rule { # syntactic sugar for NAMED_ANS_RULE
226 my($name,$col) = @_; 259 my($name,$col) = @_;
227 $col = 20 unless defined($col); 260 $col = 20 unless defined($col);
228 NAMED_ANS_RULE($name,$col); 261 NAMED_ANS_RULE($name,$col);
229} 262}
230 263
231sub NAMED_ANS_RULE { 264sub NAMED_ANS_RULE {
232 my($name,$col) = @_; 265 my($name,$col) = @_;
233 my $len = 0.07*$col; 266 my $len = 0.07*$col;
234 my $answer_value = ''; 267 my $answer_value = '';
235 $answer_value = ${$main::inputs_ref}{$name} if defined(${$main::inputs_ref}{$name}); 268 $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name});
236 if ($answer_value =~ /\0/ ) { 269 if ($answer_value =~ /\0/ ) {
237 my @answers = split("\0", $answer_value); 270 my @answers = split("\0", $answer_value);
238 $answer_value = shift(@answers); # use up the first answer 271 $answer_value = shift(@answers); # use up the first answer
239 $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
240 $answer_value= '' unless defined($answer_value); 275 $answer_value= '' unless defined($answer_value);
241 } elsif (ref($answer_value) eq 'ARRAY') { 276 } elsif (ref($answer_value) eq 'ARRAY') {
242 my @answers = @{ $answer_value}; 277 my @answers = @{ $answer_value};
243 $answer_value = shift(@answers); # use up the first answer 278 $answer_value = shift(@answers); # use up the first answer
244 $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
245 $answer_value= '' unless defined($answer_value); 282 $answer_value= '' unless defined($answer_value);
246 } 283 }
247 284
248 $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
249 $name = RECORD_ANS_NAME($name); 286 $name = RECORD_ANS_NAME($name);
260 297
261sub NAMED_ANS_RULE_EXTENSION { 298sub NAMED_ANS_RULE_EXTENSION {
262 my($name,$col) = @_; 299 my($name,$col) = @_;
263 my $len = 0.07*$col; 300 my $len = 0.07*$col;
264 my $answer_value = ''; 301 my $answer_value = '';
265 $answer_value = ${$main::inputs_ref}{$name} if defined(${$main::inputs_ref}{$name}); 302 $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name});
266 if ( defined($main::rh_sticky_answers{$name}) ) { 303 if ( defined(PG_restricted_eval(q!$main::rh_sticky_answers{$name}!)) ) {
267 $answer_value = shift( @{$main::rh_sticky_answers{$name}}); 304 $answer_value = shift( @{PG_restricted_eval(q!$main::rh_sticky_answers{$name}!)});
268 $answer_value = '' unless defined($answer_value); 305 $answer_value = '' unless defined($answer_value);
269 } 306 }
270 $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
271 MODES( 308 MODES(
272 TeX => '\\hrulefill\\quad ', 309 TeX => '\\hrulefill\\quad ',
288 $col = 80 unless defined($col); 325 $col = 80 unless defined($col);
289 $name = RECORD_ANS_NAME($name); 326 $name = RECORD_ANS_NAME($name);
290 my $len = 0.07*$col; 327 my $len = 0.07*$col;
291 my $height = .07*$row; 328 my $height = .07*$row;
292 my $answer_value = ''; 329 my $answer_value = '';
293 $answer_value = $main::inputs_ref->{$name} if defined( $main::inputs_ref->{$name} ); 330 $answer_value = $inputs_ref->{$name} if defined( $inputs_ref->{$name} );
294 $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
295 my $out = M3( 332 my $out = M3(
296 qq!\\vskip $height in \\hrulefill\\quad !, 333 qq!\\vskip $height in \\hrulefill\\quad !,
297 qq!\\begin{rawhtml}<TEXTAREA NAME="$name" ROWS="$row" COLS="$col" 334 qq!\\begin{rawhtml}<TEXTAREA NAME="$name" ROWS="$row" COLS="$col"
298 WRAP="VIRTUAL">$answer_value</TEXTAREA>\\end{rawhtml}!, 335 WRAP="VIRTUAL">$answer_value</TEXTAREA>\\end{rawhtml}!,
316 my $checked = ''; 353 my $checked = '';
317 if ($value =~/^\%/) { 354 if ($value =~/^\%/) {
318 $value =~ s/^\%//; 355 $value =~ s/^\%//;
319 $checked = 'CHECKED' 356 $checked = 'CHECKED'
320 } 357 }
321 if (defined($main::inputs_ref->{$name}) ) { 358 if (defined($inputs_ref->{$name}) ) {
322 if ($main::inputs_ref->{$name} eq $value) { 359 if ($inputs_ref->{$name} eq $value) {
323 $checked = 'CHECKED' 360 $checked = 'CHECKED'
324 } else { 361 } else {
325 $checked = ''; 362 $checked = '';
326 } 363 }
327 364
348 my $checked = ''; 385 my $checked = '';
349 if ($value =~/^\%/) { 386 if ($value =~/^\%/) {
350 $value =~ s/^\%//; 387 $value =~ s/^\%//;
351 $checked = 'CHECKED' 388 $checked = 'CHECKED'
352 } 389 }
353 if (defined($main::inputs_ref->{$name}) ) { 390 if (defined($inputs_ref->{$name}) ) {
354 if ($main::inputs_ref->{$name} eq $value) { 391 if ($inputs_ref->{$name} eq $value) {
355 $checked = 'CHECKED' 392 $checked = 'CHECKED'
356 } else { 393 } else {
357 $checked = ''; 394 $checked = '';
358 } 395 }
359 396
425 if ($value =~/^\%/) { 462 if ($value =~/^\%/) {
426 $value =~ s/^\%//; 463 $value =~ s/^\%//;
427 $checked = 'CHECKED' 464 $checked = 'CHECKED'
428 } 465 }
429 466
430 if (defined($main::inputs_ref->{$name}) ) { 467 if (defined($inputs_ref->{$name}) ) {
431 if ($main::inputs_ref->{$name} eq $value) { 468 if ($inputs_ref->{$name} eq $value) {
432 $checked = 'CHECKED' 469 $checked = 'CHECKED'
433 } 470 }
434 else { 471 else {
435 $checked = ''; 472 $checked = '';
436 } 473 }
454 if ($value =~/^\%/) { 491 if ($value =~/^\%/) {
455 $value =~ s/^\%//; 492 $value =~ s/^\%//;
456 $checked = 'CHECKED' 493 $checked = 'CHECKED'
457 } 494 }
458 495
459 if (defined($main::inputs_ref->{$name}) ) { 496 if (defined($inputs_ref->{$name}) ) {
460 if ($main::inputs_ref->{$name} eq $value) { 497 if ($inputs_ref->{$name} eq $value) {
461 $checked = 'CHECKED' 498 $checked = 'CHECKED'
462 } 499 }
463 else { 500 else {
464 $checked = ''; 501 $checked = '';
465 } 502 }
527} 564}
528 565
529sub ans_rule { 566sub ans_rule {
530 my $len = shift; # gives the optional length of the answer blank 567 my $len = shift; # gives the optional length of the answer blank
531 $len = 20 unless $len ; 568 $len = 20 unless $len ;
532 my $name = NEW_ANS_NAME(++$main::ans_rule_count); 569 my $name = NEW_ANS_NAME(inc_ans_rule_count());
533 NAMED_ANS_RULE($name ,$len); 570 NAMED_ANS_RULE($name ,$len);
534} 571}
535sub ans_rule_extension { 572sub ans_rule_extension {
536 my $len = shift; 573 my $len = shift;
537 $len = 20 unless $len ; 574 $len = 20 unless $len ;
538 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
539 NAMED_ANS_RULE($name ,$len); 576 NAMED_ANS_RULE($name ,$len);
540} 577}
541sub ans_radio_buttons { 578sub ans_radio_buttons {
542 my $name = NEW_ANS_NAME(++$main::ans_rule_count); 579 my $name = NEW_ANS_NAME(inc_ans_rule_count());
543 my @radio_buttons = NAMED_ANS_RADIO_BUTTONS($name, @_); 580 my @radio_buttons = NAMED_ANS_RADIO_BUTTONS($name, @_);
544 581
545 if ($displayMode eq 'TeX') { 582 if ($displayMode eq 'TeX') {
546 $radio_buttons[0] = "\n\\begin{itemize}\n" . $radio_buttons[0]; 583 $radio_buttons[0] = "\n\\begin{itemize}\n" . $radio_buttons[0];
547 $radio_buttons[$#radio_buttons] .= "\n\\end{itemize}\n"; 584 $radio_buttons[$#radio_buttons] .= "\n\\end{itemize}\n";
550 (wantarray) ? @radio_buttons: join(" ", @radio_buttons); 587 (wantarray) ? @radio_buttons: join(" ", @radio_buttons);
551} 588}
552 589
553#added 6/14/2000 by David Etlinger 590#added 6/14/2000 by David Etlinger
554sub ans_checkbox { 591sub ans_checkbox {
555 my $name = NEW_ANS_NAME( ++$main::ans_rule_count ); 592 my $name = NEW_ANS_NAME( inc_ans_rule_count() );
556 my @checkboxes = NAMED_ANS_CHECKBOX_BUTTONS( $name, @_ ); 593 my @checkboxes = NAMED_ANS_CHECKBOX_BUTTONS( $name, @_ );
557 594
558 if ($displayMode eq 'TeX') { 595 if ($displayMode eq 'TeX') {
559 $checkboxes[0] = "\n\\begin{itemize}\n" . $checkboxes[0]; 596 $checkboxes[0] = "\n\\begin{itemize}\n" . $checkboxes[0];
560 $checkboxes[$#checkboxes] .= "\n\\end{itemize}\n"; 597 $checkboxes[$#checkboxes] .= "\n\\end{itemize}\n";
569## 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.
570 607
571sub tex_ans_rule { 608sub tex_ans_rule {
572 my $len = shift; 609 my $len = shift;
573 $len = 20 unless $len ; 610 $len = 20 unless $len ;
574 my $name = NEW_ANS_NAME(++$main::ans_rule_count); 611 my $name = NEW_ANS_NAME(inc_ans_rule_count());
575 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.
576 my $out = MODES( 613 my $out = MODES(
577 'TeX' => $answer_rule, 614 'TeX' => $answer_rule,
578 'Latex2HTML' => '\\fbox{Answer boxes cannot be placed inside typeset equations}', 615 'Latex2HTML' => '\\fbox{Answer boxes cannot be placed inside typeset equations}',
579 'HTML_tth' => '\\begin{rawhtml} '. $answer_rule.'\\end{rawhtml}', 616 'HTML_tth' => '\\begin{rawhtml} '. $answer_rule.'\\end{rawhtml}',
584 $out; 621 $out;
585} 622}
586sub tex_ans_rule_extension { 623sub tex_ans_rule_extension {
587 my $len = shift; 624 my $len = shift;
588 $len = 20 unless $len ; 625 $len = 20 unless $len ;
589 my $name = NEW_ANS_NAME($main::ans_rule_count); 626 my $name = NEW_ANS_NAME(PG_restricted_eval(q!$main::ans_rule_count!));
590 my $answer_rule = NAMED_ANS_RULE($name ,$len); # we don't want to create three answer rules in different modes. 627 my $answer_rule = NAMED_ANS_RULE($name ,$len); # we don't want to create three answer rules in different modes.
591 my $out = MODES( 628 my $out = MODES(
592 'TeX' => $answer_rule, 629 'TeX' => $answer_rule,
593 'Latex2HTML' => '\fbox{Answer boxes cannot be placed inside typeset equations}', 630 'Latex2HTML' => '\fbox{Answer boxes cannot be placed inside typeset equations}',
594 'HTML_tth' => '\\begin{rawhtml} '. $answer_rule.'\\end{rawhtml}', 631 'HTML_tth' => '\\begin{rawhtml} '. $answer_rule.'\\end{rawhtml}',
632sub ans_box { 669sub ans_box {
633 my $row = shift; 670 my $row = shift;
634 my $col =shift; 671 my $col =shift;
635 $row = 5 unless $row; 672 $row = 5 unless $row;
636 $col = 80 unless $col; 673 $col = 80 unless $col;
637 my $name = NEW_ANS_NAME(++$main::ans_rule_count); 674 my $name = NEW_ANS_NAME(inc_ans_rule_count());
638 NAMED_ANS_BOX($name ,$row,$col); 675 NAMED_ANS_BOX($name ,$row,$col);
639} 676}
640 677
641#this is legacy code; use ans_checkbox instead 678#this is legacy code; use ans_checkbox instead
642sub checkbox { 679sub checkbox {
648sub NAMED_POP_UP_LIST { 685sub NAMED_POP_UP_LIST {
649 my $name = shift; 686 my $name = shift;
650 my @list = @_; 687 my @list = @_;
651 $name = RECORD_ANS_NAME($name); # record answer name 688 $name = RECORD_ANS_NAME($name); # record answer name
652 my $answer_value = ''; 689 my $answer_value = '';
653 $answer_value = ${$main::inputs_ref}{$name} if defined(${$main::inputs_ref}{$name}); 690 $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name});
654 my $out = ""; 691 my $out = "";
655 if ($displayMode eq 'HTML' or $displayMode eq 'HTML_tth' or 692 if ($displayMode eq 'HTML' or $displayMode eq 'HTML_tth' or
656 $displayMode eq 'HTML_dpng' or $displayMode eq 'HTML_img') { 693 $displayMode eq 'HTML_dpng' or $displayMode eq 'HTML_img') {
657 $out = qq!<SELECT NAME = "$name" SIZE=1> \n!; 694 $out = qq!<SELECT NAME = "$name" SIZE=1> \n!;
658 my $i; 695 my $i;
675 712
676} 713}
677 714
678sub pop_up_list { 715sub pop_up_list {
679 my @list = @_; 716 my @list = @_;
680 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
681 NAMED_POP_UP_LIST($name, @list); 718 NAMED_POP_UP_LIST($name, @list);
682} 719}
720
721
722
723=head5 answer_matrix
724
725 Usage \[ \{ answer_matrix(rows,columns,width_of_ans_rule, @options) \} \]
726
727 Creates an array of answer blanks and passes it to display_matrix which returns
728 text which represents the matrix in TeX format used in math display mode. Answers
729 are then passed back to whatever answer evaluators you write at the end of the problem.
730 (note, if you have an m x n matrix, you will need mn answer evaluators, and they will be
731 returned to the evaluaters starting in the top left hand corner and proceed to the left
732 and then at the end moving down one row, just as you would read them.)
733
734 The options are passed on to display_matrix.
735
736
737=cut
738
739
740sub answer_matrix{
741 my $m = shift;
742 my $n = shift;
743 my $width = shift;
744 my @options = @_;
745 my @array=();
746 for( my $i = 0; $i < $m; $i+=1)
747 {
748 my @row_array = ();
749
750 for( my $i = 0; $i < $n; $i+=1)
751 {
752 push @row_array, ans_rule($width);
753 }
754 my $r_row_array = \@row_array;
755 push @array, $r_row_array;
756 }
757 # display_matrix hasn't been loaded into the cache safe compartment
758 # so we need to refer to the subroutine in this way to make
759 # sure that main is defined correctly.
760 my $ra_local_display_matrix=PG_restricted_eval(q!\&main::display_matrix!);
761 &$ra_local_display_matrix( \@array, @options );
762
763}
764
765sub NAMED_ANS_ARRAY_EXTENSION{
766
767 my $name = shift;
768 my $col = shift;
769 $col = 20 unless $col;
770 my $answer_value = '';
771
772 $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name});
773 if ($answer_value =~ /\0/ ) {
774 my @answers = split("\0", $answer_value);
775 $answer_value = shift(@answers);
776 $answer_value= '' unless defined($answer_value);
777 } elsif (ref($answer_value) eq 'ARRAY') {
778 my @answers = @{ $answer_value};
779 $answer_value = shift(@answers);
780 $answer_value= '' unless defined($answer_value);
781 }
782
783 $answer_value =~ tr/$@`//d; ## make sure student answers can not be interpolated by e.g. EV3
784 MODES(
785 TeX => "\\mbox{\\parbox[t]{10pt}{\\hrulefill}}\\hrulefill\\quad ",
786 Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=TEXT SIZE=$col NAME=\"$name\" VALUE = \"\">\n\\end{rawhtml}\n!,
787 HTML => "<INPUT TYPE=TEXT SIZE=$col NAME=\"$name\" VALUE = \"$answer_value\">\n"
788 );
789}
790
791sub ans_array{
792 my $m = shift;
793 my $n = shift;
794 my $col = shift;
795 $col = 20 unless $col;
796 my $num = inc_ans_rule_count() ;
797 my $name = NEW_ANS_ARRAY_NAME($num,0,0);
798 my @options = @_;
799 my @array=();
800 my $string;
801 my $answer_value = "";
802
803 $array[0][0] = NAMED_ANS_RULE($name,$col);
804
805 for( my $i = 1; $i < $n; $i+=1)
806 {
807 $name = NEW_ANS_ARRAY_NAME_EXTENSION($num,0,$i);
808 $array[0][$i] = NAMED_ANS_ARRAY_EXTENSION($name,$col);
809
810 }
811
812 for( my $j = 1; $j < $m; $j+=1 ){
813
814 for( my $i = 0; $i < $n; $i+=1)
815 {
816 $name = NEW_ANS_ARRAY_NAME_EXTENSION($num,$j,$i);
817 $array[$j][$i] = NAMED_ANS_ARRAY_EXTENSION($name,$col);
818
819 }
820
821 }
822 my $ra_local_display_matrix=PG_restricted_eval(q!\&main::display_matrix!);
823 &$ra_local_display_matrix( \@array, @options );
824
825}
826
827sub ans_array_extension{
828 my $m = shift;
829 my $n = shift;
830 my $col = shift;
831 $col = 20 unless $col;
832 my $num = PG_restricted_eval(q!$main::ans_rule_count!);
833 my @options = @_;
834 my $name;
835 my @array=();
836 my $string;
837 my $answer_value = "";
838
839 for( my $j = 0; $j < $m; $j+=1 ){
840
841 for( my $i = 0; $i < $n; $i+=1)
842 {
843 $name = NEW_ANS_ARRAY_NAME_EXTENSION($num,$j,$i);
844 $array[$j][$i] = NAMED_ANS_ARRAY_EXTENSION($name,$col);
845
846 }
847
848 }
849 my $ra_local_display_matrix=PG_restricted_eval(q!\&main::display_matrix!);
850 &$ra_local_display_matrix( \@array, @options );
851
852}
853
683 854
684# end answer blank macros 855# end answer blank macros
685 856
686=head2 Hints and solutions macros 857=head2 Hints and solutions macros
687 858
693 864
694Solution prints its concatenated input when the check box named 'ShowSol' is set and 865Solution prints its concatenated input when the check box named 'ShowSol' is set and
695the time is after the answer date. The check box 'ShowSol' is visible only after the 866the time is after the answer date. The check box 'ShowSol' is visible only after the
696answer date or when the problem is viewed by a professor. 867answer date or when the problem is viewed by a professor.
697 868
698$envir{'displaySolutionsQ'} is set to 1 when a solution is to be displayed. 869$main::envir{'displaySolutionsQ'} is set to 1 when a solution is to be displayed.
699 870
700Hints are shown only after the number of attempts is greater than $:showHint 871Hints are shown only after the number of attempts is greater than $:showHint
701($main::showHint defaults to 1) and the check box named 'ShowHint' is set. The check box 872($main::showHint defaults to 1) and the check box named 'ShowHint' is set. The check box
702'ShowHint' is visible only after the number of attempts is greater than $main::showHint. 873'ShowHint' is visible only after the number of attempts is greater than $main::showHint.
703 874
704$envir{'displayHintsQ'} is set to 1 when a hint is to be displayed. 875$main::envir{'displayHintsQ'} is set to 1 when a hint is to be displayed.
705 876
706 877
707=cut 878=cut
708 879
709 880
716 887
717 888
718sub solution { 889sub solution {
719 my @in = @_; 890 my @in = @_;
720 my $out = ''; 891 my $out = '';
721 $main::solutionExists =1; 892 PG_restricted_eval(q!$main::solutionExists =1!);
722 if ($envir{'displaySolutionsQ'}) {$out = join(' ',@in);} 893 if (PG_restricted_eval(q!$main::envir{'displaySolutionsQ'}!)) {$out = join(' ',@in);}
723 $out; 894 $out;
724} 895}
725 896
726 897
727sub SOLUTION { 898sub SOLUTION {
732 903
733sub hint { 904sub hint {
734 my @in = @_; 905 my @in = @_;
735 my $out = ''; 906 my $out = '';
736 907
737 $main::hintExists =1; 908 PG_restricted_eval(q!$main::hintExists =1;
738 $main::numOfAttempts = 0 unless defined($main::numOfAttempts); 909 $main::numOfAttempts = 0 unless defined($main::numOfAttempts);
910 !);
739 911
740 if ($main::displayMode eq 'TeX') { 912 if ($displayMode eq 'TeX') {
741 $out = ''; # do nothing since hints are not available for download 913 $out = ''; # do nothing since hints are not available for download
742 } elsif (($envir{'displayHintsQ'}) and ($main::numOfAttempts >= $main::showHint)) 914 } elsif (($envir->{'displayHintsQ'}) and
915 PG_restricted_eval(q!($main::numOfAttempts >= $main::showHint)!))
743 916
744 ## 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
745 918
746 {$out = join(' ',@in);} # show hint 919 {$out = join(' ',@in);} # show hint
747 920
748 $out ; 921 $out ;
749} 922}
750 923
751 924
752sub HINT { 925sub HINT {
753 TEXT("$main::BR" . hint(@_) . "$main::BR") if hint(@_); 926 TEXT("$BR" . hint(@_) . "$BR") if hint(@_);
754} 927}
755 928
756 929
757 930
758# End hints and solutions macros 931# End hints and solutions macros
774 947
775 948
776SRAND(time) will create a different problem everytime it is called. This makes it difficult 949SRAND(time) will create a different problem everytime it is called. This makes it difficult
777to check the answers :-). 950to check the answers :-).
778 951
779SRAND($envir{'inputs_ref'}->{'key'} ) will create a different problem for each login session. 952SRAND($envir->{'inputs_ref'}->{'key'} ) will create a different problem for each login session.
780This is probably what is desired. 953This is probably what is desired.
781 954
782=cut 955=cut
783 956
784 957
785sub random { 958sub random {
786 my ($begin, $end, $incr) = @_; 959 my ($begin, $end, $incr) = @_;
787 $main::PG_random_generator->random($begin,$end,$incr); 960 $PG_random_generator->random($begin,$end,$incr);
788} 961}
789 962
790 963
791sub non_zero_random { ##gives a non-zero random number 964sub non_zero_random { ##gives a non-zero random number
792 my (@arguments)=@_; 965 my (@arguments)=@_;
803 return $li[random(1,scalar(@li))-1]; 976 return $li[random(1,scalar(@li))-1];
804} 977}
805 978
806sub SRAND { # resets the main random generator -- use cautiously 979sub SRAND { # resets the main random generator -- use cautiously
807 my $seed = shift; 980 my $seed = shift;
808 $main::PG_random_generator -> srand($seed); 981 PG_random_generator -> srand($seed);
809} 982}
810 983
811# display macros 984# display macros
812 985
813=head2 Display Macros 986=head2 Display Macros
1132 #print "$start_delim $end_delim evaluate_string=$1<BR>"; 1305 #print "$start_delim $end_delim evaluate_string=$1<BR>";
1133 ($eval_out,$PG_eval_errors,$PG_full_error_report) = &$actionRef($1); 1306 ($eval_out,$PG_eval_errors,$PG_full_error_report) = &$actionRef($1);
1134 $eval_out = "$start_delim $eval_out $end_delim" if $PG_full_error_report; 1307 $eval_out = "$start_delim $eval_out $end_delim" if $PG_full_error_report;
1135 $out = $out . $eval_out; 1308 $out = $out . $eval_out;
1136 #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>";
1137 $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 $@;
1138 } 1311 }
1139 else { 1312 else {
1140 $out .= $string; # flush the last part of the string 1313 $out .= $string; # flush the last part of the string
1141 last; 1314 last;
1142 } 1315 }
1154 my $in = shift; 1327 my $in = shift;
1155 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;");
1156 # the addition of the ; seems to provide better error reporting 1329 # the addition of the ; seems to provide better error reporting
1157 if ($PG_eval_errors) { 1330 if ($PG_eval_errors) {
1158 my @errorLines = split("\n",$PG_eval_errors); 1331 my @errorLines = split("\n",$PG_eval_errors);
1159 #$out = "<PRE>$main::PAR % ERROR in $0:old_safe_ev, PGbasicmacros.pl: $main::PAR % There is an error occuring inside evaluation brackets \\{ ...code... \\} $main::BR % somewhere in an EV2 or EV3 or BEGIN_TEXT block. $main::BR % Code evaluated:$main::BR $in $main::BR % $main::BR % $errorLines[0]\n % $errorLines[1]$main::BR % $main::BR % $main::BR </PRE> "; 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> ";
1160 warn " ERROR in old_safe_ev, PGbasicmacros.pl: <PRE> 1333 warn " ERROR in old_safe_ev, PGbasicmacros.pl: <PRE>
1161 ## There is an error occuring inside evaluation brackets \\{ ...code... \\} 1334 ## There is an error occuring inside evaluation brackets \\{ ...code... \\}
1162 ## somewhere in an EV2 or EV3 or BEGIN_TEXT block. 1335 ## somewhere in an EV2 or EV3 or BEGIN_TEXT block.
1163 ## Code evaluated: 1336 ## Code evaluated:
1164 ## $in 1337 ## $in
1165 ##" .join("\n ", @errorLines). " 1338 ##" .join("\n ", @errorLines). "
1166 ##</PRE>$main::BR 1339 ##</PRE>$BR
1167 "; 1340 ";
1168 $out ="$main::PAR $main::BBOLD $in $main::EBOLD $main::PAR"; 1341 $out ="$PAR $BBOLD $in $EBOLD $PAR";
1169 1342
1170 1343
1171 } 1344 }
1172 1345
1173 ($out,$PG_eval_errors,$PG_full_error_report); 1346 ($out,$PG_eval_errors,$PG_full_error_report);
1191#sub math_ev3 { 1364#sub math_ev3 {
1192# my $in = shift; #print "in=$in<BR>"; 1365# my $in = shift; #print "in=$in<BR>";
1193# my ($out,$PG_eval_errors,$PG_full_error_report); 1366# my ($out,$PG_eval_errors,$PG_full_error_report);
1194# $in = FEQ($in); 1367# $in = FEQ($in);
1195# $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
1196# return("$main::BM $in $main::EM") unless ($displayMode eq 'HTML_tth'); 1369# return("$BM $in $EM") unless ($displayMode eq 'HTML_tth');
1197# $in = "\\(" . $in . "\\)"; 1370# $in = "\\(" . $in . "\\)";
1198# $out = tth($in); 1371# $out = tth($in);
1199# ($out,$PG_eval_errors,$PG_full_error_report); 1372# ($out,$PG_eval_errors,$PG_full_error_report);
1200# 1373#
1201#} 1374#}
1211# ($out,$PG_eval_errors,$PG_full_error_report); 1384# ($out,$PG_eval_errors,$PG_full_error_report);
1212#} 1385#}
1213 1386
1214sub math_ev3 { 1387sub math_ev3 {
1215 my $in = shift; 1388 my $in = shift;
1216 $in = FEQ($in);
1217 $in =~ s/%/\\%/g;
1218 return general_math_ev3($in, "inline"); 1389 return general_math_ev3($in, "inline");
1219} 1390}
1220 1391
1221sub display_math_ev3 { 1392sub display_math_ev3 {
1222 my $in = shift; 1393 my $in = shift;
1225 1396
1226sub general_math_ev3 { 1397sub general_math_ev3 {
1227 my $in = shift; 1398 my $in = shift;
1228 my $mode = shift || "inline"; 1399 my $mode = shift || "inline";
1229 1400
1230 $in = FEQ($in); 1401 $in = FEQ($in); # Format EQuations
1231 $in =~ s/%/\\%/g; 1402 $in =~ s/%/\\%/g; # avoid % becoming TeX comments
1232 my $in_delim; 1403
1233 1404 # some modes want the delimiters, some don't
1234 if($mode eq "inline") { 1405 my $in_delim = $mode eq "inline"
1235 $in_delim = "\\($in\\)"; 1406 ? "\\($in\\)"
1236 } else { # assuming displayed math 1407 : "\\[$in\\]";
1237 $in_delim = "\\[$in\\]"; 1408
1238 }
1239
1240 my $out; 1409 my $out;
1241 if($displayMode eq "HTML_tth") { 1410 if($displayMode eq "HTML_tth") {
1242 $out = tth($in_delim); 1411 $out = tth($in_delim);
1243 } elsif ($displayMode eq "HTML_dpng") { 1412 } elsif ($displayMode eq "HTML_dpng") {
1413 # for jj's version of ImageGenerator
1244 $out = $envir{'imagegen'}->add($in_delim); 1414 $out = $envir->{'imagegen'}->add($in_delim);
1415 # for my version of ImageGenerator
1416 #$out = $envir->{'imagegen'}->add($in, $mode);
1245 } elsif ($displayMode eq "HTML_img") { 1417 } elsif ($displayMode eq "HTML_img") {
1246 $out = math2img($in, $mode); 1418 $out = math2img($in, $mode);
1247 } else { 1419 } else {
1248 $out = "\\($in\\)" if $mode eq "inline"; 1420 $out = "\\($in\\)" if $mode eq "inline";
1249 $out = "\\[$in\\]" if $mode eq "display"; 1421 $out = "\\[$in\\]" if $mode eq "display";
1257 $string = ev_substring($string,"\\{","\\}",\&old_safe_ev); 1429 $string = ev_substring($string,"\\{","\\}",\&old_safe_ev);
1258 $string = ev_substring($string,"\\<","\\>",\&old_safe_ev); 1430 $string = ev_substring($string,"\\<","\\>",\&old_safe_ev);
1259 $string = ev_substring($string,"\\(","\\)",\&math_ev3); 1431 $string = ev_substring($string,"\\(","\\)",\&math_ev3);
1260 $string = ev_substring($string,"\\[","\\]",\&display_math_ev3); 1432 $string = ev_substring($string,"\\[","\\]",\&display_math_ev3);
1261 # macros for displaying math 1433 # macros for displaying math
1262 $string =~ s/\\\(/$main::BM/g; 1434 $string =~ s/\\\(/$BM/g;
1263 $string =~ s/\\\)/$main::EM/g; 1435 $string =~ s/\\\)/$EM/g;
1264 $string =~ s/\\\[/$main::BDM/g; 1436 $string =~ s/\\\[/$BDM/g;
1265 $string =~ s/\\\]/$main::EDM/g; 1437 $string =~ s/\\\]/$EDM/g;
1266 $string; 1438 $string;
1267} 1439}
1268 1440
1269sub EV3{ 1441sub EV3{
1270 my $string = join(" ",@_); 1442 my $string = join(" ",@_);
1273 # interpolate variables 1445 # interpolate variables
1274 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");
1275 if ($PG_eval_errors) { 1447 if ($PG_eval_errors) {
1276 my @errorLines = split("\n",$PG_eval_errors); 1448 my @errorLines = split("\n",$PG_eval_errors);
1277 $string =~ s/</&lt;/g; $string =~ s/>/&gt;/g; 1449 $string =~ s/</&lt;/g; $string =~ s/>/&gt;/g;
1278 $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> ";
1279 $@=""; 1451 $@="";
1280 } 1452 }
1281 $string = $evaluated_string; 1453 $string = $evaluated_string;
1282 $string = ev_substring($string,"\\(","\\)",\&math_ev3); 1454 $string = ev_substring($string,"\\(","\\)",\&math_ev3);
1283 $string = ev_substring($string,"\\[","\\]",\&display_math_ev3); 1455 $string = ev_substring($string,"\\[","\\]",\&display_math_ev3);
1312 1484
1313=cut 1485=cut
1314 1486
1315sub beginproblem { 1487sub beginproblem {
1316 my $out = ""; 1488 my $out = "";
1489 my $problemValue = $envir->{problemValue};
1490 my $fileName = $envir->{problemValue};
1491 my $probNum = $envir->{probNum};
1317 my $TeXFileName = protect_underbar($main::fileName); 1492 my $TeXFileName = protect_underbar($envir->{fileName});
1318 my $l2hFileName = protect_underbar($main::fileName); 1493 my $l2hFileName = protect_underbar($envir->{fileName});
1319 my %inlist; 1494 my %inlist;
1320 my $points ='pts'; 1495 my $points ='pts';
1496
1321 $points = 'pt' if $main::problemValue == 1; 1497 $points = 'pt' if $problemValue == 1;
1322 ## Prepare header for the problem 1498 ## Prepare header for the problem
1323 grep($inlist{$_}++,@{ $envir{'PRINT_FILE_NAMES_FOR'} }); 1499 grep($inlist{$_}++,@{ $envir->{'PRINT_FILE_NAMES_FOR'} });
1324 if ( defined($inlist{$main::studentLogin}) and ($inlist{$main::studentLogin} > 0) ) { 1500 if ( defined($inlist{$envir->{studentLogin}}) and ($inlist{$envir->{studentLogin}} > 0) ) {
1325 $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 ",
1326 " \\begin{rawhtml} ($main::problemValue $points) <B>$l2hFileName</B><BR>\\end{rawhtml}", 1502 " \\begin{rawhtml} ($problemValue $points) <B>$l2hFileName</B><BR>\\end{rawhtml}",
1327 "($main::problemValue $points) <B>$main::fileName</B><BR>" 1503 "($problemValue $points) <B>$fileName</B><BR>"
1328 ); 1504 );
1329 } else { 1505 } else {
1330 $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) ",
1331 "($main::problemValue $points) ", 1507 "($problemValue $points) ",
1332 "($main::problemValue $points) " 1508 "($problemValue $points) "
1333 ); 1509 );
1334 } 1510 }
1335 $out; 1511 $out;
1336 1512
1337} 1513}
1359 "<OL TYPE=\"A\" VALUE=\"1\">\n" 1535 "<OL TYPE=\"A\" VALUE=\"1\">\n"
1360 ) ; 1536 ) ;
1361 my $elem; 1537 my $elem;
1362 foreach $elem (@array) { 1538 foreach $elem (@array) {
1363 $out .= MODES( 1539 $out .= MODES(
1364 TeX=> "\\item[$main::ALPHABET[$i].] $elem\n", 1540 TeX=> "\\item[$ALPHABET[$i].] $elem\n",
1365 Latex2HTML=> " \\begin{rawhtml} <LI> \\end{rawhtml} $elem ", 1541 Latex2HTML=> " \\begin{rawhtml} <LI> \\end{rawhtml} $elem ",
1366 HTML=> "<LI> $elem\n", 1542 HTML=> "<LI> $elem\n",
1367 HTML_dpng=> "<LI> $elem <br /> <br /> \n" 1543 HTML_dpng=> "<LI> $elem <br /> <br /> \n"
1368 ); 1544 );
1369 $i++; 1545 $i++;
1378sub htmlLink { 1554sub htmlLink {
1379 my $url = shift; 1555 my $url = shift;
1380 my $text = shift; 1556 my $text = shift;
1381 my $options = shift; 1557 my $options = shift;
1382 $options = "" unless defined($options); 1558 $options = "" unless defined($options);
1383 return "${main::BBOLD}[ broken link: $text ] ${main::EBOLD}" unless defined($url); 1559 return "$BBOLD\[ broken link: $text \] $EBOLD" unless defined($url);
1384 M3( "{\\bf \\underline{$text} }", 1560 M3( "{\\bf \\underline{$text} }",
1385 "\\begin{rawhtml} <A HREF=\"$url\" $options> $text </A>\\end{rawhtml}", 1561 "\\begin{rawhtml} <A HREF=\"$url\" $options> $text </A>\\end{rawhtml}",
1386 "<A HREF=\"$url\" $options> $text </A>" 1562 "<A HREF=\"$url\" $options> $text </A>"
1387 ); 1563 );
1388} 1564}
1565
1389sub appletLink { 1566sub appletLink {
1390 my $url = shift; 1567 my $url = shift;
1391 my $options = shift; 1568 my $options = shift;
1392 $options = "" unless defined($options); 1569 $options = "" unless defined($options);
1393 M3( "{\\bf \\underline{APPLET} }", 1570 M3( "{\\bf \\underline{APPLET} }",
1521 while (@elements) { 1698 while (@elements) {
1522 $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";
1523 } 1700 }
1524 $out .= " \n\\begin{rawhtml}\n</TR> \n\\end{rawhtml}\n"; 1701 $out .= " \n\\begin{rawhtml}\n</TR> \n\\end{rawhtml}\n";
1525 } 1702 }
1526 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') {
1527 $out .= "<TR>\n"; 1704 $out .= "<TR>\n";
1528 while (@elements) { 1705 while (@elements) {
1529 $out .= "<TD>" . shift(@elements) . "</TD>"; 1706 $out .= "<TD>" . shift(@elements) . "</TD>";
1530 } 1707 }
1531 $out .= "\n</TR>\n"; 1708 $out .= "\n</TR>\n";
1532 } 1709 }
1533 else { 1710 else {
1534 $out = "Error: PGchoicemacros: row: Unknown displayMode: $main::displayMode.\n"; 1711 $out = "Error: PGchoicemacros: row: Unknown displayMode: $displayMode.\n";
1535 } 1712 }
1536 $out; 1713 $out;
1537} 1714}
1538 1715
1539=head2 Macros for displaying static images 1716=head2 Macros for displaying static images
1586 my @output_list = (); 1763 my @output_list = ();
1587 while(@image_list) { 1764 while(@image_list) {
1588 my $imageURL = alias(shift @image_list); 1765 my $imageURL = alias(shift @image_list);
1589 my $out=""; 1766 my $out="";
1590 1767
1591 if ($main::displayMode eq 'TeX') { 1768 if ($displayMode eq 'TeX') {
1592 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
1593 if ($envir{texDisposition} eq "pdf") { 1770 if ($envir->{texDisposition} eq "pdf") {
1594 # 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
1595 # 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
1596 # 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
1597 # is too dumb to live. 1774 # is too dumb to live.
1598 1775
1607 # 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
1608 # 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!
1609 1786
1610 $out = "\\includegraphics[width=$width_ratio\\linewidth]{$imagePath}\n"; 1787 $out = "\\includegraphics[width=$width_ratio\\linewidth]{$imagePath}\n";
1611 } 1788 }
1612 } elsif ($main::displayMode eq 'Latex2HTML') { 1789 } elsif ($displayMode eq 'Latex2HTML') {
1613 $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
1614 \\end{rawhtml}\n ! 1791 \\end{rawhtml}\n !
1615 } 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') {
1616 $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>
1617 ! 1794 !
1618 } else { 1795 } else {
1619 $out = "Error: PGchoicemacros: image: Unknown displayMode: $main::displayMode.\n"; 1796 $out = "Error: PGchoicemacros: image: Unknown displayMode: $displayMode.\n";
1620 } 1797 }
1621 push(@output_list, $out); 1798 push(@output_list, $out);
1622 } 1799 }
1623 return wantarray ? @output_list : $output_list[0]; 1800 return wantarray ? @output_list : $output_list[0];
1624} 1801}
1634} 1811}
1635 1812
1636 1813
1637sub caption { 1814sub caption {
1638 my ($out) = @_; 1815 my ($out) = @_;
1639 $out = " $out \n" if $main::displayMode eq 'TeX'; 1816 $out = " $out \n" if $displayMode eq 'TeX';
1640 $out = " $out " if $main::displayMode eq 'HTML'; 1817 $out = " $out " if $displayMode eq 'HTML';
1641 $out = " $out " if $main::displayMode eq 'HTML_tth'; 1818 $out = " $out " if $displayMode eq 'HTML_tth';
1642 $out = " $out " if $main::displayMode eq 'HTML_dpng'; 1819 $out = " $out " if $displayMode eq 'HTML_dpng';
1643 $out = " $out " if $main::displayMode eq 'HTML_img'; 1820 $out = " $out " if $displayMode eq 'HTML_img';
1644 $out = " $out " if $main::displayMode eq 'Latex2HTML'; 1821 $out = " $out " if $displayMode eq 'Latex2HTML';
1645 $out; 1822 $out;
1646} 1823}
1647 1824
1648sub captions { 1825sub captions {
1649 my @in = @_; 1826 my @in = @_;
1667 'height' => 100, 1844 'height' => 100,
1668 'width' => 100, 1845 'width' => 100,
1669 @_ # overwrite any default options 1846 @_ # overwrite any default options
1670 ); 1847 );
1671 1848
1672 if ($main::displayMode eq 'TeX') { 1849 if ($displayMode eq 'TeX') {
1673 $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";
1674 while (@images) { 1851 while (@images) {
1675 $out .= &image( shift(@images),%options ) . '&'; 1852 $out .= &image( shift(@images),%options ) . '&';
1676 } 1853 }
1677 chop($out); 1854 chop($out);
1679 while (@captions) { 1856 while (@captions) {
1680 $out .= &caption( shift(@captions) ) . '&'; 1857 $out .= &caption( shift(@captions) ) . '&';
1681 } 1858 }
1682 chop($out); 1859 chop($out);
1683 $out .= "\\\\ \\hline \n\\end {tabular}\\end{center}\\par\\smallskip\n"; 1860 $out .= "\\\\ \\hline \n\\end {tabular}\\end{center}\\par\\smallskip\n";
1684 } elsif ($main::displayMode eq 'Latex2HTML'){ 1861 } elsif ($displayMode eq 'Latex2HTML'){
1685 1862
1686 $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";
1687 while (@images) { 1864 while (@images) {
1688 $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 )
1689 . "\n\\begin{rawhtml} </TD>\n\\end{rawhtml}\n" ; 1866 . "\n\\begin{rawhtml} </TD>\n\\end{rawhtml}\n" ;
1694 $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) )
1695 . "\n\\begin{rawhtml} </TH>\n\\end{rawhtml}\n" ; 1872 . "\n\\begin{rawhtml} </TH>\n\\end{rawhtml}\n" ;
1696 } 1873 }
1697 1874
1698 $out .= "\n\\begin{rawhtml} </TR> </TABLE >\n\\end{rawhtml}"; 1875 $out .= "\n\\begin{rawhtml} </TR> </TABLE >\n\\end{rawhtml}";
1699 } 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'){
1700 $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";
1701 while (@images) { 1878 while (@images) {
1702 $out .= " \n<TD>". &image( shift(@images),%options ) ."</TD>"; 1879 $out .= " \n<TD>". &image( shift(@images),%options ) ."</TD>";
1703 } 1880 }
1704 $out .= "</TR>\n<TR>"; 1881 $out .= "</TR>\n<TR>";
1706 $out .= " <TH>". &caption( shift(@captions) ) ."</TH>"; 1883 $out .= " <TH>". &caption( shift(@captions) ) ."</TH>";
1707 } 1884 }
1708 $out .= "\n</TR></TABLE></P>\n" 1885 $out .= "\n</TR></TABLE></P>\n"
1709 } 1886 }
1710 else { 1887 else {
1711 $out = "Error: PGchoicemacros: imageRow: Unknown languageMode: $main::displayMode.\n"; 1888 $out = "Error: PGchoicemacros: imageRow: Unknown languageMode: $displayMode.\n";
1712 warn $out; 1889 warn $out;
1713 } 1890 }
1714 $out; 1891 $out;
1715} 1892}
1716 1893

Legend:
Removed from v.1080  
changed lines
  Added in v.1267

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9