[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 1155 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}
683 720
684 721
685 722
715 push @row_array, ans_rule($width); 752 push @row_array, ans_rule($width);
716 } 753 }
717 my $r_row_array = \@row_array; 754 my $r_row_array = \@row_array;
718 push @array, $r_row_array; 755 push @array, $r_row_array;
719 } 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!);
720 display_matrix( \@array, @options ); 761 &$ra_local_display_matrix( \@array, @options );
721 762
722} 763}
723 764
724sub NAMED_ANS_ARRAY_EXTENSION{ 765sub NAMED_ANS_ARRAY_EXTENSION{
725 766
726 my $name = shift; 767 my $name = shift;
727 my $col = shift; 768 my $col = shift;
728 $col = 20 unless $col; 769 $col = 20 unless $col;
729 my $answer_value = ''; 770 my $answer_value = '';
730 771
731 $answer_value = ${$main::inputs_ref}{$name} if defined(${$main::inputs_ref}{$name}); 772 $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name});
732 if ($answer_value =~ /\0/ ) { 773 if ($answer_value =~ /\0/ ) {
733 my @answers = split("\0", $answer_value); 774 my @answers = split("\0", $answer_value);
734 $answer_value = shift(@answers); 775 $answer_value = shift(@answers);
735 $answer_value= '' unless defined($answer_value); 776 $answer_value= '' unless defined($answer_value);
736 } elsif (ref($answer_value) eq 'ARRAY') { 777 } elsif (ref($answer_value) eq 'ARRAY') {
750sub ans_array{ 791sub ans_array{
751 my $m = shift; 792 my $m = shift;
752 my $n = shift; 793 my $n = shift;
753 my $col = shift; 794 my $col = shift;
754 $col = 20 unless $col; 795 $col = 20 unless $col;
755 my $num = ++$main::ans_rule_count ; 796 my $num = inc_ans_rule_count() ;
756 my $name = NEW_ANS_ARRAY_NAME($num,0,0); 797 my $name = NEW_ANS_ARRAY_NAME($num,0,0);
757 my @options = @_; 798 my @options = @_;
758 my @array=(); 799 my @array=();
759 my $string; 800 my $string;
760 my $answer_value = ""; 801 my $answer_value = "";
776 $array[$j][$i] = NAMED_ANS_ARRAY_EXTENSION($name,$col); 817 $array[$j][$i] = NAMED_ANS_ARRAY_EXTENSION($name,$col);
777 818
778 } 819 }
779 820
780 } 821 }
822 my $ra_local_display_matrix=PG_restricted_eval(q!\&main::display_matrix!);
781 display_matrix( \@array, @options ); 823 &$ra_local_display_matrix( \@array, @options );
782 824
783} 825}
784 826
785sub ans_array_extension{ 827sub ans_array_extension{
786 my $m = shift; 828 my $m = shift;
787 my $n = shift; 829 my $n = shift;
788 my $col = shift; 830 my $col = shift;
789 $col = 20 unless $col; 831 $col = 20 unless $col;
790 my $num = $main::ans_rule_count; 832 my $num = PG_restricted_eval(q!$main::ans_rule_count!);
791 my @options = @_; 833 my @options = @_;
792 my $name; 834 my $name;
793 my @array=(); 835 my @array=();
794 my $string; 836 my $string;
795 my $answer_value = ""; 837 my $answer_value = "";
802 $array[$j][$i] = NAMED_ANS_ARRAY_EXTENSION($name,$col); 844 $array[$j][$i] = NAMED_ANS_ARRAY_EXTENSION($name,$col);
803 845
804 } 846 }
805 847
806 } 848 }
849 my $ra_local_display_matrix=PG_restricted_eval(q!\&main::display_matrix!);
807 display_matrix( \@array, @options ); 850 &$ra_local_display_matrix( \@array, @options );
808 851
809} 852}
810 853
811 854
812# end answer blank macros 855# end answer blank macros
821 864
822Solution 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
823the 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
824answer date or when the problem is viewed by a professor. 867answer date or when the problem is viewed by a professor.
825 868
826$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.
827 870
828Hints 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
829($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
830'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.
831 874
832$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.
833 876
834 877
835=cut 878=cut
836 879
837 880
844 887
845 888
846sub solution { 889sub solution {
847 my @in = @_; 890 my @in = @_;
848 my $out = ''; 891 my $out = '';
849 $main::solutionExists =1; 892 PG_restricted_eval(q!$main::solutionExists =1!);
850 if ($envir{'displaySolutionsQ'}) {$out = join(' ',@in);} 893 if (PG_restricted_eval(q!$main::envir{'displaySolutionsQ'}!)) {$out = join(' ',@in);}
851 $out; 894 $out;
852} 895}
853 896
854 897
855sub SOLUTION { 898sub SOLUTION {
860 903
861sub hint { 904sub hint {
862 my @in = @_; 905 my @in = @_;
863 my $out = ''; 906 my $out = '';
864 907
865 $main::hintExists =1; 908 PG_restricted_eval(q!$main::hintExists =1;
866 $main::numOfAttempts = 0 unless defined($main::numOfAttempts); 909 $main::numOfAttempts = 0 unless defined($main::numOfAttempts);
910 !);
867 911
868 if ($main::displayMode eq 'TeX') { 912 if ($displayMode eq 'TeX') {
869 $out = ''; # do nothing since hints are not available for download 913 $out = ''; # do nothing since hints are not available for download
870 } elsif (($envir{'displayHintsQ'}) and ($main::numOfAttempts >= $main::showHint)) 914 } elsif (($envir->{'displayHintsQ'}) and
915 PG_restricted_eval(q!($main::numOfAttempts >= $main::showHint)!))
871 916
872 ## 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
873 918
874 {$out = join(' ',@in);} # show hint 919 {$out = join(' ',@in);} # show hint
875 920
876 $out ; 921 $out ;
877} 922}
878 923
879 924
880sub HINT { 925sub HINT {
881 TEXT("$main::BR" . hint(@_) . "$main::BR") if hint(@_); 926 TEXT("$BR" . hint(@_) . "$BR") if hint(@_);
882} 927}
883 928
884 929
885 930
886# End hints and solutions macros 931# End hints and solutions macros
902 947
903 948
904SRAND(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
905to check the answers :-). 950to check the answers :-).
906 951
907SRAND($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.
908This is probably what is desired. 953This is probably what is desired.
909 954
910=cut 955=cut
911 956
912 957
913sub random { 958sub random {
914 my ($begin, $end, $incr) = @_; 959 my ($begin, $end, $incr) = @_;
915 $main::PG_random_generator->random($begin,$end,$incr); 960 $PG_random_generator->random($begin,$end,$incr);
916} 961}
917 962
918 963
919sub non_zero_random { ##gives a non-zero random number 964sub non_zero_random { ##gives a non-zero random number
920 my (@arguments)=@_; 965 my (@arguments)=@_;
931 return $li[random(1,scalar(@li))-1]; 976 return $li[random(1,scalar(@li))-1];
932} 977}
933 978
934sub SRAND { # resets the main random generator -- use cautiously 979sub SRAND { # resets the main random generator -- use cautiously
935 my $seed = shift; 980 my $seed = shift;
936 $main::PG_random_generator -> srand($seed); 981 PG_random_generator -> srand($seed);
937} 982}
938 983
939# display macros 984# display macros
940 985
941=head2 Display Macros 986=head2 Display Macros
1260 #print "$start_delim $end_delim evaluate_string=$1<BR>"; 1305 #print "$start_delim $end_delim evaluate_string=$1<BR>";
1261 ($eval_out,$PG_eval_errors,$PG_full_error_report) = &$actionRef($1); 1306 ($eval_out,$PG_eval_errors,$PG_full_error_report) = &$actionRef($1);
1262 $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;
1263 $out = $out . $eval_out; 1308 $out = $out . $eval_out;
1264 #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>";
1265 $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 $@;
1266 } 1311 }
1267 else { 1312 else {
1268 $out .= $string; # flush the last part of the string 1313 $out .= $string; # flush the last part of the string
1269 last; 1314 last;
1270 } 1315 }
1282 my $in = shift; 1327 my $in = shift;
1283 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;");
1284 # the addition of the ; seems to provide better error reporting 1329 # the addition of the ; seems to provide better error reporting
1285 if ($PG_eval_errors) { 1330 if ($PG_eval_errors) {
1286 my @errorLines = split("\n",$PG_eval_errors); 1331 my @errorLines = split("\n",$PG_eval_errors);
1287 #$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> ";
1288 warn " ERROR in old_safe_ev, PGbasicmacros.pl: <PRE> 1333 warn " ERROR in old_safe_ev, PGbasicmacros.pl: <PRE>
1289 ## There is an error occuring inside evaluation brackets \\{ ...code... \\} 1334 ## There is an error occuring inside evaluation brackets \\{ ...code... \\}
1290 ## somewhere in an EV2 or EV3 or BEGIN_TEXT block. 1335 ## somewhere in an EV2 or EV3 or BEGIN_TEXT block.
1291 ## Code evaluated: 1336 ## Code evaluated:
1292 ## $in 1337 ## $in
1293 ##" .join("\n ", @errorLines). " 1338 ##" .join("\n ", @errorLines). "
1294 ##</PRE>$main::BR 1339 ##</PRE>$BR
1295 "; 1340 ";
1296 $out ="$main::PAR $main::BBOLD $in $main::EBOLD $main::PAR"; 1341 $out ="$PAR $BBOLD $in $EBOLD $PAR";
1297 1342
1298 1343
1299 } 1344 }
1300 1345
1301 ($out,$PG_eval_errors,$PG_full_error_report); 1346 ($out,$PG_eval_errors,$PG_full_error_report);
1319#sub math_ev3 { 1364#sub math_ev3 {
1320# my $in = shift; #print "in=$in<BR>"; 1365# my $in = shift; #print "in=$in<BR>";
1321# my ($out,$PG_eval_errors,$PG_full_error_report); 1366# my ($out,$PG_eval_errors,$PG_full_error_report);
1322# $in = FEQ($in); 1367# $in = FEQ($in);
1323# $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
1324# return("$main::BM $in $main::EM") unless ($displayMode eq 'HTML_tth'); 1369# return("$BM $in $EM") unless ($displayMode eq 'HTML_tth');
1325# $in = "\\(" . $in . "\\)"; 1370# $in = "\\(" . $in . "\\)";
1326# $out = tth($in); 1371# $out = tth($in);
1327# ($out,$PG_eval_errors,$PG_full_error_report); 1372# ($out,$PG_eval_errors,$PG_full_error_report);
1328# 1373#
1329#} 1374#}
1363 1408
1364 my $out; 1409 my $out;
1365 if($displayMode eq "HTML_tth") { 1410 if($displayMode eq "HTML_tth") {
1366 $out = tth($in_delim); 1411 $out = tth($in_delim);
1367 } elsif ($displayMode eq "HTML_dpng") { 1412 } elsif ($displayMode eq "HTML_dpng") {
1413 # for jj's version of ImageGenerator
1368 #$out = $envir{'imagegen'}->add($in_delim); 1414 $out = $envir->{'imagegen'}->add($in_delim);
1415 # for my version of ImageGenerator
1369 $out = $envir{'imagegen'}->add($in, $mode); 1416 #$out = $envir->{'imagegen'}->add($in, $mode);
1370 } elsif ($displayMode eq "HTML_img") { 1417 } elsif ($displayMode eq "HTML_img") {
1371 $out = math2img($in, $mode); 1418 $out = math2img($in, $mode);
1372 } else { 1419 } else {
1373 $out = "\\($in\\)" if $mode eq "inline"; 1420 $out = "\\($in\\)" if $mode eq "inline";
1374 $out = "\\[$in\\]" if $mode eq "display"; 1421 $out = "\\[$in\\]" if $mode eq "display";
1382 $string = ev_substring($string,"\\{","\\}",\&old_safe_ev); 1429 $string = ev_substring($string,"\\{","\\}",\&old_safe_ev);
1383 $string = ev_substring($string,"\\<","\\>",\&old_safe_ev); 1430 $string = ev_substring($string,"\\<","\\>",\&old_safe_ev);
1384 $string = ev_substring($string,"\\(","\\)",\&math_ev3); 1431 $string = ev_substring($string,"\\(","\\)",\&math_ev3);
1385 $string = ev_substring($string,"\\[","\\]",\&display_math_ev3); 1432 $string = ev_substring($string,"\\[","\\]",\&display_math_ev3);
1386 # macros for displaying math 1433 # macros for displaying math
1387 $string =~ s/\\\(/$main::BM/g; 1434 $string =~ s/\\\(/$BM/g;
1388 $string =~ s/\\\)/$main::EM/g; 1435 $string =~ s/\\\)/$EM/g;
1389 $string =~ s/\\\[/$main::BDM/g; 1436 $string =~ s/\\\[/$BDM/g;
1390 $string =~ s/\\\]/$main::EDM/g; 1437 $string =~ s/\\\]/$EDM/g;
1391 $string; 1438 $string;
1392} 1439}
1393 1440
1394sub EV3{ 1441sub EV3{
1395 my $string = join(" ",@_); 1442 my $string = join(" ",@_);
1398 # interpolate variables 1445 # interpolate variables
1399 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");
1400 if ($PG_eval_errors) { 1447 if ($PG_eval_errors) {
1401 my @errorLines = split("\n",$PG_eval_errors); 1448 my @errorLines = split("\n",$PG_eval_errors);
1402 $string =~ s/</&lt;/g; $string =~ s/>/&gt;/g; 1449 $string =~ s/</&lt;/g; $string =~ s/>/&gt;/g;
1403 $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> ";
1404 $@=""; 1451 $@="";
1405 } 1452 }
1406 $string = $evaluated_string; 1453 $string = $evaluated_string;
1407 $string = ev_substring($string,"\\(","\\)",\&math_ev3); 1454 $string = ev_substring($string,"\\(","\\)",\&math_ev3);
1408 $string = ev_substring($string,"\\[","\\]",\&display_math_ev3); 1455 $string = ev_substring($string,"\\[","\\]",\&display_math_ev3);
1437 1484
1438=cut 1485=cut
1439 1486
1440sub beginproblem { 1487sub beginproblem {
1441 my $out = ""; 1488 my $out = "";
1489 my $problemValue = $envir->{problemValue};
1490 my $fileName = $envir->{problemValue};
1491 my $probNum = $envir->{probNum};
1442 my $TeXFileName = protect_underbar($main::fileName); 1492 my $TeXFileName = protect_underbar($envir->{fileName});
1443 my $l2hFileName = protect_underbar($main::fileName); 1493 my $l2hFileName = protect_underbar($envir->{fileName});
1444 my %inlist; 1494 my %inlist;
1445 my $points ='pts'; 1495 my $points ='pts';
1496
1446 $points = 'pt' if $main::problemValue == 1; 1497 $points = 'pt' if $problemValue == 1;
1447 ## Prepare header for the problem 1498 ## Prepare header for the problem
1448 grep($inlist{$_}++,@{ $envir{'PRINT_FILE_NAMES_FOR'} }); 1499 grep($inlist{$_}++,@{ $envir->{'PRINT_FILE_NAMES_FOR'} });
1449 if ( defined($inlist{$main::studentLogin}) and ($inlist{$main::studentLogin} > 0) ) { 1500 if ( defined($inlist{$envir->{studentLogin}}) and ($inlist{$envir->{studentLogin}} > 0) ) {
1450 $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 ",
1451 " \\begin{rawhtml} ($main::problemValue $points) <B>$l2hFileName</B><BR>\\end{rawhtml}", 1502 " \\begin{rawhtml} ($problemValue $points) <B>$l2hFileName</B><BR>\\end{rawhtml}",
1452 "($main::problemValue $points) <B>$main::fileName</B><BR>" 1503 "($problemValue $points) <B>$fileName</B><BR>"
1453 ); 1504 );
1454 } else { 1505 } else {
1455 $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) ",
1456 "($main::problemValue $points) ", 1507 "($problemValue $points) ",
1457 "($main::problemValue $points) " 1508 "($problemValue $points) "
1458 ); 1509 );
1459 } 1510 }
1460 $out; 1511 $out;
1461 1512
1462} 1513}
1484 "<OL TYPE=\"A\" VALUE=\"1\">\n" 1535 "<OL TYPE=\"A\" VALUE=\"1\">\n"
1485 ) ; 1536 ) ;
1486 my $elem; 1537 my $elem;
1487 foreach $elem (@array) { 1538 foreach $elem (@array) {
1488 $out .= MODES( 1539 $out .= MODES(
1489 TeX=> "\\item[$main::ALPHABET[$i].] $elem\n", 1540 TeX=> "\\item[$ALPHABET[$i].] $elem\n",
1490 Latex2HTML=> " \\begin{rawhtml} <LI> \\end{rawhtml} $elem ", 1541 Latex2HTML=> " \\begin{rawhtml} <LI> \\end{rawhtml} $elem ",
1491 HTML=> "<LI> $elem\n", 1542 HTML=> "<LI> $elem\n",
1492 HTML_dpng=> "<LI> $elem <br /> <br /> \n" 1543 HTML_dpng=> "<LI> $elem <br /> <br /> \n"
1493 ); 1544 );
1494 $i++; 1545 $i++;
1503sub htmlLink { 1554sub htmlLink {
1504 my $url = shift; 1555 my $url = shift;
1505 my $text = shift; 1556 my $text = shift;
1506 my $options = shift; 1557 my $options = shift;
1507 $options = "" unless defined($options); 1558 $options = "" unless defined($options);
1508 return "${main::BBOLD}[ broken link: $text ] ${main::EBOLD}" unless defined($url); 1559 return "$BBOLD\[ broken link: $text \] $EBOLD" unless defined($url);
1509 M3( "{\\bf \\underline{$text} }", 1560 M3( "{\\bf \\underline{$text} }",
1510 "\\begin{rawhtml} <A HREF=\"$url\" $options> $text </A>\\end{rawhtml}", 1561 "\\begin{rawhtml} <A HREF=\"$url\" $options> $text </A>\\end{rawhtml}",
1511 "<A HREF=\"$url\" $options> $text </A>" 1562 "<A HREF=\"$url\" $options> $text </A>"
1512 ); 1563 );
1513} 1564}
1565
1514sub appletLink { 1566sub appletLink {
1515 my $url = shift; 1567 my $url = shift;
1516 my $options = shift; 1568 my $options = shift;
1517 $options = "" unless defined($options); 1569 $options = "" unless defined($options);
1518 M3( "{\\bf \\underline{APPLET} }", 1570 M3( "{\\bf \\underline{APPLET} }",
1646 while (@elements) { 1698 while (@elements) {
1647 $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";
1648 } 1700 }
1649 $out .= " \n\\begin{rawhtml}\n</TR> \n\\end{rawhtml}\n"; 1701 $out .= " \n\\begin{rawhtml}\n</TR> \n\\end{rawhtml}\n";
1650 } 1702 }
1651 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') {
1652 $out .= "<TR>\n"; 1704 $out .= "<TR>\n";
1653 while (@elements) { 1705 while (@elements) {
1654 $out .= "<TD>" . shift(@elements) . "</TD>"; 1706 $out .= "<TD>" . shift(@elements) . "</TD>";
1655 } 1707 }
1656 $out .= "\n</TR>\n"; 1708 $out .= "\n</TR>\n";
1657 } 1709 }
1658 else { 1710 else {
1659 $out = "Error: PGchoicemacros: row: Unknown displayMode: $main::displayMode.\n"; 1711 $out = "Error: PGchoicemacros: row: Unknown displayMode: $displayMode.\n";
1660 } 1712 }
1661 $out; 1713 $out;
1662} 1714}
1663 1715
1664=head2 Macros for displaying static images 1716=head2 Macros for displaying static images
1711 my @output_list = (); 1763 my @output_list = ();
1712 while(@image_list) { 1764 while(@image_list) {
1713 my $imageURL = alias(shift @image_list); 1765 my $imageURL = alias(shift @image_list);
1714 my $out=""; 1766 my $out="";
1715 1767
1716 if ($main::displayMode eq 'TeX') { 1768 if ($displayMode eq 'TeX') {
1717 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
1718 if ($envir{texDisposition} eq "pdf") { 1770 if ($envir->{texDisposition} eq "pdf") {
1719 # 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
1720 # 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
1721 # 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
1722 # is too dumb to live. 1774 # is too dumb to live.
1723 1775
1732 # 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
1733 # 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!
1734 1786
1735 $out = "\\includegraphics[width=$width_ratio\\linewidth]{$imagePath}\n"; 1787 $out = "\\includegraphics[width=$width_ratio\\linewidth]{$imagePath}\n";
1736 } 1788 }
1737 } elsif ($main::displayMode eq 'Latex2HTML') { 1789 } elsif ($displayMode eq 'Latex2HTML') {
1738 $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
1739 \\end{rawhtml}\n ! 1791 \\end{rawhtml}\n !
1740 } 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') {
1741 $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>
1742 ! 1794 !
1743 } else { 1795 } else {
1744 $out = "Error: PGchoicemacros: image: Unknown displayMode: $main::displayMode.\n"; 1796 $out = "Error: PGchoicemacros: image: Unknown displayMode: $displayMode.\n";
1745 } 1797 }
1746 push(@output_list, $out); 1798 push(@output_list, $out);
1747 } 1799 }
1748 return wantarray ? @output_list : $output_list[0]; 1800 return wantarray ? @output_list : $output_list[0];
1749} 1801}
1759} 1811}
1760 1812
1761 1813
1762sub caption { 1814sub caption {
1763 my ($out) = @_; 1815 my ($out) = @_;
1764 $out = " $out \n" if $main::displayMode eq 'TeX'; 1816 $out = " $out \n" if $displayMode eq 'TeX';
1765 $out = " $out " if $main::displayMode eq 'HTML'; 1817 $out = " $out " if $displayMode eq 'HTML';
1766 $out = " $out " if $main::displayMode eq 'HTML_tth'; 1818 $out = " $out " if $displayMode eq 'HTML_tth';
1767 $out = " $out " if $main::displayMode eq 'HTML_dpng'; 1819 $out = " $out " if $displayMode eq 'HTML_dpng';
1768 $out = " $out " if $main::displayMode eq 'HTML_img'; 1820 $out = " $out " if $displayMode eq 'HTML_img';
1769 $out = " $out " if $main::displayMode eq 'Latex2HTML'; 1821 $out = " $out " if $displayMode eq 'Latex2HTML';
1770 $out; 1822 $out;
1771} 1823}
1772 1824
1773sub captions { 1825sub captions {
1774 my @in = @_; 1826 my @in = @_;
1792 'height' => 100, 1844 'height' => 100,
1793 'width' => 100, 1845 'width' => 100,
1794 @_ # overwrite any default options 1846 @_ # overwrite any default options
1795 ); 1847 );
1796 1848
1797 if ($main::displayMode eq 'TeX') { 1849 if ($displayMode eq 'TeX') {
1798 $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";
1799 while (@images) { 1851 while (@images) {
1800 $out .= &image( shift(@images),%options ) . '&'; 1852 $out .= &image( shift(@images),%options ) . '&';
1801 } 1853 }
1802 chop($out); 1854 chop($out);
1804 while (@captions) { 1856 while (@captions) {
1805 $out .= &caption( shift(@captions) ) . '&'; 1857 $out .= &caption( shift(@captions) ) . '&';
1806 } 1858 }
1807 chop($out); 1859 chop($out);
1808 $out .= "\\\\ \\hline \n\\end {tabular}\\end{center}\\par\\smallskip\n"; 1860 $out .= "\\\\ \\hline \n\\end {tabular}\\end{center}\\par\\smallskip\n";
1809 } elsif ($main::displayMode eq 'Latex2HTML'){ 1861 } elsif ($displayMode eq 'Latex2HTML'){
1810 1862
1811 $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";
1812 while (@images) { 1864 while (@images) {
1813 $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 )
1814 . "\n\\begin{rawhtml} </TD>\n\\end{rawhtml}\n" ; 1866 . "\n\\begin{rawhtml} </TD>\n\\end{rawhtml}\n" ;
1819 $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) )
1820 . "\n\\begin{rawhtml} </TH>\n\\end{rawhtml}\n" ; 1872 . "\n\\begin{rawhtml} </TH>\n\\end{rawhtml}\n" ;
1821 } 1873 }
1822 1874
1823 $out .= "\n\\begin{rawhtml} </TR> </TABLE >\n\\end{rawhtml}"; 1875 $out .= "\n\\begin{rawhtml} </TR> </TABLE >\n\\end{rawhtml}";
1824 } 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'){
1825 $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";
1826 while (@images) { 1878 while (@images) {
1827 $out .= " \n<TD>". &image( shift(@images),%options ) ."</TD>"; 1879 $out .= " \n<TD>". &image( shift(@images),%options ) ."</TD>";
1828 } 1880 }
1829 $out .= "</TR>\n<TR>"; 1881 $out .= "</TR>\n<TR>";
1831 $out .= " <TH>". &caption( shift(@captions) ) ."</TH>"; 1883 $out .= " <TH>". &caption( shift(@captions) ) ."</TH>";
1832 } 1884 }
1833 $out .= "\n</TR></TABLE></P>\n" 1885 $out .= "\n</TR></TABLE></P>\n"
1834 } 1886 }
1835 else { 1887 else {
1836 $out = "Error: PGchoicemacros: imageRow: Unknown languageMode: $main::displayMode.\n"; 1888 $out = "Error: PGchoicemacros: imageRow: Unknown languageMode: $displayMode.\n";
1837 warn $out; 1889 warn $out;
1838 } 1890 }
1839 $out; 1891 $out;
1840} 1892}
1841 1893

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9