[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 6247 Revision 6248
1################################################################################ 1################################################################################
2# WeBWorK Program Generation Language 2# WeBWorK Program Generation Language
3# Copyright  2000-2007 The WeBWorK Project, http://openwebwork.sf.net/ 3# Copyright  2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
4# $CVSHeader: pg/macros/PGbasicmacros.pl,v 1.63 2010/01/07 18:02:53 jj Exp $ 4# $CVSHeader: pg/macros/PGbasicmacros.pl,v 1.64 2010/03/20 00:53:25 gage Exp $
5# 5#
6# This program is free software; you can redistribute it and/or modify it under 6# This program is free software; you can redistribute it and/or modify it under
7# the terms of either: (a) the GNU General Public License as published by the 7# the terms of either: (a) the GNU General Public License as published by the
8# Free Software Foundation; either version 2, or (at your option) any later 8# Free Software Foundation; either version 2, or (at your option) any later
9# version, or (b) the "Artistic License" which comes with this package. 9# version, or (b) the "Artistic License" which comes with this package.
190 $inputs_ref = $envir{inputs_ref}; 190 $inputs_ref = $envir{inputs_ref};
191 $rh_sticky_answers = PG_restricted_eval(q!\%main::STICKY_ANSWERS!); 191 $rh_sticky_answers = PG_restricted_eval(q!\%main::STICKY_ANSWERS!);
192 $r_ans_rule_count = PG_restricted_eval(q!\$ans_rule_count!); 192 $r_ans_rule_count = PG_restricted_eval(q!\$ans_rule_count!);
193} 193}
194 194
195=head2 Utility Macros
196
197 not_null(item) returns 1 or 0
198
199 empty arrays, empty hashes, strings containing only whitespace are all NULL and return 0
200 all undefined quantities are null and return 0
201
202
203=cut
204
205sub not_null { # empty arrays, empty hashes and strings containing only whitespace are all NULL
206 my $item = shift;
207 return 0 unless defined($item);
208 if (ref($item)=~/ARRAY/) {
209 return scalar(@{$item}); # return the length
210 } elsif (ref($item)=~/HASH/) {
211 return scalar( keys %{$item});
212 } else { # string case return 1 if none empty
213 return ($item =~ /\S/)? 1:0;
214 }
215}
216
195=head2 Answer blank macros: 217=head2 Answer blank macros:
196 218
197These produce answer blanks of various sizes or pop up lists or radio answer buttons. 219These produce answer blanks of various sizes or pop up lists or radio answer buttons.
198The names for the answer blanks are 220The names for the answer blanks are
199generated implicitly. 221generated implicitly.
256 NAMED_ANS(name1 => ans_evaluator1, name2 => ans_evaluator2,...); 278 NAMED_ANS(name1 => ans_evaluator1, name2 => ans_evaluator2,...);
257 279
258These auxiliary macros are defined in PG.pl 280These auxiliary macros are defined in PG.pl
259 281
260 282
261 NEW_ANS_NAME( number ); # produces a new answer blank name from a number by adding a prefix (AnSwEr) 283 NEW_ANS_NAME( ); # produces a new anonymous answer blank name by appending a number to the prefix (AnSwEr)
262 # and registers this name as an implicitly labeled answer 284 # and registers this name as an implicitly labeled answer
263 # Its use is paired with each answer evaluator being entered using ANS() 285 # Its use is paired with each answer evaluator being entered using ANS()
264 286
265 ANS_NUM_TO_NAME(number); # adds the prefix (AnSwEr) to the number, but does nothing else. 287 ANS_NUM_TO_NAME(number); # prepends the prefix (AnSwEr) to the number, but does nothing else.
266 288
267 RECORD_ANS_NAME( name ); # records the order in which the answer blank is rendered 289 RECORD_ANS_NAME( name ); # records the order in which the answer blank is rendered
268 # This is called by all of the constructs above, but must 290 # This is called by all of the constructs above, but must
269 # be called explicitly if an input blank is constructed explictly 291 # be called explicitly if an input blank is constructed explictly
270 # using HTML code. 292 # using HTML code.
271 293
272These are legacy macros: 294These are legacy macros:
273 295
274 ANS_RULE( number, width ); # equivalent to NAMED_ANS_RULE( NEW_ANS_NAME(number), width) 296 ANS_RULE( number, width ); # equivalent to NAMED_ANS_RULE( NEW_ANS_NAME( ), width)
275 ANS_BOX( question_number,height, width ); # equivalent to NAMED_ANS_BOX( NEW_ANS_NAME(number), height, width) 297 ANS_BOX( question_number,height, width ); # equivalent to NAMED_ANS_BOX( NEW_ANS_NAME( ), height, width)
276 ANS_RADIO( question_number, value,tag ); # equivalent to NAMED_ANS_RADIO( NEW_ANS_NAME(number), value,tag) 298 ANS_RADIO( question_number, value,tag ); # equivalent to NAMED_ANS_RADIO( NEW_ANS_NAME( ), value,tag)
277 ANS_RADIO_OPTION( question_number, value,tag ); # equivalent to NAMED_ANS_RADIO_EXTENSION( ANS_NUM_TO_NAME(number), value,tag) 299 ANS_RADIO_OPTION( question_number, value,tag ); # equivalent to NAMED_ANS_RADIO_EXTENSION( ANS_NUM_TO_NAME(number), value,tag)
278 300
279 301
280=cut 302=cut
281 303
282 304
283 305
284sub labeled_ans_rule { # syntactic sugar for NAMED_ANS_RULE 306sub labeled_ans_rule { # syntactic sugar for NAMED_ANS_RULE
285 my($name,$col) = @_; 307 my($name,$col) = @_;
286 $col = 20 unless defined($col); 308 $col = 20 unless not_null($col);
287 NAMED_ANS_RULE($name,$col); 309 NAMED_ANS_RULE($name,$col);
288} 310}
289 311
290sub NAMED_ANS_RULE { 312sub NAMED_ANS_RULE {
291 my($name,$col) = @_; 313 my($name,$col) = @_;
314 $col = 20 unless not_null($col);
315 my $answer_value = '';
316 $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name});
317 #FIXME -- code factoring needed
318 if ($answer_value =~ /\0/ ) {
319 my @answers = split("\0", $answer_value);
320 $answer_value = shift(@answers); # use up the first answer
321 $rh_sticky_answers->{$name}=\@answers;
322 # store the rest -- beacuse this stores to a main:; variable
323 # it must be evaluated at run time
324 $answer_value= '' unless defined($answer_value);
325 } elsif (ref($answer_value) eq 'ARRAY') {
326 my @answers = @{ $answer_value};
327 $answer_value = shift(@answers); # use up the first answer
328 $rh_sticky_answers->{$name}=\@answers;
329 # store the rest -- because this stores to a main:; variable
330 # it must be evaluated at run time
331 $answer_value= '' unless defined($answer_value);
332 }
333
334 $answer_value =~ tr/\\$@`//d; ## make sure student answers can not be interpolated by e.g. EV3
335 $answer_value =~ s/\s+/ /g; ## remove excessive whitespace from student answer
336 DEBUG_MESSAGE( "RECORD_ANS_NAME($name, $answer_value)");
337 $name = RECORD_ANS_NAME($name, $answer_value);
338 #INSERT_RESPONSE($name,$name,$answer_value); #FIXME -- why can't we do this inside RECORD_ANS_NAME?
339
340 my $tcol = $col/2 > 3 ? $col/2 : 3; ## get max
341 $tcol = $tcol < 40 ? $tcol : 40; ## get min
342
343 MODES(
344 TeX => "\\mbox{\\parbox[t]{${tcol}ex}{\\hrulefill}}",
345 Latex2HTML => qq!\\begin{rawhtml}<INPUT TYPE=TEXT SIZE=$col NAME=\"$name\" VALUE = \"\">\\end{rawhtml}!,
346 HTML => qq!<INPUT TYPE=TEXT SIZE=$col NAME="$name" id="$name" VALUE="$answer_value">!.
347 qq!<INPUT TYPE=HIDDEN NAME="previous_$name" VALUE="$answer_value">!
348 );
349}
350
351sub NAMED_HIDDEN_ANS_RULE { # this is used to hold information being passed into and out of applets
352 # -- preserves state -- identical to NAMED_ANS_RULE except input type "hidden"
353 my($name,$col) = @_;
354 $col = 20 unless not_null($col);
292 my $answer_value = ''; 355 my $answer_value = '';
293 $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name}); 356 $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name});
294 if ($answer_value =~ /\0/ ) { 357 if ($answer_value =~ /\0/ ) {
295 my @answers = split("\0", $answer_value); 358 my @answers = split("\0", $answer_value);
296 $answer_value = shift(@answers); # use up the first answer 359 $answer_value = shift(@answers); # use up the first answer
307 $answer_value= '' unless defined($answer_value); 370 $answer_value= '' unless defined($answer_value);
308 } 371 }
309 372
310 $answer_value =~ tr/\\$@`//d; #`## make sure student answers can not be interpolated by e.g. EV3 373 $answer_value =~ tr/\\$@`//d; #`## make sure student answers can not be interpolated by e.g. EV3
311 $answer_value =~ s/\s+/ /g; ## remove excessive whitespace from student answer 374 $answer_value =~ s/\s+/ /g; ## remove excessive whitespace from student answer
312 $name = RECORD_ANS_NAME($name); 375 $name = RECORD_ANS_NAME($name, $answer_value);
313 376 #INSERT_RESPONSE($name,$name,$answer_value);
314 my $tcol = $col/2 > 3 ? $col/2 : 3; ## get max
315 $tcol = $tcol < 40 ? $tcol : 40; ## get min
316
317 MODES(
318 TeX => "\\mbox{\\parbox[t]{${tcol}ex}{\\hrulefill}}",
319 Latex2HTML => qq!\\begin{rawhtml}<INPUT TYPE=TEXT SIZE=$col NAME=\"$name\" VALUE = \"\">\\end{rawhtml}!,
320 HTML => qq!<INPUT TYPE=TEXT SIZE=$col NAME="$name" id="$name" VALUE="$answer_value">!.
321 qq!<INPUT TYPE=HIDDEN NAME="previous_$name" VALUE="$answer_value">!
322 );
323}
324
325sub NAMED_HIDDEN_ANS_RULE { # this is used to hold information being passed into and out of applets
326 # -- preserves state -- identical to NAMED_ANS_RULE except input type "hidden"
327 my($name,$col) = @_;
328 my $answer_value = '';
329 $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name});
330 if ($answer_value =~ /\0/ ) {
331 my @answers = split("\0", $answer_value);
332 $answer_value = shift(@answers); # use up the first answer
333 $rh_sticky_answers->{$name}=\@answers;
334 # store the rest -- beacuse this stores to a main:; variable
335 # it must be evaluated at run time
336 $answer_value= '' unless defined($answer_value);
337 } elsif (ref($answer_value) eq 'ARRAY') {
338 my @answers = @{ $answer_value};
339 $answer_value = shift(@answers); # use up the first answer
340 $rh_sticky_answers->{$name}=\@answers;
341 # store the rest -- beacuse this stores to a main:; variable
342 # it must be evaluated at run time
343 $answer_value= '' unless defined($answer_value);
344 }
345
346 $answer_value =~ tr/\\$@`//d; #`## make sure student answers can not be interpolated by e.g. EV3
347 $answer_value =~ s/\s+/ /g; ## remove excessive whitespace from student answer
348 $name = RECORD_ANS_NAME($name);
349
350 my $tcol = $col/2 > 3 ? $col/2 : 3; ## get max 377 my $tcol = $col/2 > 3 ? $col/2 : 3; ## get max
351 $tcol = $tcol < 40 ? $tcol : 40; ## get min 378 $tcol = $tcol < 40 ? $tcol : 40; ## get min
352 379
353 MODES( 380 MODES(
354 TeX => "\\mbox{\\parbox[t]{${tcol}ex}{\\hrulefill}}", 381 TeX => "\\mbox{\\parbox[t]{${tcol}ex}{\\hrulefill}}",
369 $answer_value = shift( @{ $rh_sticky_answers->{$name} }); 396 $answer_value = shift( @{ $rh_sticky_answers->{$name} });
370 $answer_value = '' unless defined($answer_value); 397 $answer_value = '' unless defined($answer_value);
371 } 398 }
372 $answer_value =~ tr/\\$@`//d; #`## make sure student answers can not be interpolated by e.g. EV3 399 $answer_value =~ tr/\\$@`//d; #`## make sure student answers can not be interpolated by e.g. EV3
373 $answer_value =~ s/\s+/ /g; ## remove excessive whitespace from student answer 400 $answer_value =~ s/\s+/ /g; ## remove excessive whitespace from student answer
401 INSERT_RESPONSE($name,$name,$answer_value); #hack -- this needs more work to decide how to make it work
374 my $tcol = $col/2 > 3 ? $col/2 : 3; ## get max 402 my $tcol = $col/2 > 3 ? $col/2 : 3; ## get max
375 $tcol = $tcol < 40 ? $tcol : 40; ## get min 403 $tcol = $tcol < 40 ? $tcol : 40; ## get min
376 MODES( 404 MODES(
377 TeX => "\\mbox{\\parbox[t]{${tcol}ex}{\\hrulefill}}", 405 TeX => "\\mbox{\\parbox[t]{${tcol}ex}{\\hrulefill}}",
378 Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=TEXT SIZE=$col NAME="$name" id="$name" VALUE = " ">\n\\end{rawhtml}\n!, 406 Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=TEXT SIZE=$col NAME="$name" id="$name" VALUE = " ">\n\\end{rawhtml}\n!,
390 418
391sub NAMED_ANS_BOX { 419sub NAMED_ANS_BOX {
392 my($name,$row,$col) = @_; 420 my($name,$row,$col) = @_;
393 $row = 10 unless defined($row); 421 $row = 10 unless defined($row);
394 $col = 80 unless defined($col); 422 $col = 80 unless defined($col);
395 $name = RECORD_ANS_NAME($name); 423
396 my $height = .07*$row; 424 my $height = .07*$row;
397 my $answer_value = ''; 425 my $answer_value = '';
398 $answer_value = $inputs_ref->{$name} if defined( $inputs_ref->{$name} ); 426 $answer_value = $inputs_ref->{$name} if defined( $inputs_ref->{$name} );
427 $name = RECORD_ANS_NAME($name, $answer_value);
399# $answer_value =~ tr/\\$@`//d; #`## make sure student answers can not be interpolated by e.g. EV3 428# $answer_value =~ tr/\\$@`//d; #`## make sure student answers can not be interpolated by e.g. EV3
429 INSERT_RESPONSE($name,$name,$answer_value);
400 my $out = MODES( 430 my $out = MODES(
401 TeX => qq!\\vskip $height in \\hrulefill\\quad !, 431 TeX => qq!\\vskip $height in \\hrulefill\\quad !,
402 Latex2HTML => qq!\\begin{rawhtml}<TEXTAREA NAME="$name" id="$name" ROWS="$row" COLS="$col" 432 Latex2HTML => qq!\\begin{rawhtml}<TEXTAREA NAME="$name" id="$name" ROWS="$row" COLS="$col"
403 WRAP="VIRTUAL">$answer_value</TEXTAREA>\\end{rawhtml}!, 433 WRAP="VIRTUAL">$answer_value</TEXTAREA>\\end{rawhtml}!,
404 HTML => qq!<TEXTAREA NAME="$name" id="$name" ROWS="$row" COLS="$col" 434 HTML => qq!<TEXTAREA NAME="$name" id="$name" ROWS="$row" COLS="$col"
409 $out; 439 $out;
410} 440}
411 441
412sub ANS_BOX { #deprecated 442sub ANS_BOX { #deprecated
413 my($number,$row,$col) = @_; 443 my($number,$row,$col) = @_;
414 my $name = NEW_ANS_NAME($number); 444 my $name = NEW_ANS_NAME();
415 NAMED_ANS_BOX($name,$row,$col); 445 NAMED_ANS_BOX($name,$row,$col);
416} 446}
417 447
418sub NAMED_ANS_RADIO { 448sub NAMED_ANS_RADIO {
419 my $name = shift; 449 my $name = shift;
420 my $value = shift; 450 my $value = shift;
421 my $tag =shift; 451 my $tag =shift;
422 $name = RECORD_ANS_NAME($name); 452
423 my $checked = ''; 453 my $checked = '';
424 if ($value =~/^\%/) { 454 if ($value =~/^\%/) {
425 $value =~ s/^\%//; 455 $value =~ s/^\%//;
426 $checked = 'CHECKED' 456 $checked = 'CHECKED'
427 } 457 }
431 } else { 461 } else {
432 $checked = ''; 462 $checked = '';
433 } 463 }
434 464
435 } 465 }
436 466 $name = RECORD_ANS_NAME($name, {$value=>$checked} );
437 MODES( 467 MODES(
438 TeX => qq!\\item{$tag}\n!, 468 TeX => qq!\\item{$tag}\n!,
439 Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=RADIO NAME="$name" id="$name" VALUE="$value" $checked>\\end{rawhtml}$tag!, 469 Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=RADIO NAME="$name" id="$name" VALUE="$value" $checked>\\end{rawhtml}$tag!,
440 HTML => qq!<INPUT TYPE=RADIO NAME="$name" id="$name" VALUE="$value" $checked>$tag! 470 HTML => qq!<INPUT TYPE=RADIO NAME="$name" id="$name" VALUE="$value" $checked>$tag!
441 ); 471 );
463 } else { 493 } else {
464 $checked = ''; 494 $checked = '';
465 } 495 }
466 496
467 } 497 }
468 498 EXTEND_RESPONSE($name,$name,$value, $checked);
469 MODES( 499 MODES(
470 TeX => qq!\\item{$tag}\n!, 500 TeX => qq!\\item{$tag}\n!,
471 Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=RADIO NAME="$name" id="$name" VALUE="$value" $checked>\\end{rawhtml}$tag!, 501 Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=RADIO NAME="$name" id="$name" VALUE="$value" $checked>\\end{rawhtml}$tag!,
472 HTML => qq!<INPUT TYPE=RADIO NAME="$name" id="$name" VALUE="$value" $checked>$tag! 502 HTML => qq!<INPUT TYPE=RADIO NAME="$name" id="$name" VALUE="$value" $checked>$tag!
473 ); 503 );
491} 521}
492sub ANS_RADIO { 522sub ANS_RADIO {
493 my $number = shift; 523 my $number = shift;
494 my $value = shift; 524 my $value = shift;
495 my $tag =shift; 525 my $tag =shift;
496 my $name = NEW_ANS_NAME($number); 526 my $name = NEW_ANS_NAME();
497 NAMED_ANS_RADIO($name,$value,$tag); 527 NAMED_ANS_RADIO($name,$value,$tag);
498} 528}
499 529
500sub ANS_RADIO_OPTION { 530sub ANS_RADIO_OPTION {
501 my $number = shift; 531 my $number = shift;
502 my $value = shift; 532 my $value = shift;
503 my $tag =shift; 533 my $tag =shift;
504
505
506 my $name = ANS_NUM_TO_NAME($number); 534 my $name = ANS_NUM_TO_NAME($number);
507 NAMED_ANS_RADIO_OPTION($name,$value,$tag); 535 NAMED_ANS_RADIO_OPTION($name,$value,$tag);
508} 536}
509sub ANS_RADIO_BUTTONS { 537sub ANS_RADIO_BUTTONS {
510 my $number =shift; 538 my $number =shift;
557 585
558sub NAMED_ANS_CHECKBOX { 586sub NAMED_ANS_CHECKBOX {
559 my $name = shift; 587 my $name = shift;
560 my $value = shift; 588 my $value = shift;
561 my $tag =shift; 589 my $tag =shift;
562 $name = RECORD_ANS_NAME($name); 590
563 591
564 my $checked = ''; 592 my $checked = '';
565 if ($value =~/^\%/) { 593 if ($value =~/^\%/) {
566 $value =~ s/^\%//; 594 $value =~ s/^\%//;
567 $checked = 'CHECKED' 595 $checked = 'CHECKED'
574 else { 602 else {
575 $checked = ''; 603 $checked = '';
576 } 604 }
577 605
578 } 606 }
579 607 $name = RECORD_ANS_NAME($name, {$value => $checked});
580 MODES( 608 MODES(
581 TeX => qq!\\item{$tag}\n!, 609 TeX => qq!\\item{$tag}\n!,
582 Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=CHECKBOX NAME="$name" id="$name" VALUE="$value" $checked>\\end{rawhtml}$tag!, 610 Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=CHECKBOX NAME="$name" id="$name" VALUE="$value" $checked>\\end{rawhtml}$tag!,
583 HTML => qq!<INPUT TYPE=CHECKBOX NAME="$name" id="$name" VALUE="$value" $checked>$tag! 611 HTML => qq!<INPUT TYPE=CHECKBOX NAME="$name" id="$name" VALUE="$value" $checked>$tag!
584 ); 612 );
603 else { 631 else {
604 $checked = ''; 632 $checked = '';
605 } 633 }
606 634
607 } 635 }
608 636 EXTEND_RESPONSE($name,$name,$value, $checked);
609 MODES( 637 MODES(
610 TeX => qq!\\item{$tag}\n!, 638 TeX => qq!\\item{$tag}\n!,
611 Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=CHECKBOX NAME="$name" id="$name" VALUE="$value" $checked>\\end{rawhtml}$tag!, 639 Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=CHECKBOX NAME="$name" id="$name" VALUE="$value" $checked>\\end{rawhtml}$tag!,
612 HTML => qq!<INPUT TYPE=CHECKBOX NAME="$name" id="$name" VALUE="$value" $checked>$tag! 640 HTML => qq!<INPUT TYPE=CHECKBOX NAME="$name" id="$name" VALUE="$value" $checked>$tag!
613 ); 641 );
633 661
634sub ANS_CHECKBOX { 662sub ANS_CHECKBOX {
635 my $number = shift; 663 my $number = shift;
636 my $value = shift; 664 my $value = shift;
637 my $tag =shift; 665 my $tag =shift;
638 my $name = NEW_ANS_NAME($number); 666 my $name = NEW_ANS_NAME();
639 667
640 NAMED_ANS_CHECKBOX($name,$value,$tag); 668 NAMED_ANS_CHECKBOX($name,$value,$tag);
641} 669}
642 670
643sub ANS_CHECKBOX_OPTION { 671sub ANS_CHECKBOX_OPTION {
669} 697}
670 698
671sub ans_rule { 699sub ans_rule {
672 my $len = shift; # gives the optional length of the answer blank 700 my $len = shift; # gives the optional length of the answer blank
673 $len = 20 unless $len ; 701 $len = 20 unless $len ;
674 my $name = NEW_ANS_NAME(inc_ans_rule_count()); 702 #my $name = NEW_ANS_NAME();
703 my $name = NEW_ANS_NAME(); # increment is done internally
675 NAMED_ANS_RULE($name ,$len); 704 NAMED_ANS_RULE($name ,$len);
676} 705}
677sub ans_rule_extension { 706sub ans_rule_extension {
678 my $len = shift; 707 my $len = shift;
679 $len = 20 unless $len ; 708 $len = 20 unless $len ;
709 warn "ans_rule_extension may be misnumbering the answers";
680 my $name = NEW_ANS_NAME($$r_ans_rule_count); # don't update the answer name 710 my $name = NEW_ANS_NAME($$r_ans_rule_count); # don't update the answer name
681 NAMED_ANS_RULE($name ,$len); 711 NAMED_ANS_RULE($name ,$len);
682} 712}
683sub ans_radio_buttons { 713sub ans_radio_buttons {
684 my $name = NEW_ANS_NAME(inc_ans_rule_count()); 714 my $name = NEW_ANS_NAME();
685 my @radio_buttons = NAMED_ANS_RADIO_BUTTONS($name, @_); 715 my @radio_buttons = NAMED_ANS_RADIO_BUTTONS($name, @_);
686 716
687 if ($displayMode eq 'TeX') { 717 if ($displayMode eq 'TeX') {
688 $radio_buttons[0] = "\n\\begin{itemize}\n" . $radio_buttons[0]; 718 $radio_buttons[0] = "\n\\begin{itemize}\n" . $radio_buttons[0];
689 $radio_buttons[$#radio_buttons] .= "\n\\end{itemize}\n"; 719 $radio_buttons[$#radio_buttons] .= "\n\\end{itemize}\n";
692 (wantarray) ? @radio_buttons: join(" ", @radio_buttons); 722 (wantarray) ? @radio_buttons: join(" ", @radio_buttons);
693} 723}
694 724
695#added 6/14/2000 by David Etlinger 725#added 6/14/2000 by David Etlinger
696sub ans_checkbox { 726sub ans_checkbox {
697 my $name = NEW_ANS_NAME( inc_ans_rule_count() ); 727 my $name = NEW_ANS_NAME( );
698 my @checkboxes = NAMED_ANS_CHECKBOX_BUTTONS( $name, @_ ); 728 my @checkboxes = NAMED_ANS_CHECKBOX_BUTTONS( $name, @_ );
699 729
700 if ($displayMode eq 'TeX') { 730 if ($displayMode eq 'TeX') {
701 $checkboxes[0] = "\n\\begin{itemize}\n" . $checkboxes[0]; 731 $checkboxes[0] = "\n\\begin{itemize}\n" . $checkboxes[0];
702 $checkboxes[$#checkboxes] .= "\n\\end{itemize}\n"; 732 $checkboxes[$#checkboxes] .= "\n\\end{itemize}\n";
711## This will not work with latex2HTML mode since it creates gif equations. 741## This will not work with latex2HTML mode since it creates gif equations.
712 742
713sub tex_ans_rule { 743sub tex_ans_rule {
714 my $len = shift; 744 my $len = shift;
715 $len = 20 unless $len ; 745 $len = 20 unless $len ;
716 my $name = NEW_ANS_NAME(inc_ans_rule_count()); 746 my $name = NEW_ANS_NAME();
717 my $answer_rule = NAMED_ANS_RULE($name ,$len); # we don't want to create three answer rules in different modes. 747 my $answer_rule = NAMED_ANS_RULE($name ,$len); # we don't want to create three answer rules in different modes.
718 my $out = MODES( 748 my $out = MODES(
719 'TeX' => $answer_rule, 749 'TeX' => $answer_rule,
720 'Latex2HTML' => '\\fbox{Answer boxes cannot be placed inside typeset equations}', 750 'Latex2HTML' => '\\fbox{Answer boxes cannot be placed inside typeset equations}',
721 'HTML_tth' => '\\begin{rawhtml} '. $answer_rule.'\\end{rawhtml}', 751 'HTML_tth' => '\\begin{rawhtml} '. $answer_rule.'\\end{rawhtml}',
726 $out; 756 $out;
727} 757}
728sub tex_ans_rule_extension { 758sub tex_ans_rule_extension {
729 my $len = shift; 759 my $len = shift;
730 $len = 20 unless $len ; 760 $len = 20 unless $len ;
761 warn "tex_ans_rule_extension may be missnumbering the answer";
731 my $name = NEW_ANS_NAME($$r_ans_rule_count); 762 my $name = NEW_ANS_NAME($$r_ans_rule_count);
732 my $answer_rule = NAMED_ANS_RULE($name ,$len); # we don't want to create three answer rules in different modes. 763 my $answer_rule = NAMED_ANS_RULE($name ,$len); # we don't want to create three answer rules in different modes.
733 my $out = MODES( 764 my $out = MODES(
734 'TeX' => $answer_rule, 765 'TeX' => $answer_rule,
735 'Latex2HTML' => '\fbox{Answer boxes cannot be placed inside typeset equations}', 766 'Latex2HTML' => '\fbox{Answer boxes cannot be placed inside typeset equations}',
774sub ans_box { 805sub ans_box {
775 my $row = shift; 806 my $row = shift;
776 my $col =shift; 807 my $col =shift;
777 $row = 5 unless $row; 808 $row = 5 unless $row;
778 $col = 80 unless $col; 809 $col = 80 unless $col;
779 my $name = NEW_ANS_NAME(inc_ans_rule_count()); 810 my $name = NEW_ANS_NAME();
780 NAMED_ANS_BOX($name ,$row,$col); 811 NAMED_ANS_BOX($name ,$row,$col);
781} 812}
782 813
783#this is legacy code; use ans_checkbox instead 814#this is legacy code; use ans_checkbox instead
784sub checkbox { 815sub checkbox {
792 my @list = @_; 823 my @list = @_;
793 if(ref($list[0]) eq 'ARRAY') { 824 if(ref($list[0]) eq 'ARRAY') {
794 my @list1 = @{$list[0]}; 825 my @list1 = @{$list[0]};
795 @list = map { $_ => $_ } @list1; 826 @list = map { $_ => $_ } @list1;
796 } 827 }
797 $name = RECORD_ANS_NAME($name); # record answer name 828
798 my $answer_value = ''; 829 my $answer_value = '';
799 $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name}); 830 $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name});
800 my $out = ""; 831 my $out = "";
801 if ($displayMode eq 'HTML' or $displayMode eq 'HTML_tth' or 832 if ($displayMode eq 'HTML' or $displayMode eq 'HTML_tth' or
802 $displayMode eq 'HTML_dpng' or $displayMode eq 'HTML_img' or $displayMode eq 'HTML_jsMath' or 833 $displayMode eq 'HTML_dpng' or $displayMode eq 'HTML_img' or $displayMode eq 'HTML_jsMath' or
817 }; 848 };
818 $out .= " \\begin{rawhtml}</SELECT>\\end{rawhtml}\n"; 849 $out .= " \\begin{rawhtml}</SELECT>\\end{rawhtml}\n";
819 } elsif ( $displayMode eq "TeX") { 850 } elsif ( $displayMode eq "TeX") {
820 $out .= "\\fbox{?}"; 851 $out .= "\\fbox{?}";
821 } 852 }
822 853 $name = RECORD_ANS_NAME($name,$answer_value); # record answer name
854 $out;
823} 855}
824 856
825sub pop_up_list { 857sub pop_up_list {
826 my @list = @_; 858 my @list = @_;
827 my $name = NEW_ANS_NAME(inc_ans_rule_count()); # get new answer name 859 my $name = NEW_ANS_NAME(); # get new answer name
828 NAMED_POP_UP_LIST($name, @list); 860 NAMED_POP_UP_LIST($name, @list);
829} 861}
830 862
831 863
832 864
874 906
875sub NAMED_ANS_ARRAY_EXTENSION{ 907sub NAMED_ANS_ARRAY_EXTENSION{
876 908
877 my $name = shift; 909 my $name = shift;
878 my $col = shift; 910 my $col = shift;
911 my %options = @_;
879 $col = 20 unless $col; 912 $col = 20 unless $col;
880 my $answer_value = ''; 913 my $answer_value = '';
881 914
882 $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name}); 915 $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name});
883 if ($answer_value =~ /\0/ ) { 916 if ($answer_value =~ /\0/ ) {
889 $answer_value = shift(@answers); 922 $answer_value = shift(@answers);
890 $answer_value= '' unless defined($answer_value); 923 $answer_value= '' unless defined($answer_value);
891 } 924 }
892 925
893 $answer_value =~ tr/\\$@`//d; #`## make sure student answers can not be interpolated by e.g. EV3 926 $answer_value =~ tr/\\$@`//d; #`## make sure student answers can not be interpolated by e.g. EV3
927 warn "ans_label $options{ans_label} $name $answer_value";
928 if (defined($options{ans_label}) ) {
929 INSERT_RESPONSE($options{ans_label}, $name, $answer_value);
930 }
894 MODES( 931 MODES(
895 TeX => "\\mbox{\\parbox[t]{10pt}{\\hrulefill}}\\hrulefill\\quad ", 932 TeX => "\\mbox{\\parbox[t]{10pt}{\\hrulefill}}\\hrulefill\\quad ",
896 Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=TEXT SIZE=$col NAME="$name" id="$name" VALUE = "">\n\\end{rawhtml}\n!, 933 Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=TEXT SIZE=$col NAME="$name" id="$name" VALUE = "">\n\\end{rawhtml}\n!,
897 HTML => qq!<INPUT TYPE=TEXT SIZE=$col NAME="$name" id="$name" VALUE = "$answer_value">\n! 934 HTML => qq!<INPUT TYPE=TEXT SIZE=$col NAME="$name" id="$name" VALUE = "$answer_value">\n!
898 ); 935 );
901sub ans_array{ 938sub ans_array{
902 my $m = shift; 939 my $m = shift;
903 my $n = shift; 940 my $n = shift;
904 my $col = shift; 941 my $col = shift;
905 $col = 20 unless $col; 942 $col = 20 unless $col;
943 my $ans_label = NEW_ANS_NAME();
906 my $num = inc_ans_rule_count() ; 944 my $num = ans_rule_count();
907 my $name = NEW_ANS_ARRAY_NAME($num,0,0);
908 my @options = @_; 945 my @options = @_;
909 my @array=(); 946 my @array=();
910 my $string;
911 my $answer_value = ""; 947 my $answer_value = "";
912 948 my @response_list = ();
913 $array[0][0] = NAMED_ANS_RULE($name,$col); 949 my $name;
914 950 $main::vecnum = -1;
951 CLEAR_RESPONSES($ans_label);
952
953
915 for( my $i = 1; $i < $n; $i+=1) 954 for( my $i = 0; $i < $n; $i+=1)
916 { 955 {
917 $name = NEW_ANS_ARRAY_NAME_EXTENSION($num,0,$i); 956 $name = NEW_ANS_ARRAY_NAME_EXTENSION($num,0,$i);
918 $array[0][$i] = NAMED_ANS_ARRAY_EXTENSION($name,$col); 957 $array[0][$i] = NAMED_ANS_ARRAY_EXTENSION($name,$col,ans_label=>$ans_label);
919 958
920 } 959 }
921 960
922 for( my $j = 1; $j < $m; $j+=1 ){ 961 for( my $j = 1; $j < $m; $j+=1 ){
923 962
924 for( my $i = 0; $i < $n; $i+=1) 963 for( my $i = 0; $i < $n; $i+=1)
925 { 964 {
926 $name = NEW_ANS_ARRAY_NAME_EXTENSION($num,$j,$i); 965 $name = NEW_ANS_ARRAY_NAME_EXTENSION($num,$j,$i);
927 $array[$j][$i] = NAMED_ANS_ARRAY_EXTENSION($name,$col); 966 $array[$j][$i] = NAMED_ANS_ARRAY_EXTENSION($name,$col, ans_label=>$ans_label);
928
929 } 967 }
930 968
931 } 969 }
932 my $ra_local_display_matrix=PG_restricted_eval(q!\&main::display_matrix!); 970 my $ra_local_display_matrix=PG_restricted_eval(q!\&main::display_matrix!);
933 &$ra_local_display_matrix( \@array, @options ); 971 &$ra_local_display_matrix( \@array, @options );
937sub ans_array_extension{ 975sub ans_array_extension{
938 my $m = shift; 976 my $m = shift;
939 my $n = shift; 977 my $n = shift;
940 my $col = shift; 978 my $col = shift;
941 $col = 20 unless $col; 979 $col = 20 unless $col;
942 my $num = PG_restricted_eval(q!$main::ans_rule_count!); 980 my $num = ans_rule_count(); #hack -- ans_rule_count is updated after being used
943 my @options = @_; 981 my @options = @_;
982 my @response_list = ();
944 my $name; 983 my $name;
945 my @array=(); 984 my @array=();
946 my $string; 985 my $ans_label = $main::PG->new_label($num);
947 my $answer_value = "";
948
949 for( my $j = 0; $j < $m; $j+=1 ){ 986 for( my $j = 0; $j < $m; $j+=1 ){
950 987
951 for( my $i = 0; $i < $n; $i+=1) 988 for( my $i = 0; $i < $n; $i+=1)
952 { 989 {
953 $name = NEW_ANS_ARRAY_NAME_EXTENSION($num,$j,$i); 990 $name = NEW_ANS_ARRAY_NAME_EXTENSION($num,$j,$i);
954 $array[$j][$i] = NAMED_ANS_ARRAY_EXTENSION($name,$col); 991 $array[$j][$i] = NAMED_ANS_ARRAY_EXTENSION($name,$col, ans_label=>$ans_label);
955 992
956 } 993 }
957 994
958 } 995 }
959 my $ra_local_display_matrix=PG_restricted_eval(q!\&main::display_matrix!); 996 my $ra_local_display_matrix=PG_restricted_eval(q!\&main::display_matrix!);
1067# Currently, the only output is html 1104# Currently, the only output is html
1068 1105
1069sub COMMENT { 1106sub COMMENT {
1070 my @in = @_; 1107 my @in = @_;
1071 my $out = join("$BR", @in); 1108 my $out = join("$BR", @in);
1072 my $out = '<div class=\"AuthorComment\">'.$out.'</div>'; 1109 $out = '<div class=\"AuthorComment\">'.$out.'</div>';
1073
1074 PG_restricted_eval(q!$main::pgComment = "!.$out.q!"!); 1110 PG_restricted_eval(q!$main::pgComment = "!.$out.q!"!);
1075 return(''); 1111 return('');
1076} 1112}
1077 1113
1078################################# 1114#################################
1180# This replaces M3. You can add new modes at will to this one. 1216# This replaces M3. You can add new modes at will to this one.
1181sub MODES { 1217sub MODES {
1182 my %options = @_; 1218 my %options = @_;
1183 1219
1184 # is a string supplied for the current display mode? if so, return it 1220 # is a string supplied for the current display mode? if so, return it
1185 return $options{$displayMode} if defined $options{$displayMode}; 1221 return $options{$main::displayMode} if defined $options{$main::displayMode};
1186 1222
1187 # otherwise, fail over to backup modes 1223 # otherwise, fail over to backup modes
1188 my @backup_modes; 1224 my @backup_modes;
1189 if (exists $DISPLAY_MODE_FAILOVER{$displayMode}) { 1225 if (exists $DISPLAY_MODE_FAILOVER{$main::displayMode}) {
1190 @backup_modes = @{$DISPLAY_MODE_FAILOVER{$displayMode}}; 1226 @backup_modes = @{$DISPLAY_MODE_FAILOVER{$main::displayMode}};
1191 foreach my $mode (@backup_modes) { 1227 foreach my $mode (@backup_modes) {
1192 return $options{$mode} if defined $options{$mode}; 1228 return $options{$mode} if defined $options{$mode};
1193 } 1229 }
1194 } 1230 }
1195 die "ERROR in defining MODES: neither display mode $displayMode nor", 1231 die "ERROR in defining MODES: neither display mode '$main::displayMode' nor",
1196 " any fallback modes (", join(", ", @backup_modes), ") supplied.\n"; 1232 " any fallback modes (", join(", ", @backup_modes), ") supplied.";
1197} 1233}
1198 1234
1199# end display macros 1235# end display macros
1200 1236
1201 1237
1259# Adopted Davide Cervone's improvements to PAR, LTS, GTS, LTE, GTE, LBRACE, RBRACE, LB, RB. 7-14-03 AKP 1295# Adopted Davide Cervone's improvements to PAR, LTS, GTS, LTE, GTE, LBRACE, RBRACE, LB, RB. 7-14-03 AKP
1260sub PAR { MODES( TeX => '\\par ', Latex2HTML => '\\begin{rawhtml}<P>\\end{rawhtml}', HTML => '<P>'); }; 1296sub PAR { MODES( TeX => '\\par ', Latex2HTML => '\\begin{rawhtml}<P>\\end{rawhtml}', HTML => '<P>'); };
1261#sub BR { MODES( TeX => '\\par\\noindent ', Latex2HTML => '\\begin{rawhtml}<BR>\\end{rawhtml}', HTML => '<BR>'); }; 1297#sub BR { MODES( TeX => '\\par\\noindent ', Latex2HTML => '\\begin{rawhtml}<BR>\\end{rawhtml}', HTML => '<BR>'); };
1262# Alternate definition of BR which is slightly more flexible and gives more white space in printed output 1298# Alternate definition of BR which is slightly more flexible and gives more white space in printed output
1263# which looks better but kills more trees. 1299# which looks better but kills more trees.
1264sub BR { MODES( TeX => '\\leavevmode\\\\\\relax ', Latex2HTML => '\\begin{rawhtml}<BR>\\end{rawhtml}', HTML => '<BR>'); }; 1300sub BR { MODES( TeX => '\\leavevmode\\\\\\relax ', Latex2HTML => '\\begin{rawhtml}<BR>\\end{rawhtml}', HTML => '<BR/>'); };
1265sub LQ { MODES( TeX => "\\lq\\lq{}", Latex2HTML => '"', HTML => '&quot;' ); }; 1301sub LQ { MODES( TeX => "\\lq\\lq{}", Latex2HTML => '"', HTML => '&quot;' ); };
1266sub RQ { MODES( TeX => "\\rq\\rq{}", Latex2HTML => '"', HTML => '&quot;' ); }; 1302sub RQ { MODES( TeX => "\\rq\\rq{}", Latex2HTML => '"', HTML => '&quot;' ); };
1267sub BM { MODES(TeX => '\\(', Latex2HTML => '\\(', HTML => ''); }; # begin math mode 1303sub BM { MODES(TeX => '\\(', Latex2HTML => '\\(', HTML => ''); }; # begin math mode
1268sub EM { MODES(TeX => '\\)', Latex2HTML => '\\)', HTML => ''); }; # end math mode 1304sub EM { MODES(TeX => '\\)', Latex2HTML => '\\)', HTML => ''); }; # end math mode
1269sub BDM { MODES(TeX => '\\[', Latex2HTML => '\\[', HTML => '<P ALIGN=CENTER>'); }; #begin displayMath mode 1305sub BDM { MODES(TeX => '\\[', Latex2HTML => '\\[', HTML => '<P ALIGN=CENTER>'); }; #begin displayMath mode
1467 } 1503 }
1468 $out; 1504 $out;
1469} 1505}
1470sub safe_ev { 1506sub safe_ev {
1471 my ($out,$PG_eval_errors,$PG_full_error_report) = &old_safe_ev; # process input by old_safe_ev first 1507 my ($out,$PG_eval_errors,$PG_full_error_report) = &old_safe_ev; # process input by old_safe_ev first
1508 $out = "" unless defined($out) and $out =~/\S/;
1472 $out =~s/\\/\\\\/g; # protect any new backslashes introduced. 1509 $out =~s/\\/\\\\/g; # protect any new backslashes introduced.
1473 ($out,$PG_eval_errors,$PG_full_error_report) 1510 ($out,$PG_eval_errors,$PG_full_error_report)
1474} 1511}
1475 1512
1476sub old_safe_ev { 1513sub old_safe_ev {
1808 1845
1809=cut 1846=cut
1810 1847
1811sub beginproblem { 1848sub beginproblem {
1812 my $out = ""; 1849 my $out = "";
1813 my $problemValue = $envir->{problemValue}; 1850 my $problemValue = $envir->{problemValue} || 0;
1814 my $fileName = $envir->{fileName}; 1851 my $fileName = $envir->{fileName};
1815 my $probNum = $envir->{probNum}; 1852 my $probNum = $envir->{probNum};
1816 my $TeXFileName = protect_underbar($envir->{fileName}); 1853 my $TeXFileName = protect_underbar($envir->{fileName});
1817 my $l2hFileName = protect_underbar($envir->{fileName}); 1854 my $l2hFileName = protect_underbar($envir->{fileName});
1818 my %inlist; 1855 my %inlist;
1947 return "" if(not defined($envir{'localHelpURL'})); 1984 return "" if(not defined($envir{'localHelpURL'}));
1948 my $type = lc($type1); 1985 my $type = lc($type1);
1949 my %typeHash = ( 1986 my %typeHash = (
1950 'interval notation' => 'IntervalNotation.html', 1987 'interval notation' => 'IntervalNotation.html',
1951 'units' => 'Units.html', 1988 'units' => 'Units.html',
1989 'syntax' => 'Syntax.html',
1952 ); 1990 );
1953 1991
1954 my $infoRef = $typeHash{$type}; 1992 my $infoRef = $typeHash{$type};
1955 return htmlLink( $envir{'localHelpURL'}.$infoRef, $type1, 1993 return htmlLink( $envir{'localHelpURL'}.$infoRef, $type1,
1956'target="ww_help" onclick="window.open(this.href,this.target,\'width=550,height=350,scrollbars=yes,resizable=on\'); return false;"'); 1994'target="ww_help" onclick="window.open(this.href,this.target,\'width=550,height=350,scrollbars=yes,resizable=on\'); return false;"');
1983 warn $codebase; 2021 warn $codebase;
1984 return; 2022 return;
1985 } else { 2023 } else {
1986 # we are set to include the applet 2024 # we are set to include the applet
1987 } 2025 }
1988 my $appletHeader = qq! archive = "$archive " codebase = "$codebase" !; 2026 $appletHeader = qq! archive = "$archive " codebase = "$codebase" !;
1989 foreach my $key ('name', 'code','width','height', ) { 2027 foreach my $key ('name', 'code','width','height', ) {
1990 if ( defined($applet->{$key}) ) { 2028 if ( defined($applet->{$key}) ) {
1991 $appletHeader .= qq! $key = "!.$applet->{$key}.q!" ! ; 2029 $appletHeader .= qq! $key = "!.$applet->{$key}.q!" ! ;
1992 } else { 2030 } else {
1993 warn " $key is not defined for applet ".$applet->{name}; 2031 warn " $key is not defined for applet ".$applet->{name};
2056 my @out = keys %temp; # sort is causing trouble with Safe.?? 2094 my @out = keys %temp; # sort is causing trouble with Safe.??
2057 @out; 2095 @out;
2058} 2096}
2059 2097
2060sub lex_sort { 2098sub lex_sort {
2061 PGsort sub {$_[0] lt $_[1]}, @_; 2099 PGsort( sub {$_[0] lt $_[1]}, @_);
2062} 2100}
2063sub num_sort { 2101sub num_sort {
2064 PGsort sub {$_[0] < $_[1]}, @_; 2102 PGsort( sub {$_[0] < $_[1]}. @_);
2065} 2103}
2066 2104
2067 2105
2068=head2 Macros for handling tables 2106=head2 Macros for handling tables
2069 2107
2128 } 2166 }
2129 else { 2167 else {
2130 $out = "Error: PGbasicmacros: endtable: Unknown displayMode: $displayMode.\n"; 2168 $out = "Error: PGbasicmacros: endtable: Unknown displayMode: $displayMode.\n";
2131 } 2169 }
2132 $out; 2170 $out;
2133 } 2171}
2134 2172
2135 2173
2136sub row { 2174sub row {
2137 my @elements = @_; 2175 my @elements = @_;
2138 my $out = ""; 2176 my $out = "";

Legend:
Removed from v.6247  
changed lines
  Added in v.6248

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9