Parent Directory
| 
Revision Log
Added syntactic sugar for pop_up_lists.
A common situation is that a problem includes a short multiple-choice question along with other answers. Often, these questions are written as fill-in-the-blank where the student is told a list of legal words to put in the blanks. The idea is to make it as simple as possible for problem writers to replace the fill-in-the-blank with a drop-down list of alternatives.
So, now the text of a problem can contain
is the function increasing on [0,1]? \{ pop_up_list(['?', 'yes', 'no']) \}
instead of
is the function increasing on [0,1]? \{ pop_up_list('?' => '?', 'yes' => 'yes', 'no' => 'no') \}
The result is checked with something like
ANS(str_cmp('yes'));
Existing problems are unaffected since the added syntax uses a reference to a list (the extra square brackets).
1 2 3 #################################################################### 4 # Copyright @ 1995-1998 University of Rochester 5 # All Rights Reserved 6 #################################################################### 7 8 =head1 NAME 9 10 PGbasicmacros.pl --- located in the courseScripts directory 11 12 =head1 SYNPOSIS 13 14 15 16 =head1 DESCRIPTION 17 18 19 20 =cut 21 22 # this is equivalent to use strict, but can be used within the Safe compartment. 23 BEGIN{ 24 be_strict; 25 } 26 27 28 my $displayMode; 29 30 my ($PAR, 31 $BR, 32 $LQ, 33 $RQ, 34 $BM, 35 $EM, 36 $BDM, 37 $EDM, 38 $LTS, 39 $GTS, 40 $LTE, 41 $GTE, 42 $BEGIN_ONE_COLUMN, 43 $END_ONE_COLUMN, 44 $SOL, 45 $SOLUTION, 46 $HINT, 47 $COMMENT, 48 $US, 49 $SPACE, 50 $BBOLD, 51 $EBOLD, 52 $BITALIC, 53 $EITALIC, 54 $BCENTER, 55 $ECENTER, 56 $HR, 57 $LBRACE, 58 $RBRACE, 59 $LB, 60 $RB, 61 $DOLLAR, 62 $PERCENT, 63 $CARET, 64 $PI, 65 $E, 66 @ALPHABET, 67 $envir, 68 $PG_random_generator, 69 $inputs_ref, 70 $rh_sticky_answers, 71 $r_ans_rule_count, 72 ); 73 74 sub _PGbasicmacros_init { 75 # The big problem is that at compile time in the cached Safe compartment 76 # main:: has one definition, probably Safe::Root1:: 77 # At runtime main has another definition Safe::Rootx:: where x is > 1 78 79 # It is important to 80 # initialize the my variable version of $displayMode from the "runtime" version 81 # of main::displayMode 82 83 $displayMode = main::PG_restricted_eval(q!$main::displayMode!); 84 85 # This is initializes the remaining variables in the runtime main:: compartment. 86 87 main::PG_restricted_eval( <<'EndOfFile'); 88 $displayMode = $displayMode; 89 90 $main::PAR = PAR(); 91 $main::BR = BR(); 92 $main::LQ = LQ(); 93 $main::RQ = RQ(); 94 $main::BM = BM(); 95 $main::EM = EM(); 96 $main::BDM = BDM(); 97 $main::EDM = EDM(); 98 $main::LTS = LTS(); 99 $main::GTS = GTS(); 100 $main::LTE = LTE(); 101 $main::GTE = GTE(); 102 $main::BEGIN_ONE_COLUMN = BEGIN_ONE_COLUMN(); 103 $main::END_ONE_COLUMN = END_ONE_COLUMN(); 104 $main::SOL = SOLUTION_HEADING(); 105 $main::SOLUTION = SOLUTION_HEADING(); 106 $main::HINT = HINT_HEADING(); 107 $main::US = US(); 108 $main::SPACE = SPACE(); 109 $main::BBOLD = BBOLD(); 110 $main::EBOLD = EBOLD(); 111 $main::BITALIC = BITALIC(); 112 $main::EITALIC = EITALIC(); 113 $main::BCENTER = BCENTER(); 114 $main::ECENTER = ECENTER(); 115 $main::HR = HR(); 116 $main::LBRACE = LBRACE(); 117 $main::RBRACE = RBRACE(); 118 $main::LB = LB(); 119 $main::RB = RB(); 120 $main::DOLLAR = DOLLAR(); 121 $main::PERCENT = PERCENT(); 122 $main::CARET = CARET(); 123 $main::PI = PI(); 124 $main::E = E(); 125 @main::ALPHABET = ('A'..'ZZ'); 126 %main::STICKY_ANSWERS = (); 127 128 129 EndOfFile 130 131 # Next we transfer the correct definitions in the main:: compartment to the local my variables 132 # This can't be done inside the eval above because my variables seem to be invisible inside the eval 133 134 135 $PAR = PAR(); 136 $BR = BR(); 137 $LQ = LQ(); 138 $RQ = RQ(); 139 $BM = BM(); 140 $EM = EM(); 141 $BDM = BDM(); 142 $EDM = EDM(); 143 $LTS = LTS(); 144 $GTS = GTS(); 145 $LTE = LTE(); 146 $GTE = GTE(); 147 $BEGIN_ONE_COLUMN = BEGIN_ONE_COLUMN(); 148 $END_ONE_COLUMN = END_ONE_COLUMN(); 149 $SOL = SOLUTION_HEADING(); 150 $SOLUTION = SOLUTION_HEADING(); 151 $HINT = HINT_HEADING(); 152 $US = US(); 153 $SPACE = SPACE(); 154 $BBOLD = BBOLD(); 155 $EBOLD = EBOLD(); 156 $BITALIC = BITALIC(); 157 $EITALIC = EITALIC(); 158 $BCENTER = BCENTER(); 159 $ECENTER = ECENTER(); 160 $HR = HR(); 161 $LBRACE = LBRACE(); 162 $RBRACE = RBRACE(); 163 $LB = LB(); 164 $RB = RB(); 165 $DOLLAR = DOLLAR(); 166 $PERCENT = PERCENT(); 167 $CARET = CARET(); 168 $PI = PI(); 169 $E = E(); 170 @ALPHABET = ('A'..'ZZ'); 171 172 $envir = PG_restricted_eval(q!\%main::envir!); 173 $PG_random_generator = PG_restricted_eval(q!$main::PG_random_generator!); 174 $inputs_ref = $envir{inputs_ref}; 175 $rh_sticky_answers = PG_restricted_eval(q!\%main::STICKY_ANSWERS!); 176 $r_ans_rule_count = PG_restricted_eval(q!\$ans_rule_count!); 177 } 178 179 =head2 Answer blank macros: 180 181 These produce answer blanks of various sizes or pop up lists or radio answer buttons. 182 The names for the answer blanks are 183 generated implicitly. 184 185 ans_rule( width ) 186 tex_ans_rule( width ) 187 ans_radio_buttons(value1=>label1, value2,label2 => value3,label3=>...) 188 pop_up_list(@list) # list consists of (value => label, PR => "Product rule",...) 189 pop_up_list([@list]) # list consists of values 190 191 In the last case, one can use C<pop_up_list(['?', 'yes', 'no'])> to produce a 192 pop-up list containing the three strings listed, and then use str_cmp to check 193 the answer. 194 195 To indicate the checked position of radio buttons put a '%' in front of the value: C<ans_radio_buttons(1, 'Yes','%2','No')> 196 will have 'No' checked. C<tex_ans_rule> works inside math equations in C<HTML_tth> mode. It does not work in C<Latex2HTML> mode 197 since this mode produces gif pictures. 198 199 200 The following method is defined in F<PG.pl> for entering the answer evaluators corresponding 201 to answer rules with automatically generated names. The answer evaluators are matched with the 202 answer rules in the order in which they appear on the page. 203 204 ANS(ans_evaluator1, ans_evaluator2,...); 205 206 These are more primitive macros which produce answer blanks for specialized cases when complete 207 control over the matching of answers blanks and answer evaluators is desired. 208 The names of the answer blanks must be generated manually, and it is best if they do NOT begin 209 with the default answer prefix (currently AnSwEr). 210 211 labeled_ans_rule(name, width) # an alias for NAMED_ANS_RULE where width defaults to 20 if omitted. 212 213 NAMED_ANS_RULE(name, width) 214 NAMED_ANS_BOX(name, rows, cols) 215 NAMED_ANS_RADIO(name, value,label,) 216 NAMED_ANS_RADIO_EXTENSION(name, value,label) 217 NAMED_ANS_RADIO_BUTTONS(name,value1,label1,value2,label2,...) 218 check_box('-name' =>answer5,'-value' =>'statement3','-label' =>'I loved this course!' ) 219 NAMED_POP_UP_LIST($name, @list) # list consists of (value => tag, PR => "Product rule",...) 220 NAMED_POP_UP_LIST($name, [@list]) # list consists of a list of values (and each tag will be set to the corresponding value) 221 222 (Name is the name of the variable, value is the value given to the variable when this option is selected, 223 and label is the text printed next to the button or check box. Check box variables can have multiple values.) 224 225 NAMED_ANS_RADIO_BUTTONS creates a sequence of NAMED_ANS_RADIO and NAMED_ANS_RADIO_EXTENSION items which 226 are output either as an array or, in scalar context, as the array glued together with spaces. It is 227 usually easier to use this than to manually construct the radio buttons by hand. However, sometimes 228 extra flexibility is desiredin which case: 229 230 When entering radio buttons using the "NAMED" format, you should use NAMED_ANS_RADIO button for the first button 231 and then use NAMED_ANS_RADIO_EXTENSION for the remaining buttons. NAMED_ANS_RADIO requires a matching answer evalutor, 232 while NAMED_ANS_RADIO_EXTENSION does not. The name used for NAMED_ANS_RADIO_EXTENSION should match the name 233 used for NAMED_ANS_RADIO (and the associated answer evaluator). 234 235 236 The following method is defined in F<PG.pl> for entering the answer evaluators corresponding 237 to answer rules with automatically generated names. The answer evaluators are matched with the 238 answer rules in the order in which they appear on the page. 239 240 NAMED_ANS(name1 => ans_evaluator1, name2 => ans_evaluator2,...); 241 242 These auxiliary macros are defined in PG.pl 243 244 245 NEW_ANS_NAME( number ); # produces a new answer blank name from a number by adding a prefix (AnSwEr) 246 # and registers this name as an implicitly labeled answer 247 # Its use is paired with each answer evaluator being entered using ANS() 248 249 ANS_NUM_TO_NAME(number); # adds the prefix (AnSwEr) to the number, but does nothing else. 250 251 RECORD_ANS_NAME( name ); # records the order in which the answer blank is rendered 252 # This is called by all of the constructs above, but must 253 # be called explicitly if an input blank is constructed explictly 254 # using HTML code. 255 256 These are legacy macros: 257 258 ANS_RULE( number, width ); # equivalent to NAMED_ANS_RULE( NEW_ANS_NAME(number), width) 259 ANS_BOX( question_number,height, width ); # equivalent to NAMED_ANS_BOX( NEW_ANS_NAME(number), height, width) 260 ANS_RADIO( question_number, value,tag ); # equivalent to NAMED_ANS_RADIO( NEW_ANS_NAME(number), value,tag) 261 ANS_RADIO_OPTION( question_number, value,tag ); # equivalent to NAMED_ANS_RADIO_EXTENSION( ANS_NUM_TO_NAME(number), value,tag) 262 263 264 =cut 265 266 267 268 sub labeled_ans_rule { # syntactic sugar for NAMED_ANS_RULE 269 my($name,$col) = @_; 270 $col = 20 unless defined($col); 271 NAMED_ANS_RULE($name,$col); 272 } 273 274 sub NAMED_ANS_RULE { 275 my($name,$col) = @_; 276 my $answer_value = ''; 277 $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name}); 278 if ($answer_value =~ /\0/ ) { 279 my @answers = split("\0", $answer_value); 280 $answer_value = shift(@answers); # use up the first answer 281 $rh_sticky_answers->{$name}=\@answers; 282 # store the rest -- beacuse this stores to a main:; variable 283 # it must be evaluated at run time 284 $answer_value= '' unless defined($answer_value); 285 } elsif (ref($answer_value) eq 'ARRAY') { 286 my @answers = @{ $answer_value}; 287 $answer_value = shift(@answers); # use up the first answer 288 $rh_sticky_answers->{$name}=\@answers; 289 # store the rest -- beacuse this stores to a main:; variable 290 # it must be evaluated at run time 291 $answer_value= '' unless defined($answer_value); 292 } 293 294 $answer_value =~ tr/\\$@`//d; ## make sure student answers can not be interpolated by e.g. EV3 295 $answer_value =~ s/\s+/ /g; ## remove excessive whitespace from student answer 296 $name = RECORD_ANS_NAME($name); 297 298 my $tcol = $col/2 > 3 ? $col/2 : 3; ## get max 299 $tcol = $tcol < 40 ? $tcol : 40; ## get min 300 301 MODES( 302 TeX => "\\mbox{\\parbox[t]{${tcol}ex}{\\hrulefill}}", 303 Latex2HTML => qq!\\begin{rawhtml}<INPUT TYPE=TEXT SIZE=$col NAME=\"$name\" VALUE = \"\">\\end{rawhtml}!, 304 HTML => qq!<INPUT TYPE=TEXT SIZE=$col NAME="$name" VALUE="$answer_value">!. 305 qq!<INPUT TYPE=HIDDEN NAME="previous_$name" VALUE="$answer_value">! 306 ); 307 } 308 309 sub NAMED_ANS_RULE_OPTION { # deprecated 310 &NAMED_ANS_RULE_EXTENSION; 311 } 312 313 sub NAMED_ANS_RULE_EXTENSION { 314 my($name,$col) = @_; 315 my $answer_value = ''; 316 $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name}); 317 if ( defined( $rh_sticky_answers->{$name} ) ) { 318 $answer_value = shift( @{ $rh_sticky_answers->{$name} }); 319 $answer_value = '' unless defined($answer_value); 320 } 321 $answer_value =~ tr/\\$@`//d; ## make sure student answers can not be interpolated by e.g. EV3 322 $answer_value =~ s/\s+/ /g; ## remove excessive whitespace from student answer 323 my $tcol = $col/2 > 3 ? $col/2 : 3; ## get max 324 $tcol = $tcol < 40 ? $tcol : 40; ## get min 325 MODES( 326 TeX => "\\mbox{\\parbox[t]{${tcol}ex}{\\hrulefill}}", 327 Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=TEXT SIZE=$col NAME=\"$name\" VALUE = \"\">\n\\end{rawhtml}\n!, 328 HTML => qq!<INPUT TYPE=TEXT SIZE=$col NAME = "$name" VALUE = "$answer_value">!. 329 qq!<INPUT TYPE=HIDDEN NAME="previous_$name" VALUE = "$answer_value">! 330 ); 331 } 332 333 sub ANS_RULE { #deprecated 334 my($number,$col) = @_; 335 my $name = NEW_ANS_NAME($number); 336 NAMED_ANS_RULE($name,$col); 337 } 338 339 340 sub NAMED_ANS_BOX { 341 my($name,$row,$col) = @_; 342 $row = 10 unless defined($row); 343 $col = 80 unless defined($col); 344 $name = RECORD_ANS_NAME($name); 345 my $height = .07*$row; 346 my $answer_value = ''; 347 $answer_value = $inputs_ref->{$name} if defined( $inputs_ref->{$name} ); 348 $answer_value =~ tr/\\$@`//d; ## make sure student answers can not be interpolated by e.g. EV3 349 my $out = M3( 350 qq!\\vskip $height in \\hrulefill\\quad !, 351 qq!\\begin{rawhtml}<TEXTAREA NAME="$name" ROWS="$row" COLS="$col" 352 WRAP="VIRTUAL">$answer_value</TEXTAREA>\\end{rawhtml}!, 353 qq!<TEXTAREA NAME="$name" ROWS="$row" COLS="$col" 354 WRAP="VIRTUAL">$answer_value</TEXTAREA> 355 <INPUT TYPE=HIDDEN NAME="previous_$name" VALUE = "$answer_value"> 356 ! 357 ); 358 $out; 359 } 360 361 sub ANS_BOX { #deprecated 362 my($number,$row,$col) = @_; 363 my $name = NEW_ANS_NAME($number); 364 NAMED_ANS_BOX($name,$row,$col); 365 } 366 367 sub NAMED_ANS_RADIO { 368 my $name = shift; 369 my $value = shift; 370 my $tag =shift; 371 $name = RECORD_ANS_NAME($name); 372 my $checked = ''; 373 if ($value =~/^\%/) { 374 $value =~ s/^\%//; 375 $checked = 'CHECKED' 376 } 377 if (defined($inputs_ref->{$name}) ) { 378 if ($inputs_ref->{$name} eq $value) { 379 $checked = 'CHECKED' 380 } else { 381 $checked = ''; 382 } 383 384 } 385 386 MODES( 387 TeX => qq!\\item{$tag}\n!, 388 Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=RADIO NAME="$name" VALUE="$value" $checked>\\end{rawhtml}$tag!, 389 HTML => qq!<INPUT TYPE=RADIO NAME="$name" VALUE="$value" $checked>$tag! 390 ); 391 392 } 393 394 sub NAMED_ANS_RADIO_OPTION { #deprecated 395 &NAMED_ANS_RADIO_EXTENSION; 396 } 397 398 sub NAMED_ANS_RADIO_EXTENSION { 399 my $name = shift; 400 my $value = shift; 401 my $tag =shift; 402 403 404 my $checked = ''; 405 if ($value =~/^\%/) { 406 $value =~ s/^\%//; 407 $checked = 'CHECKED' 408 } 409 if (defined($inputs_ref->{$name}) ) { 410 if ($inputs_ref->{$name} eq $value) { 411 $checked = 'CHECKED' 412 } else { 413 $checked = ''; 414 } 415 416 } 417 418 MODES( 419 TeX => qq!\\item{$tag}\n!, 420 Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=RADIO NAME="$name" VALUE="$value" $checked>\\end{rawhtml}$tag!, 421 HTML => qq!<INPUT TYPE=RADIO NAME="$name" VALUE="$value" $checked>$tag! 422 ); 423 424 } 425 426 sub NAMED_ANS_RADIO_BUTTONS { 427 my $name =shift; 428 my $value = shift; 429 my $tag = shift; 430 431 432 my @out = (); 433 push(@out, NAMED_ANS_RADIO($name, $value,$tag)); 434 my @buttons = @_; 435 while (@buttons) { 436 $value = shift @buttons; $tag = shift @buttons; 437 push(@out, NAMED_ANS_RADIO_OPTION($name, $value,$tag)); 438 } 439 (wantarray) ? @out : join(" ",@out); 440 } 441 sub ANS_RADIO { 442 my $number = shift; 443 my $value = shift; 444 my $tag =shift; 445 my $name = NEW_ANS_NAME($number); 446 NAMED_ANS_RADIO($name,$value,$tag); 447 } 448 449 sub ANS_RADIO_OPTION { 450 my $number = shift; 451 my $value = shift; 452 my $tag =shift; 453 454 455 my $name = ANS_NUM_TO_NAME($number); 456 NAMED_ANS_RADIO_OPTION($name,$value,$tag); 457 } 458 sub ANS_RADIO_BUTTONS { 459 my $number =shift; 460 my $value = shift; 461 my $tag = shift; 462 463 464 my @out = (); 465 push(@out, ANS_RADIO($number, $value,$tag)); 466 my @buttons = @_; 467 while (@buttons) { 468 $value = shift @buttons; $tag = shift @buttons; 469 push(@out, ANS_RADIO_OPTION($number, $value,$tag)); 470 } 471 (wantarray) ? @out : join(" ",@out); 472 } 473 ############################################## 474 # contained_in( $elem, $array_reference or null separated string); 475 # determine whether element is equal 476 # ( in the sense of eq, not ==, ) to an element in the array. 477 ############################################## 478 sub contained_in { 479 my $element = shift; 480 my @input_list = @_; 481 my @output_list = (); 482 # Expand the list -- convert references to arrays to arrays 483 # Convert null separated strings to arrays 484 foreach my $item (@input_list ) { 485 if ($item =~ /\0/) { 486 push @output_list, split('\0', $item); 487 } elsif (ref($item) =~/ARRAY/) { 488 push @output_list, @{$item}; 489 } else { 490 push @output_list, $item; 491 } 492 } 493 494 my @match_list = grep {$element eq $_ } @output_list; 495 if ( @match_list ) { 496 return 1; 497 } else { 498 return 0; 499 } 500 } 501 502 ########################## 503 # If multiple boxes are checked then the $inputs_ref->{name }will be a null separated string 504 # or a reference to an array. 505 ########################## 506 507 sub NAMED_ANS_CHECKBOX { 508 my $name = shift; 509 my $value = shift; 510 my $tag =shift; 511 $name = RECORD_ANS_NAME($name); 512 513 my $checked = ''; 514 if ($value =~/^\%/) { 515 $value =~ s/^\%//; 516 $checked = 'CHECKED' 517 } 518 519 if (defined($inputs_ref->{$name}) ) { 520 if ( contained_in($value, $inputs_ref->{$name} ) ) { 521 $checked = 'CHECKED' 522 } 523 else { 524 $checked = ''; 525 } 526 527 } 528 529 MODES( 530 TeX => qq!\\item{$tag}\n!, 531 Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=CHECKBOX NAME="$name" VALUE="$value" $checked>\\end{rawhtml}$tag!, 532 HTML => qq!<INPUT TYPE=CHECKBOX NAME="$name" VALUE="$value" $checked>$tag! 533 ); 534 535 } 536 537 sub NAMED_ANS_CHECKBOX_OPTION { 538 my $name = shift; 539 my $value = shift; 540 my $tag =shift; 541 542 my $checked = ''; 543 if ($value =~/^\%/) { 544 $value =~ s/^\%//; 545 $checked = 'CHECKED' 546 } 547 548 if (defined($inputs_ref->{$name}) ) { 549 if ( contained_in($value, $inputs_ref->{$name}) ) { 550 $checked = 'CHECKED' 551 } 552 else { 553 $checked = ''; 554 } 555 556 } 557 558 MODES( 559 TeX => qq!\\item{$tag}\n!, 560 Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=CHECKBOX NAME="$name" VALUE="$value" $checked>\\end{rawhtml}$tag!, 561 HTML => qq!<INPUT TYPE=CHECKBOX NAME="$name" VALUE="$value" $checked>$tag! 562 ); 563 564 } 565 566 sub NAMED_ANS_CHECKBOX_BUTTONS { 567 my $name =shift; 568 my $value = shift; 569 my $tag = shift; 570 571 my @out = (); 572 push(@out, NAMED_ANS_CHECKBOX($name, $value,$tag)); 573 574 my @buttons = @_; 575 while (@buttons) { 576 $value = shift @buttons; $tag = shift @buttons; 577 push(@out, NAMED_ANS_CHECKBOX_OPTION($name, $value,$tag)); 578 } 579 580 (wantarray) ? @out : join(" ",@out); 581 } 582 583 sub ANS_CHECKBOX { 584 my $number = shift; 585 my $value = shift; 586 my $tag =shift; 587 my $name = NEW_ANS_NAME($number); 588 589 NAMED_ANS_CHECKBOX($name,$value,$tag); 590 } 591 592 sub ANS_CHECKBOX_OPTION { 593 my $number = shift; 594 my $value = shift; 595 my $tag =shift; 596 my $name = ANS_NUM_TO_NAME($number); 597 598 NAMED_ANS_CHECKBOX_OPTION($name,$value,$tag); 599 } 600 601 602 603 sub ANS_CHECKBOX_BUTTONS { 604 my $number =shift; 605 my $value = shift; 606 my $tag = shift; 607 608 my @out = (); 609 push(@out, ANS_CHECKBOX($number, $value, $tag)); 610 611 my @buttons = @_; 612 while (@buttons) { 613 $value = shift @buttons; $tag = shift @buttons; 614 push(@out, ANS_CHECKBOX_OPTION($number, $value,$tag)); 615 } 616 617 (wantarray) ? @out : join(" ",@out); 618 } 619 620 sub ans_rule { 621 my $len = shift; # gives the optional length of the answer blank 622 $len = 20 unless $len ; 623 my $name = NEW_ANS_NAME(inc_ans_rule_count()); 624 NAMED_ANS_RULE($name ,$len); 625 } 626 sub ans_rule_extension { 627 my $len = shift; 628 $len = 20 unless $len ; 629 my $name = NEW_ANS_NAME($$r_ans_rule_count); # don't update the answer name 630 NAMED_ANS_RULE($name ,$len); 631 } 632 sub ans_radio_buttons { 633 my $name = NEW_ANS_NAME(inc_ans_rule_count()); 634 my @radio_buttons = NAMED_ANS_RADIO_BUTTONS($name, @_); 635 636 if ($displayMode eq 'TeX') { 637 $radio_buttons[0] = "\n\\begin{itemize}\n" . $radio_buttons[0]; 638 $radio_buttons[$#radio_buttons] .= "\n\\end{itemize}\n"; 639 } 640 641 (wantarray) ? @radio_buttons: join(" ", @radio_buttons); 642 } 643 644 #added 6/14/2000 by David Etlinger 645 sub ans_checkbox { 646 my $name = NEW_ANS_NAME( inc_ans_rule_count() ); 647 my @checkboxes = NAMED_ANS_CHECKBOX_BUTTONS( $name, @_ ); 648 649 if ($displayMode eq 'TeX') { 650 $checkboxes[0] = "\n\\begin{itemize}\n" . $checkboxes[0]; 651 $checkboxes[$#checkboxes] .= "\n\\end{itemize}\n"; 652 } 653 654 (wantarray) ? @checkboxes: join(" ", @checkboxes); 655 } 656 657 658 ## define a version of ans_rule which will work inside TeX math mode or display math mode -- at least for tth mode. 659 ## This is great for displayed fractions. 660 ## This will not work with latex2HTML mode since it creates gif equations. 661 662 sub tex_ans_rule { 663 my $len = shift; 664 $len = 20 unless $len ; 665 my $name = NEW_ANS_NAME(inc_ans_rule_count()); 666 my $answer_rule = NAMED_ANS_RULE($name ,$len); # we don't want to create three answer rules in different modes. 667 my $out = MODES( 668 'TeX' => $answer_rule, 669 'Latex2HTML' => '\\fbox{Answer boxes cannot be placed inside typeset equations}', 670 'HTML_tth' => '\\begin{rawhtml} '. $answer_rule.'\\end{rawhtml}', 671 'HTML_dpng' => '\\fbox{Answer boxes cannot be placed inside typeset equations}', 672 'HTML' => $answer_rule 673 ); 674 675 $out; 676 } 677 sub tex_ans_rule_extension { 678 my $len = shift; 679 $len = 20 unless $len ; 680 my $name = NEW_ANS_NAME($$r_ans_rule_count); 681 my $answer_rule = NAMED_ANS_RULE($name ,$len); # we don't want to create three answer rules in different modes. 682 my $out = MODES( 683 'TeX' => $answer_rule, 684 'Latex2HTML' => '\fbox{Answer boxes cannot be placed inside typeset equations}', 685 'HTML_tth' => '\\begin{rawhtml} '. $answer_rule.'\\end{rawhtml}', 686 'HTML_dpng' => '\fbox{Answer boxes cannot be placed inside typeset equations}', 687 'HTML' => $answer_rule 688 ); 689 690 $out; 691 } 692 # still needs some cleanup. 693 sub NAMED_TEX_ANS_RULE { 694 my $name = shift; 695 my $len = shift; 696 $len = 20 unless $len ; 697 my $answer_rule = NAMED_ANS_RULE($name ,$len); # we don't want to create three answer rules in different modes. 698 my $out = MODES( 699 'TeX' => $answer_rule, 700 'Latex2HTML' => '\\fbox{Answer boxes cannot be placed inside typeset equations}', 701 'HTML_tth' => '\\begin{rawhtml} '. $answer_rule.'\\end{rawhtml}', 702 'HTML_dpng' => '\\fbox{Answer boxes cannot be placed inside typeset equations}', 703 'HTML' => $answer_rule 704 ); 705 706 $out; 707 } 708 sub NAMED_TEX_ANS_RULE_EXTENSION { 709 my $name = shift; 710 my $len = shift; 711 $len = 20 unless $len ; 712 my $answer_rule = NAMED_ANS_RULE_EXTENSION($name ,$len); # we don't want to create three answer rules in different modes. 713 my $out = MODES( 714 'TeX' => $answer_rule, 715 'Latex2HTML' => '\fbox{Answer boxes cannot be placed inside typeset equations}', 716 'HTML_tth' => '\\begin{rawhtml} '. $answer_rule.'\\end{rawhtml}', 717 'HTML_dpng' => '\fbox{Answer boxes cannot be placed inside typeset equations}', 718 'HTML' => $answer_rule 719 ); 720 721 $out; 722 } 723 sub ans_box { 724 my $row = shift; 725 my $col =shift; 726 $row = 5 unless $row; 727 $col = 80 unless $col; 728 my $name = NEW_ANS_NAME(inc_ans_rule_count()); 729 NAMED_ANS_BOX($name ,$row,$col); 730 } 731 732 #this is legacy code; use ans_checkbox instead 733 sub checkbox { 734 my %options = @_; 735 qq!<INPUT TYPE="checkbox" NAME="$options{'-name'}" VALUE="$options{'-value'}">$options{'-label'}! 736 } 737 738 739 sub NAMED_POP_UP_LIST { 740 my $name = shift; 741 my @list = @_; 742 if(ref($list[0]) eq 'ARRAY') { 743 my @list1 = @{$list[0]}; 744 @list = map { $_ => $_ } @list1; 745 } 746 $name = RECORD_ANS_NAME($name); # record answer name 747 my $answer_value = ''; 748 $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name}); 749 my $out = ""; 750 if ($displayMode eq 'HTML' or $displayMode eq 'HTML_tth' or 751 $displayMode eq 'HTML_dpng' or $displayMode eq 'HTML_img' or $displayMode eq 'HTML_jsMath' or $displayMode eq 'HTML_asciimath') { 752 $out = qq!<SELECT NAME = "$name" SIZE=1> \n!; 753 my $i; 754 foreach ($i=0; $i< @list; $i=$i+2) { 755 my $select_flag = ($list[$i] eq $answer_value) ? "SELECTED" : ""; 756 $out .= qq!<OPTION $select_flag VALUE ="$list[$i]" > $list[$i+1] </OPTION>\n!; 757 }; 758 $out .= " </SELECT>\n"; 759 } elsif ( $displayMode eq "Latex2HTML") { 760 $out = qq! \\begin{rawhtml}<SELECT NAME = "$name" SIZE=1> \\end{rawhtml} \n !; 761 my $i; 762 foreach ($i=0; $i< @list; $i=$i+2) { 763 my $select_flag = ($list[$i] eq $answer_value) ? "SELECTED" : ""; 764 $out .= qq!\\begin{rawhtml}<OPTION $select_flag VALUE ="$list[$i]" > $list[$i+1] </OPTION>\\end{rawhtml}\n!; 765 }; 766 $out .= " \\begin{rawhtml}</SELECT>\\end{rawhtml}\n"; 767 } elsif ( $displayMode eq "TeX") { 768 $out .= "\\fbox{?}"; 769 } 770 771 } 772 773 sub pop_up_list { 774 my @list = @_; 775 my $name = NEW_ANS_NAME(inc_ans_rule_count()); # get new answer name 776 NAMED_POP_UP_LIST($name, @list); 777 } 778 779 780 781 =head5 answer_matrix 782 783 Usage \[ \{ answer_matrix(rows,columns,width_of_ans_rule, @options) \} \] 784 785 Creates an array of answer blanks and passes it to display_matrix which returns 786 text which represents the matrix in TeX format used in math display mode. Answers 787 are then passed back to whatever answer evaluators you write at the end of the problem. 788 (note, if you have an m x n matrix, you will need mn answer evaluators, and they will be 789 returned to the evaluaters starting in the top left hand corner and proceed to the left 790 and then at the end moving down one row, just as you would read them.) 791 792 The options are passed on to display_matrix. 793 794 795 =cut 796 797 798 sub answer_matrix{ 799 my $m = shift; 800 my $n = shift; 801 my $width = shift; 802 my @options = @_; 803 my @array=(); 804 for( my $i = 0; $i < $m; $i+=1) 805 { 806 my @row_array = (); 807 808 for( my $i = 0; $i < $n; $i+=1) 809 { 810 push @row_array, ans_rule($width); 811 } 812 my $r_row_array = \@row_array; 813 push @array, $r_row_array; 814 } 815 # display_matrix hasn't been loaded into the cache safe compartment 816 # so we need to refer to the subroutine in this way to make 817 # sure that main is defined correctly. 818 my $ra_local_display_matrix=PG_restricted_eval(q!\&main::display_matrix!); 819 &$ra_local_display_matrix( \@array, @options ); 820 821 } 822 823 sub NAMED_ANS_ARRAY_EXTENSION{ 824 825 my $name = shift; 826 my $col = shift; 827 $col = 20 unless $col; 828 my $answer_value = ''; 829 830 $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name}); 831 if ($answer_value =~ /\0/ ) { 832 my @answers = split("\0", $answer_value); 833 $answer_value = shift(@answers); 834 $answer_value= '' unless defined($answer_value); 835 } elsif (ref($answer_value) eq 'ARRAY') { 836 my @answers = @{ $answer_value}; 837 $answer_value = shift(@answers); 838 $answer_value= '' unless defined($answer_value); 839 } 840 841 $answer_value =~ tr/\\$@`//d; ## make sure student answers can not be interpolated by e.g. EV3 842 MODES( 843 TeX => "\\mbox{\\parbox[t]{10pt}{\\hrulefill}}\\hrulefill\\quad ", 844 Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=TEXT SIZE=$col NAME=\"$name\" VALUE = \"\">\n\\end{rawhtml}\n!, 845 HTML => "<INPUT TYPE=TEXT SIZE=$col NAME=\"$name\" VALUE = \"$answer_value\">\n" 846 ); 847 } 848 849 sub ans_array{ 850 my $m = shift; 851 my $n = shift; 852 my $col = shift; 853 $col = 20 unless $col; 854 my $num = inc_ans_rule_count() ; 855 my $name = NEW_ANS_ARRAY_NAME($num,0,0); 856 my @options = @_; 857 my @array=(); 858 my $string; 859 my $answer_value = ""; 860 861 $array[0][0] = NAMED_ANS_RULE($name,$col); 862 863 for( my $i = 1; $i < $n; $i+=1) 864 { 865 $name = NEW_ANS_ARRAY_NAME_EXTENSION($num,0,$i); 866 $array[0][$i] = NAMED_ANS_ARRAY_EXTENSION($name,$col); 867 868 } 869 870 for( my $j = 1; $j < $m; $j+=1 ){ 871 872 for( my $i = 0; $i < $n; $i+=1) 873 { 874 $name = NEW_ANS_ARRAY_NAME_EXTENSION($num,$j,$i); 875 $array[$j][$i] = NAMED_ANS_ARRAY_EXTENSION($name,$col); 876 877 } 878 879 } 880 my $ra_local_display_matrix=PG_restricted_eval(q!\&main::display_matrix!); 881 &$ra_local_display_matrix( \@array, @options ); 882 883 } 884 885 sub ans_array_extension{ 886 my $m = shift; 887 my $n = shift; 888 my $col = shift; 889 $col = 20 unless $col; 890 my $num = PG_restricted_eval(q!$main::ans_rule_count!); 891 my @options = @_; 892 my $name; 893 my @array=(); 894 my $string; 895 my $answer_value = ""; 896 897 for( my $j = 0; $j < $m; $j+=1 ){ 898 899 for( my $i = 0; $i < $n; $i+=1) 900 { 901 $name = NEW_ANS_ARRAY_NAME_EXTENSION($num,$j,$i); 902 $array[$j][$i] = NAMED_ANS_ARRAY_EXTENSION($name,$col); 903 904 } 905 906 } 907 my $ra_local_display_matrix=PG_restricted_eval(q!\&main::display_matrix!); 908 &$ra_local_display_matrix( \@array, @options ); 909 910 } 911 912 913 # end answer blank macros 914 915 =head2 Hints and solutions macros 916 917 solution('text','text2',...); 918 SOLUTION('text','text2',...); # equivalent to TEXT(solution(...)); 919 920 hint('text', 'text2', ...); 921 HINT('text', 'text2',...); # equivalent to TEXT("$BR$HINT" . hint(@_) . "$BR") if hint(@_); 922 923 Solution prints its concatenated input when the check box named 'ShowSol' is set and 924 the time is after the answer date. The check box 'ShowSol' is visible only after the 925 answer date or when the problem is viewed by a professor. 926 927 $main::envir{'displaySolutionsQ'} is set to 1 when a solution is to be displayed. 928 929 Hints are shown only after the number of attempts is greater than $:showHint 930 ($main::showHint defaults to 1) and the check box named 'ShowHint' is set. The check box 931 'ShowHint' is visible only after the number of attempts is greater than $main::showHint. 932 933 $main::envir{'displayHintsQ'} is set to 1 when a hint is to be displayed. 934 935 936 =cut 937 938 939 940 # solution prints its input when $displaySolutionsQ is set. 941 # use as TEXT(solution("blah, blah"); 942 # \$solutionExists 943 # is passed to processProblem which displays a "show Solution" button 944 # when a solution is available for viewing 945 946 947 sub solution { 948 my @in = @_; 949 my $out = ''; 950 PG_restricted_eval(q!$main::solutionExists =1!); 951 if (PG_restricted_eval(q!$main::envir{'displaySolutionsQ'}!)) {$out = join(' ',@in);} 952 $out; 953 } 954 955 956 sub SOLUTION { 957 TEXT( solution(@_)) ; 958 } 959 960 961 962 sub hint { 963 my @in = @_; 964 my $out = ''; 965 966 PG_restricted_eval(q!$main::hintExists =1; 967 $main::numOfAttempts = 0 unless defined($main::numOfAttempts); 968 !); 969 970 if ($displayMode eq 'TeX') { 971 $out = ''; # do nothing since hints are not available for download 972 } elsif (($envir->{'displayHintsQ'}) and 973 PG_restricted_eval(q!($main::numOfAttempts >= $main::showHint)!)) 974 975 ## the second test above prevents a hint being shown if a doctored form is submitted 976 977 {$out = join(' ',@in);} # show hint 978 979 $out ; 980 } 981 982 983 sub HINT { 984 TEXT("$BR" . hint(@_) . "$BR") if hint(@_); 985 } 986 987 988 989 # End hints and solutions macros 990 ################################# 991 992 =head2 Comments to instructors 993 994 COMMENT('text','text2',...); 995 996 Takes the text to be lines of a comment to be shown only 997 in the Library Browser below the rendered problem. 998 999 The function COMMENT stores the needed html in the variable 1000 pgComment, which gets transfered to the flag 'comment' in PG_FLAGS. 1001 1002 =cut 1003 1004 # Add a comment which will display in the Library browser 1005 # Currently, the only output is html 1006 1007 sub COMMENT { 1008 my @in = @_; 1009 my $out = join("$BR", @in); 1010 my $out = '<div class=\"AuthorComment\">'.$out.'</div>'; 1011 1012 PG_restricted_eval(q!$main::pgComment = "!.$out.q!"!); 1013 return(''); 1014 } 1015 1016 ################################# 1017 # Produces a random number between $begin and $end with increment 1. 1018 # You do not have to worry about integer or floating point types. 1019 1020 =head2 Pseudo-random number generator 1021 1022 Usage: 1023 random(0,5,.1) # produces a random number between 0 and 5 in increments of .1 1024 non_zero_random(0,5,.1) # gives a non-zero random number 1025 1026 list_random(2,3,5,6,7,8,10) # produces random value from the list 1027 list_random(2,3, (5..8),10) # does the same thing 1028 1029 SRAND(seed) # resets the main random generator -- use very cautiously 1030 1031 1032 SRAND(time) will create a different problem everytime it is called. This makes it difficult 1033 to check the answers :-). 1034 1035 SRAND($envir->{'inputs_ref'}->{'key'} ) will create a different problem for each login session. 1036 This is probably what is desired. 1037 1038 =cut 1039 1040 1041 sub random { 1042 my ($begin, $end, $incr) = @_; 1043 $PG_random_generator->random($begin,$end,$incr); 1044 } 1045 1046 1047 sub non_zero_random { ##gives a non-zero random number 1048 my (@arguments)=@_; 1049 my $a=0; 1050 my $i=100; #safety counter 1051 while ($a==0 && ( 0 < $i-- ) ) { 1052 $a=random(@arguments); 1053 } 1054 $a; 1055 } 1056 1057 sub list_random { 1058 my(@li) = @_; 1059 return $li[random(1,scalar(@li))-1]; 1060 } 1061 1062 sub SRAND { # resets the main random generator -- use cautiously 1063 my $seed = shift; 1064 $PG_random_generator -> srand($seed); 1065 } 1066 1067 # display macros 1068 1069 =head2 Display Macros 1070 1071 These macros produce different output depending on the display mode being used to show 1072 the problem on the screen, or whether the problem is being converted to TeX to produce 1073 a hard copy output. 1074 1075 MODES ( TeX => "Output this in TeX mode", 1076 HTML => "output this in HTML mode", 1077 HTML_tth => "output this in HTML_tth mode", 1078 HTML_dpng => "output this in HTML_dpng mode", 1079 Latex2HTML => "output this in Latex2HTML mode", 1080 ) 1081 1082 TEX (tex_version, html_version) #obsolete 1083 1084 M3 (tex_version, latex2html_version, html_version) #obsolete 1085 1086 1087 1088 =cut 1089 1090 1091 sub TEX { 1092 my ($tex, $html ) = @_; 1093 MODES(TeX => $tex, HTML => $html, HTML_tth => $html, HTML_dpng => $html); 1094 } 1095 1096 1097 sub M3 { 1098 my($tex,$l2h,$html) = @_; 1099 MODES(TeX => $tex, Latex2HTML => $l2h, HTML => $html, HTML_tth => $html, HTML_dpng => $html); 1100 } 1101 1102 # MODES() is now table driven 1103 our %DISPLAY_MODE_FAILOVER = ( 1104 TeX => [], 1105 HTML => [], 1106 HTML_tth => [ "HTML", ], 1107 HTML_dpng => [ "HTML_tth", "HTML", ], 1108 HTML_jsMath => [ "HTML_dpng", "HTML_tth", "HTML", ], 1109 HTML_asciimath => [ "HTML_dpng", "HTML_tth", "HTML", ], 1110 # legacy modes -- these are not supported, but some problems might try to 1111 # set the display mode to one of these values manually and some macros may 1112 # provide rendered versions for these modes but not the one we want. 1113 Latex2HTML => [ "TeX", "HTML", ], 1114 HTML_img => [ "HTML_dpng", "HTML_tth", "HTML", ], 1115 ); 1116 1117 # This replaces M3. You can add new modes at will to this one. 1118 sub MODES { 1119 my %options = @_; 1120 1121 # is a string supplied for the current display mode? if so, return it 1122 return $options{$displayMode} if defined $options{$displayMode}; 1123 1124 # otherwise, fail over to backup modes 1125 my @backup_modes; 1126 if (exists $DISPLAY_MODE_FAILOVER{$displayMode}) { 1127 @backup_modes = @{$DISPLAY_MODE_FAILOVER{$displayMode}}; 1128 foreach my $mode (@backup_modes) { 1129 return $options{$mode} if defined $options{$mode}; 1130 } 1131 } 1132 die "ERROR in defining MODES: neither display mode $displayMode nor", 1133 " any fallback modes (", join(", ", @backup_modes), ") supplied.\n"; 1134 } 1135 1136 # end display macros 1137 1138 1139 =head2 Display constants 1140 1141 @ALPHABET ALPHABET() capital letter alphabet -- ALPHABET[0] = 'A' 1142 $PAR PAR() paragraph character (\par or <p>) 1143 $BR BR() line break character 1144 $LQ LQ() left double quote 1145 $RQ RQ() right double quote 1146 $BM BM() begin math 1147 $EM EM() end math 1148 $BDM BDM() begin display math 1149 $EDM EDM() end display math 1150 $LTS LTS() strictly less than 1151 $GTS GTS() strictly greater than 1152 $LTE LTE() less than or equal 1153 $GTE GTE() greater than or equal 1154 $BEGIN_ONE_COLUMN BEGIN_ONE_COLUMN() begin one-column mode 1155 $END_ONE_COLUMN END_ONE_COLUMN() end one-column mode 1156 $SOL SOLUTION_HEADING() solution headline 1157 $SOLUTION SOLUTION_HEADING() solution headline 1158 $HINT HINT_HEADING() hint headline 1159 $US US() underscore character 1160 $SPACE SPACE() space character (tex and latex only) 1161 $BBOLD BBOLD() begin bold typeface 1162 $EBOLD EBOLD() end bold typeface 1163 $BITALIC BITALIC() begin italic typeface 1164 $EITALIC EITALIC() end italic typeface 1165 $BCENTER BCENTER() begin centered environment 1166 $ECENTER ECENTER() end centered environment 1167 $HR HR() horizontal rule 1168 $LBRACE LBRACE() left brace 1169 $LB LB () left brace 1170 $RBRACE RBRACE() right brace 1171 $RB RB () right brace 1172 $DOLLAR DOLLAR() a dollar sign 1173 $PERCENT PERCENT() a percent sign 1174 $CARET CARET() a caret sign 1175 $PI PI() the number pi 1176 $E E() the number e 1177 1178 =cut 1179 1180 1181 1182 1183 1184 # A utility variable. Notice that "B"=$ALPHABET[1] and 1185 # "ABCD"=@ALPHABET[0..3]. 1186 1187 sub ALPHABET { 1188 ('A'..'ZZ')[@_]; 1189 } 1190 1191 ############################################################### 1192 # Some constants which are different in tex and in HTML 1193 # The order of arguments is TeX, Latex2HTML, HTML 1194 # Adopted Davide Cervone's improvements to PAR, LTS, GTS, LTE, GTE, LBRACE, RBRACE, LB, RB. 7-14-03 AKP 1195 sub PAR { MODES( TeX => '\\par ', Latex2HTML => '\\begin{rawhtml}<P>\\end{rawhtml}', HTML => '<P>'); }; 1196 sub BR { MODES( TeX => '\\par\\noindent ', Latex2HTML => '\\begin{rawhtml}<BR>\\end{rawhtml}', HTML => '<BR>'); }; 1197 # Alternate definition of BR which is slightly more flexible and gives more white space in printed output 1198 # which looks better but kills more trees. 1199 #sub BR { MODES( TeX => '\\leavevmode\\\\', Latex2HTML => '\\begin{rawhtml}<BR>\\end{rawhtml}', HTML => '<BR>'); }; 1200 sub LQ { MODES( TeX => "``", Latex2HTML => '"', HTML => '"' ); }; 1201 sub RQ { MODES( TeX => "''", Latex2HTML => '"', HTML => '"' ); }; 1202 sub BM { MODES(TeX => '\\(', Latex2HTML => '\\(', HTML => ''); }; # begin math mode 1203 sub EM { MODES(TeX => '\\)', Latex2HTML => '\\)', HTML => ''); }; # end math mode 1204 sub BDM { MODES(TeX => '\\[', Latex2HTML => '\\[', HTML => '<P ALIGN=CENTER>'); }; #begin displayMath mode 1205 sub EDM { MODES(TeX => '\\]', Latex2HTML => '\\]', HTML => '</P>'); }; #end displayMath mode 1206 sub LTS { MODES(TeX => '<', Latex2HTML => '\\lt ', HTML => '<', HTML_tth => '<' ); }; 1207 sub GTS { MODES(TeX => '>', Latex2HTML => '\\gt ', HTML => '>', HTML_tth => '>' ); }; 1208 sub LTE { MODES(TeX => '\\le ', Latex2HTML => '\\le ', HTML => '<U><</U>', HTML_tth => '\\le ' ); }; 1209 sub GTE { MODES(TeX => '\\ge ', Latex2HTML => '\\ge ', HTML => '<U>></U>', HTML_tth => '\\ge ' ); }; 1210 sub BEGIN_ONE_COLUMN { MODES(TeX => " \\end{multicols}\n", Latex2HTML => " ", HTML => " "); }; 1211 sub END_ONE_COLUMN { MODES(TeX => 1212 " \\begin{multicols}{2}\n\\columnwidth=\\linewidth\n", 1213 Latex2HTML => ' ', HTML => ' '); 1214 1215 }; 1216 sub SOLUTION_HEADING { MODES( TeX => '\\par {\\bf Solution:}', 1217 Latex2HTML => '\\par {\\bf Solution:}', 1218 HTML => '<P><B>Solution:</B>'); 1219 }; 1220 sub HINT_HEADING { MODES( TeX => "\\par {\\bf Hint:}", Latex2HTML => "\\par {\\bf Hint:}", HTML => "<P><B>Hint:</B>"); }; 1221 sub US { MODES(TeX => '\\_', Latex2HTML => '\\_', HTML => '_');}; # underscore, e.g. file${US}name 1222 sub SPACE { MODES(TeX => '\\ ', Latex2HTML => '\\ ', HTML => ' ');}; # force a space in latex, doesn't force extra space in html 1223 sub BBOLD { MODES(TeX => '{\\bf ', Latex2HTML => '{\\bf ', HTML => '<B>'); }; 1224 sub EBOLD { MODES( TeX => '}', Latex2HTML => '}',HTML => '</B>'); }; 1225 sub BITALIC { MODES(TeX => '{\\it ', Latex2HTML => '{\\it ', HTML => '<I>'); }; 1226 sub EITALIC { MODES(TeX => '} ', Latex2HTML => '} ', HTML => '</I>'); }; 1227 sub BCENTER { MODES(TeX => '\\begin{center} ', Latex2HTML => ' \\begin{rawhtml} <div align="center"> \\end{rawhtml} ', HTML => '<div align="center">'); }; 1228 sub ECENTER { MODES(TeX => '\\end{center} ', Latex2HTML => ' \\begin{rawhtml} </div> \\end{rawhtml} ', HTML => '</div>'); }; 1229 sub HR { MODES(TeX => '\\par\\hrulefill\\par ', Latex2HTML => '\\begin{rawhtml} <HR> \\end{rawhtml}', HTML => '<HR>'); }; 1230 sub LBRACE { MODES( TeX => '\{', Latex2HTML => '\\lbrace', HTML => '{' , HTML_tth=> '\\lbrace' ); }; 1231 sub RBRACE { MODES( TeX => '\}', Latex2HTML => '\\rbrace', HTML => '}' , HTML_tth=> '\\rbrace',); }; 1232 sub LB { MODES( TeX => '\{', Latex2HTML => '\\lbrace', HTML => '{' , HTML_tth=> '\\lbrace' ); }; 1233 sub RB { MODES( TeX => '\}', Latex2HTML => '\\rbrace', HTML => '}' , HTML_tth=> '\\rbrace',); }; 1234 sub DOLLAR { MODES( TeX => '\\$', Latex2HTML => '\\$', HTML => '$' ); }; 1235 sub PERCENT { MODES( TeX => '\\%', Latex2HTML => '\\%', HTML => '%' ); }; 1236 sub CARET { MODES( TeX => '\\verb+^+', Latex2HTML => '\\verb+^+', HTML => '^' ); }; 1237 sub PI {4*atan2(1,1);}; 1238 sub E {exp(1);}; 1239 1240 ############################################################### 1241 ## Evaluation macros 1242 1243 1244 =head2 TEXT macros 1245 1246 Usage: 1247 TEXT(@text); 1248 1249 This is the simplest way to print text from a problem. The strings in the array C<@text> are concatenated 1250 with spaces between them and printed out in the text of the problem. The text is not processed in any other way. 1251 C<TEXT> is defined in PG.pl. 1252 1253 Usage: 1254 BEGIN_TEXT 1255 text..... 1256 END_TEXT 1257 1258 This is the most common way to enter text into the problem. All of the text between BEGIN_TEXT and END_TEXT 1259 is processed by the C<EV3> macro described below and then printed using the C<TEXT> command. The two key words 1260 must appear on lines by themselves. The preprocessing that makes this construction work is done in F<PGtranslator.pm>. 1261 See C<EV3> below for details on the processing. 1262 1263 1264 =cut 1265 1266 =head2 Evaluation macros 1267 1268 =head3 EV3 1269 1270 TEXT(EV3("This is a formulat \( \int_0^5 x^2 \, dx \) "); 1271 TEXT(EV3(@text)); 1272 1273 TEXT(EV3(<<'END_TEXT')); 1274 text stuff... 1275 END_TEXT 1276 1277 1278 The BEGIN_TEXT/END_TEXT construction is translated into the construction above by PGtranslator.pm. END_TEXT must appear 1279 on a line by itself and be left justified. (The << construction is known as a "here document" in UNIX and in PERL.) 1280 1281 The single quotes around END_TEXT mean that no automatic interpolation of variables takes place in the text. 1282 Using EV3 with strings which have been evaluated by double quotes may lead to unexpected results. 1283 1284 1285 The evaluation macro E3 first evaluates perl code inside the braces: C<\{ code \}>. 1286 Any perl statment can be put inside the braces. The 1287 result of the evaluation (i.e. the last statement evaluated) replaces the C<\{ code \}> construction. 1288 1289 Next interpolation of all variables (e.g. C<$var or @array> ) is performed. 1290 1291 Then mathematical formulas in TeX are evaluated within the 1292 C<\( tex math mode \)> and 1293 C<\[ tex display math mode \] > 1294 constructions, in that order: 1295 1296 =head3 FEQ 1297 1298 FEQ($string); # processes and outputs the string 1299 1300 1301 The mathematical formulas are run through the macro C<FEQ> (Format EQuations) which performs 1302 several substitutions (see below). 1303 In C<HTML_tth> mode the resulting code is processed by tth to obtain an HTML version 1304 of the formula. (In the future processing by WebEQ may be added here as another option.) 1305 The Latex2HTML mode does nothing 1306 at this stage; it creates the entire problem before running it through 1307 TeX and creating the GIF images of the equations. 1308 1309 The resulting string is output (and usually fed into TEXT to be printed in the problem). 1310 1311 Usage: 1312 1313 $string2 = FEQ($string1); 1314 1315 This is a filter which is used to format equations by C<EV2> and C<EV3>, but can also be used on its own. It is best 1316 understood with an example. 1317 1318 $string1 = "${a}x^2 + ${b}x + {$c:%.1f}"; $a = 3;, $b = -2; $c = -7.345; 1319 1320 when interpolated becomes: 1321 1322 $string1 = '3x^2 + -2x + {-7.345:%0.1f} 1323 1324 FEQ first changes the number of decimal places displayed, so that the last term becomes -7.3 Then it removes the 1325 extraneous plus and minus signs, so that the final result is what you want: 1326 1327 $string2 = '3x^2 - 2x -7.3'; 1328 1329 (The %0.1f construction 1330 is the same formatting convention used by Perl and nearly identical to the one used by the C printf statement. Some common 1331 usage: %0.3f 3 decimal places, fixed notation; %0.3e 3 significant figures exponential notation; %0.3g uses either fixed 1332 or exponential notation depending on the size of the number.) 1333 1334 Two additional legacy formatting constructions are also supported: 1335 1336 C<?{$c:%0.3f} > will give a number with 3 decimal places and a negative 1337 sign if the number is negative, no sign if the number is positive. 1338 1339 C<!{$c:%0.3f}> determines the sign and prints it 1340 whether the number is positive or negative. 1341 1342 =head3 EV2 1343 1344 TEXT(EV2(@text)); 1345 1346 TEXT(EV2(<<END_OF_TEXT)); 1347 text stuff... 1348 END_OF_TEXT 1349 1350 This is a precursor to EV3. In this case the constants are interpolated first, before the evaluation of the \{ ...code...\} 1351 construct. This can lead to unexpected results. For example C<\{ join(" ", @text) \}> with C<@text = ("Hello","World");> becomes, 1352 after interpolation, C<\{ join(" ",Hello World) \}> which then causes an error when evaluated because Hello is a bare word. 1353 C<EV2> can still be useful if you allow for this, and in particular it works on double quoted strings, which lead to 1354 unexpected results with C<EV3>. Using single quoted strings with C<EV2> may lead to unexpected results. 1355 1356 The unexpected results have to do with the number of times backslashed constructions have to be escaped. It is quite messy. For 1357 more details get a good Perl book and then read the code. :-) 1358 1359 1360 1361 1362 =cut 1363 1364 1365 sub ev_substring { 1366 my $string = shift; 1367 my $start_delim = shift; 1368 my $end_delim = shift; 1369 my $actionRef = shift; 1370 my ($eval_out,$PG_eval_errors,$PG_full_error_report)=(); 1371 my $out = ""; 1372 # 1373 # DPVC -- 2001/12/07 1374 # original "while ($string)" fails to process the string "0" correctly 1375 # 1376 while ($string ne "") { 1377 # 1378 # end DPVC 1379 # 1380 if ($string =~ /\Q$start_delim\E/s) { 1381 #print "$start_delim $end_delim evaluating_substring=$string<BR>"; 1382 $string =~ s/^(.*?)\Q$start_delim\E//s; # get string up to next \{ ---treats string as a single line, ignoring returns 1383 $out .= $1; 1384 #print "$start_delim $end_delim substring_out=$out<BR>"; 1385 $string =~ s/^(.*?)\Q$end_delim\E//s; # get perl code up to \} ---treats string as a single line, ignoring returns 1386 #print "$start_delim $end_delim evaluate_string=$1<BR>"; 1387 ($eval_out,$PG_eval_errors,$PG_full_error_report) = &$actionRef($1); 1388 $eval_out = "$start_delim $eval_out $end_delim" if $PG_full_error_report; 1389 $out = $out . $eval_out; 1390 #print "$start_delim $end_delim new substring_out=$out<BR><p><BR>"; 1391 $out .="$PAR ERROR $0 in ev_substring, PGbasicmacros.pl:$PAR <PRE> $@ </PRE>$PAR" if $@; 1392 } 1393 else { 1394 $out .= $string; # flush the last part of the string 1395 last; 1396 } 1397 1398 } 1399 $out; 1400 } 1401 sub safe_ev { 1402 my ($out,$PG_eval_errors,$PG_full_error_report) = &old_safe_ev; # process input by old_safe_ev first 1403 $out =~s/\\/\\\\/g; # protect any new backslashes introduced. 1404 ($out,$PG_eval_errors,$PG_full_error_report) 1405 } 1406 1407 sub old_safe_ev { 1408 my $in = shift; 1409 my ($out,$PG_eval_errors,$PG_full_error_report) = PG_restricted_eval("$in;"); 1410 # the addition of the ; seems to provide better error reporting 1411 if ($PG_eval_errors) { 1412 my @errorLines = split("\n",$PG_eval_errors); 1413 #$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> "; 1414 warn " ERROR in old_safe_ev, PGbasicmacros.pl: <PRE> 1415 ## There is an error occuring inside evaluation brackets \\{ ...code... \\} 1416 ## somewhere in an EV2 or EV3 or BEGIN_TEXT block. 1417 ## Code evaluated: 1418 ## $in 1419 ##" .join("\n ", @errorLines). " 1420 ##</PRE>$BR 1421 "; 1422 $out ="$PAR $BBOLD $in $EBOLD $PAR"; 1423 1424 1425 } 1426 1427 ($out,$PG_eval_errors,$PG_full_error_report); 1428 } 1429 1430 sub FEQ { # Format EQuations 1431 my $in = shift; 1432 # formatting numbers -- the ?{} and !{} constructions 1433 $in =~s/\?\s*\{([.\-\$\w\d]+):?([%.\da-z]*)\}/${ \( &sspf($1,$2) )}/g; 1434 $in =~s/\!\s*\{([.\-\$\w\d]+):?([%.\da-z]*)\}/${ \( &spf($1,$2) )}/g; 1435 1436 # more formatting numbers -- {number:format} constructions 1437 $in =~ s/\{(\s*[\+\-\d\.]+[eE]*[\+\-]*\d*):(\%\d*.\d*\w)}/${ \( &spf($1,$2) )}/g; 1438 $in =~ s/\+\s*\-/ - /g; 1439 $in =~ s/\-\s*\+/ - /g; 1440 $in =~ s/\+\s*\+/ + /g; 1441 $in =~ s/\-\s*\-/ + /g; 1442 $in; 1443 } 1444 1445 #sub math_ev3 { 1446 # my $in = shift; #print "in=$in<BR>"; 1447 # my ($out,$PG_eval_errors,$PG_full_error_report); 1448 # $in = FEQ($in); 1449 # $in =~ s/%/\\%/g; # % causes trouble in TeX and HTML_tth it usually (always?) indicates an error, not comment 1450 # return("$BM $in $EM") unless ($displayMode eq 'HTML_tth'); 1451 # $in = "\\(" . $in . "\\)"; 1452 # $out = tth($in); 1453 # ($out,$PG_eval_errors,$PG_full_error_report); 1454 # 1455 #} 1456 # 1457 #sub display_math_ev3 { 1458 # my $in = shift; #print "in=$in<BR>"; 1459 # my ($out,$PG_eval_errors,$PG_full_error_report); 1460 # $in = FEQ($in); 1461 # $in =~ s/%/\\%/g; 1462 # return("$main::BDM $in $main::EDM") unless $displayMode eq 'HTML_tth' ; 1463 # $in = "\\[" . $in . "\\]"; 1464 # $out =tth($in); 1465 # ($out,$PG_eval_errors,$PG_full_error_report); 1466 #} 1467 1468 sub math_ev3 { 1469 my $in = shift; 1470 return general_math_ev3($in, "inline"); 1471 } 1472 1473 sub display_math_ev3 { 1474 my $in = shift; 1475 return general_math_ev3($in, "display"); 1476 } 1477 1478 sub general_math_ev3 { 1479 my $in = shift; 1480 my $mode = shift || "inline"; 1481 1482 $in = FEQ($in); # Format EQuations 1483 $in =~ s/%/\\%/g; # avoid % becoming TeX comments 1484 1485 ## remove leading and trailing spaces so that HTML mode will 1486 ## not include unwanted spaces as per Davide Cervone. 1487 $in =~ s/^\s+//; 1488 $in =~ s/\s+$//; 1489 ## If it ends with a backslash, there should be another space 1490 ## at the end 1491 if($in =~ /\\$/) { $in .= ' ';} 1492 1493 # some modes want the delimiters, some don't 1494 my $in_delim = $mode eq "inline" 1495 ? "\\($in\\)" 1496 : "\\[$in\\]"; 1497 1498 my $out; 1499 if($displayMode eq "HTML_tth") { 1500 $out = tth($in_delim); 1501 ## remove leading and trailing spaces as per Davide Cervone. 1502 $out =~ s/^\s+//; 1503 $out =~ s/\s+$//; 1504 } elsif ($displayMode eq "HTML_dpng") { 1505 # for jj's version of ImageGenerator 1506 $out = $envir->{'imagegen'}->add($in_delim); 1507 # for my version of ImageGenerator 1508 #$out = $envir->{'imagegen'}->add($in, $mode); 1509 } elsif ($displayMode eq "HTML_img") { 1510 $out = math2img($in, $mode); 1511 } elsif ($displayMode eq "HTML_jsMath") { 1512 $in =~ s/</</g; $in =~ s/>/>/g; 1513 $out = '<SPAN CLASS="math">'.$in.'</SPAN>' if $mode eq "inline"; 1514 $out = '<DIV CLASS="math">'.$in.'</DIV>' if $mode eq "display"; 1515 } elsif ($displayMode eq "HTML_asciimath") { 1516 $out = "`$in`" if $mode eq "inline"; 1517 $out = '<DIV ALIGN="CENTER">`'.$in.'`</DIV>' if $mode eq "display"; 1518 } else { 1519 $out = "\\($in\\)" if $mode eq "inline"; 1520 $out = "\\[$in\\]" if $mode eq "display"; 1521 } 1522 return $out; 1523 } 1524 1525 sub EV2 { 1526 my $string = join(" ",@_); 1527 # evaluate code inside of \{ \} (no nesting allowed) 1528 $string = ev_substring($string,"\\{","\\}",\&old_safe_ev); 1529 $string = ev_substring($string,"\\<","\\>",\&old_safe_ev); 1530 $string = ev_substring($string,"\\(","\\)",\&math_ev3); 1531 $string = ev_substring($string,"\\[","\\]",\&display_math_ev3); 1532 # macros for displaying math 1533 $string =~ s/\\\(/$BM/g; 1534 $string =~ s/\\\)/$EM/g; 1535 $string =~ s/\\\[/$BDM/g; 1536 $string =~ s/\\\]/$EDM/g; 1537 $string; 1538 } 1539 1540 sub EV3{ 1541 my $string = join(" ",@_); 1542 # evaluate code inside of \{ \} (no nesting allowed) 1543 $string = ev_substring($string,"\\\\{","\\\\}",\&safe_ev); # handles \{ \} in single quoted strings of PG files 1544 # interpolate variables 1545 my ($evaluated_string,$PG_eval_errors,$PG_full_errors) = PG_restricted_eval("<<END_OF_EVALUATION_STRING\n$string\nEND_OF_EVALUATION_STRING\n"); 1546 if ($PG_eval_errors) { 1547 my @errorLines = split("\n",$PG_eval_errors); 1548 $string =~ s/</</g; $string =~ s/>/>/g; 1549 $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> "; 1550 $@=""; 1551 } 1552 $string = $evaluated_string; 1553 $string = ev_substring($string,"\\(","\\)",\&math_ev3); 1554 $string = ev_substring($string,"\\[","\\]",\&display_math_ev3); 1555 $string; 1556 } 1557 1558 sub EV4{ 1559 if ($displayMode eq "HTML_dpng") { 1560 my $string = join(" ",@_); 1561 my ($evaluated_string,$PG_eval_errors,$PG_full_errors) = PG_restricted_eval("<<END_OF_EVALUATION_STRING\n$string\nEND_OF_EVALUATION_STRING\n"); 1562 if ($PG_eval_errors) { 1563 my @errorLines = split("\n",$PG_eval_errors); 1564 $string =~ s/</</g; $string =~ s/>/>/g; 1565 $evaluated_string = "<PRE>$PAR % ERROR in $0:EV3, PGbasicmacros.pl:". 1566 "$PAR % There is an error occuring in the following code:$BR ". 1567 "$string $BR % $BR % $errorLines[0]\n % $errorLines[1]$BR ". 1568 "% $BR % $BR </PRE> "; 1569 } 1570 $string = $evaluated_string; 1571 $string = $envir{'imagegen'}->add($string); 1572 $string; 1573 } else { 1574 EV3(@_); 1575 } 1576 } 1577 1578 1579 =head2 Formatting macros 1580 1581 beginproblem() # generates text listing number and the point value of 1582 # the problem. It will also print the file name containing 1583 # the problem for users listed in the PRINT_FILE_NAMES_FOR PG_environment 1584 # variable. 1585 OL(@array) # formats the array as an Ordered List ( <OL> </OL> ) enumerated by letters. 1586 1587 htmlLink($url, $text) 1588 # Places a reference to the URL with the specified text in the problem. 1589 # A common usage is \{ htmlLink(alias('prob1_help.html') \}, 'for help') 1590 # where alias finds the full address of the prob1_help.html file in the same directory 1591 # as the problem file 1592 appletLink($url, $parameters) 1593 # For example 1594 # appletLink(q! archive="http: //webwork.math.rochester.edu/gage/xFunctions/xFunctions.zip" 1595 code="xFunctionsLauncher.class" width=100 height=14!, 1596 " parameter text goes here") 1597 # will link to xFunctions. 1598 1599 low level: 1600 1601 spf($number, $format) # prints the number with the given format 1602 sspf($number, $format) # prints the number with the given format, always including a sign. 1603 nicestring($coefficients, $terms) # print a linear combinations of terms using coefficients 1604 nicestring($coefficients) # uses the coefficients to make a polynomial 1605 # For example 1606 # nicestring([1,-2, 0]) produces 'x^2-2x' 1607 # nicestring([2,0,-1],['', 't', 't^2']) produces '2-t^2' 1608 protect_underbar($string) # protects the underbar (class_name) in strings which may have to pass through TeX. 1609 1610 =cut 1611 1612 sub beginproblem { 1613 my $out = ""; 1614 my $problemValue = $envir->{problemValue}; 1615 my $fileName = $envir->{fileName}; 1616 my $probNum = $envir->{probNum}; 1617 my $TeXFileName = protect_underbar($envir->{fileName}); 1618 my $l2hFileName = protect_underbar($envir->{fileName}); 1619 my %inlist; 1620 my $points ='pts'; 1621 1622 $points = 'pt' if $problemValue == 1; 1623 ## Prepare header for the problem 1624 grep($inlist{$_}++,@{ $envir->{'PRINT_FILE_NAMES_FOR'} }); 1625 if ( defined($inlist{$envir->{studentLogin}}) and ($inlist{$envir->{studentLogin}} > 0) ) { 1626 $out = &M3("{\\bf ${probNum}. {\\footnotesize ($problemValue $points) $TeXFileName}}\\newline ", 1627 " \\begin{rawhtml} ($problemValue $points) <B>$l2hFileName</B><BR>\\end{rawhtml}", 1628 "($problemValue $points) <B>$fileName</B><BR>" 1629 ) if ($problemValue ne ""); 1630 } else { 1631 $out = &M3("{\\bf ${probNum}.} ($problemValue $points) ", 1632 "($problemValue $points) ", 1633 "($problemValue $points) " 1634 ) if ($problemValue ne ""); 1635 } 1636 $out .= MODES(%{main::PG_restricted_eval(q!$main::problemPreamble!)}); 1637 $out; 1638 1639 } 1640 1641 sub nicestring { 1642 my($thingy) = shift; 1643 my(@coefs) = @{$thingy}; 1644 my $n = scalar(@coefs); 1645 $thingy = shift; 1646 my(@others); 1647 if(defined($thingy)) { 1648 @others = @{$thingy}; 1649 } else { 1650 my($j); 1651 for $j (1..($n-2)) { 1652 $others[$j-1] = "x^".($n-$j); 1653 } 1654 if($n>=2) { $others[$n-2] = "x";} 1655 $others[$n-1] = ""; 1656 } 1657 my($j, $k)=(0,0); 1658 while(($k<$n) && ($coefs[$k]==0)) {$k++;} 1659 if($k==$n) {return("0");} 1660 my $ans; 1661 if($coefs[$k]==1) {$ans = ($others[$k]) ? "$others[$k]" : "1";} 1662 elsif($coefs[$k]== -1) {$ans = ($others[$k]) ? "- $others[$k]" : "-1"} 1663 else { $ans = "$coefs[$k] $others[$k]";} 1664 $k++; 1665 for $j ($k..($n-1)) { 1666 if($coefs[$j] != 0) { 1667 if($coefs[$j] == 1) { 1668 $ans .= ($others[$j]) ? "+ $others[$j]" : "+ 1"; 1669 } elsif($coefs[$j] == -1) { 1670 $ans .= ($others[$j]) ? "- $others[$j]" : "-1"; 1671 } else { 1672 $ans .= "+ $coefs[$j] $others[$j]"; 1673 } 1674 } 1675 } 1676 return($ans); 1677 } 1678 1679 # kludge to clean up path names 1680 ## allow underscore character in set and section names and also allows line breaks at / 1681 sub protect_underbar { 1682 my $in = shift; 1683 if ($displayMode eq 'TeX') { 1684 1685 $in =~ s|_|\\\_|g; 1686 $in =~ s|/|\\\-/|g; # allows an optional hyphenation of the path (in tex) 1687 } 1688 $in; 1689 } 1690 1691 1692 # An example of a macro which prints out a list (with letters) 1693 sub OL { 1694 my(@array) = @_; 1695 my $i = 0; 1696 my @alpha = ('A'..'Z', 'AA'..'ZZ'); 1697 my $letter; 1698 my $out= &M3( 1699 "\\begin{enumerate}\n", 1700 " \\begin{rawhtml} <OL TYPE=\"A\" VALUE=\"1\"> \\end{rawhtml} ", 1701 # kludge to fix IE/CSS problem 1702 #"<OL TYPE=\"A\" VALUE=\"1\">\n" 1703 "<BLOCKQUOTE>\n" 1704 ) ; 1705 my $elem; 1706 foreach $elem (@array) { 1707 $letter = shift @alpha; 1708 $out .= MODES( 1709 TeX=> "\\item[$ALPHABET[$i].] $elem\n", 1710 Latex2HTML=> " \\begin{rawhtml} <LI> \\end{rawhtml} $elem ", 1711 #HTML=> "<LI> $elem\n", 1712 HTML=> "<br /> <b>$letter.</b> $elem\n", 1713 #HTML_dpng=> "<LI> $elem <br /> <br /> \n" 1714 HTML_dpng=> "<br /> <b>$letter.</b> $elem \n" 1715 ); 1716 $i++; 1717 } 1718 $out .= &M3( 1719 "\\end{enumerate}\n", 1720 " \\begin{rawhtml} </OL>\n \\end{rawhtml} ", 1721 #"</OL>\n" 1722 "</BLOCKQUOTE>\n" 1723 ) ; 1724 } 1725 1726 sub htmlLink { 1727 my $url = shift; 1728 my $text = shift; 1729 my $options = shift; 1730 $options = "" unless defined($options); 1731 return "$BBOLD\[ broken link: $text \] $EBOLD" unless defined($url); 1732 M3( "{\\bf \\underline{$text}}", 1733 "\\begin{rawhtml}<A HREF=\"$url\" $options>$text</A>\\end{rawhtml}", 1734 "<A HREF=\"$url\" $options>$text</A>" 1735 ); 1736 } 1737 1738 1739 sub helpLink { 1740 my $type1 = shift; 1741 return "" if(not defined($envir{'localHelpURL'})); 1742 my $type = lc($type1); 1743 my %typeHash = ( 1744 'interval notation' => 'IntervalNotation.html', 1745 'units' => 'Units.html', 1746 ); 1747 1748 my $infoRef = $typeHash{$type}; 1749 return htmlLink( $envir{'localHelpURL'}.$infoRef, $type1, 1750 'target="ww_help" onclick="window.open(this.href,this.target,\'width=550,height=350,scrollbars=yes,resizable=on\'); return false;"'); 1751 } 1752 1753 sub appletLink { 1754 my $url = shift; 1755 my $options = shift; 1756 $options = "" unless defined($options); 1757 M3( "{\\bf \\underline{APPLET} }", 1758 "\\begin{rawhtml} <APPLET $url> $options </APPLET>\\end{rawhtml}", 1759 "<APPLET $url> $options </APPLET>" 1760 ); 1761 } 1762 sub spf { 1763 my($number,$format) = @_; # attention, the order of format and number are reversed 1764 $format = "%4.3g" unless $format; # default value for format 1765 sprintf($format, $number); 1766 } 1767 sub sspf { 1768 my($number,$format) = @_; # attention, the order of format and number are reversed 1769 $format = "%4.3g" unless $format; # default value for format 1770 my $sign = $number>=0 ? " + " : " - "; 1771 $number = $number>=0 ? $number : -$number; 1772 $sign .sprintf($format, $number); 1773 } 1774 1775 =head2 Sorting and other list macros 1776 1777 1778 1779 Usage: 1780 lex_sort(@list); # outputs list in lexigraphic (alphabetical) order 1781 num_sort(@list); # outputs list in numerical order 1782 uniq( @list); # outputs a list with no duplicates. Order is unspecified. 1783 1784 PGsort( \&sort_subroutine, @list); 1785 # &sort_subroutine defines order. It's output must be 1 or 0 (true or false) 1786 1787 =cut 1788 1789 # uniq gives unique elements of a list: 1790 sub uniq { 1791 my (@in) =@_; 1792 my %temp = (); 1793 while (@in) { 1794 $temp{shift(@in)}++; 1795 } 1796 my @out = keys %temp; # sort is causing trouble with Safe.?? 1797 @out; 1798 } 1799 1800 sub lex_sort { 1801 PGsort sub {$_[0] lt $_[1]}, @_; 1802 } 1803 sub num_sort { 1804 PGsort sub {$_[0] < $_[1]}, @_; 1805 } 1806 1807 1808 =head2 Macros for handling tables 1809 1810 Usage: 1811 begintable( number_of_columns_in_table) 1812 row(@dataelements) 1813 endtable() 1814 1815 Example of useage: 1816 1817 BEGIN_TEXT 1818 This problem tests calculating new functions from old ones:$BR 1819 From the table below calculate the quantities asked for:$BR 1820 \{begintable(scalar(@firstrow)+1)\} 1821 \{row(" \(x\) ",@firstrow)\} 1822 \{row(" \(f(x)\) ", @secondrow)\} 1823 \{row(" \(g(x)\) ", @thirdrow)\} 1824 \{row(" \(f'(x)\) ", @fourthrow)\} 1825 \{row(" \(g'(x)\) ", @fifthrow)\} 1826 \{endtable()\} 1827 1828 (The arrays contain numbers which are placed in the table.) 1829 1830 END_TEXT 1831 1832 =cut 1833 1834 sub begintable { 1835 my ($number)=shift; #number of columns in table 1836 my %options = @_; 1837 warn "begintable(cols) requires a number indicating the number of columns" unless defined($number); 1838 my $out = ""; 1839 if ($displayMode eq 'TeX') { 1840 $out .= "\n\\par\\smallskip\\begin{center}\\begin{tabular}{" . "|c" x $number . "|} \\hline\n"; 1841 } 1842 elsif ($displayMode eq 'Latex2HTML') { 1843 $out .= "\n\\begin{rawhtml} <TABLE , BORDER=1>\n\\end{rawhtml}"; 1844 } 1845 elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng' || $displayMode eq 'HTML_img' || $displayMode eq 'HTML_jsMath' || $displayMode eq 'HTML_asciimath') { 1846 $out .= "<TABLE BORDER=1>\n" 1847 } 1848 else { 1849 $out = "Error: PGbasicmacros: begintable: Unknown displayMode: $displayMode.\n"; 1850 } 1851 $out; 1852 } 1853 1854 sub endtable { 1855 my $out = ""; 1856 if ($displayMode eq 'TeX') { 1857 $out .= "\n\\end {tabular}\\end{center}\\par\\smallskip\n"; 1858 } 1859 elsif ($displayMode eq 'Latex2HTML') { 1860 $out .= "\n\\begin{rawhtml} </TABLE >\n\\end{rawhtml}"; 1861 } 1862 elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng' ||$displayMode eq 'HTML_img' || $displayMode eq 'HTML_jsMath' || $displayMode eq 'HTML_asciimath') { 1863 $out .= "</TABLE>\n"; 1864 } 1865 else { 1866 $out = "Error: PGbasicmacros: endtable: Unknown displayMode: $displayMode.\n"; 1867 } 1868 $out; 1869 } 1870 1871 1872 sub row { 1873 my @elements = @_; 1874 my $out = ""; 1875 if ($displayMode eq 'TeX') { 1876 while (@elements) { 1877 $out .= shift(@elements) . " &"; 1878 } 1879 chop($out); # remove last & 1880 $out .= "\\\\ \\hline \n"; 1881 # carriage returns must be added manually for tex 1882 } 1883 elsif ($displayMode eq 'Latex2HTML') { 1884 $out .= "\n\\begin{rawhtml}\n<TR>\n\\end{rawhtml}\n"; 1885 while (@elements) { 1886 $out .= " \n\\begin{rawhtml}\n<TD> \n\\end{rawhtml}\n" . shift(@elements) . " \n\\begin{rawhtml}\n</TD> \n\\end{rawhtml}\n"; 1887 } 1888 $out .= " \n\\begin{rawhtml}\n</TR> \n\\end{rawhtml}\n"; 1889 } 1890 elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng'||$displayMode eq 'HTML_img' || $displayMode eq 'HTML_jsMath' || $displayMode eq 'HTML_asciimath') { 1891 $out .= "<TR>\n"; 1892 while (@elements) { 1893 $out .= "<TD>" . shift(@elements) . "</TD>"; 1894 } 1895 $out .= "\n</TR>\n"; 1896 } 1897 else { 1898 $out = "Error: PGbasicmacros: row: Unknown displayMode: $displayMode.\n"; 1899 } 1900 $out; 1901 } 1902 1903 =head2 Macros for displaying static images 1904 1905 Usage: 1906 $string = image($image, width => 100, height => 100, tex_size => 800) 1907 $string = image($image, width => 100, height => 100, extra_html_tags => 'align="middle"', tex_size => 800) 1908 $string = image([$image1, $image2], width => 100, height => 100, tex_size => 800) 1909 $string = caption($string); 1910 $string = imageRow([$image1, $image2 ], [$caption1, $caption2]); 1911 # produces a complete table with rows of pictures. 1912 1913 1914 =cut 1915 1916 # More advanced macros 1917 sub image { 1918 my $image_ref = shift; 1919 my @opt = @_; 1920 unless (scalar(@opt) % 2 == 0 ) { 1921 warn "ERROR in image macro. A list of macros must be inclosed in square brackets."; 1922 } 1923 my %in_options = @opt; 1924 my %known_options = ( 1925 width => 100, 1926 height => 100, 1927 tex_size => 800, 1928 extra_html_tags => '', 1929 ); 1930 # handle options 1931 my %out_options = %known_options; 1932 foreach my $opt_name (keys %in_options) { 1933 if ( exists( $known_options{$opt_name} ) ) { 1934 $out_options{$opt_name} = $in_options{$opt_name} if exists( $in_options{$opt_name} ) ; 1935 } else { 1936 die "Option $opt_name not defined for image. " . 1937 "Default options are:<BR> ", display_options2(%known_options); 1938 } 1939 } 1940 my $width = $out_options{width}; 1941 my $height = $out_options{height}; 1942 my $tex_size = $out_options{tex_size}; 1943 my $width_ratio = $tex_size*(.001); 1944 my @image_list = (); 1945 1946 if (ref($image_ref) =~ /ARRAY/ ) { 1947 @image_list = @{$image_ref}; 1948 } else { 1949 push(@image_list,$image_ref); 1950 } 1951 1952 my @output_list = (); 1953 while(@image_list) { 1954 my $imageURL = alias(shift @image_list); 1955 my $out=""; 1956 1957 if ($displayMode eq 'TeX') { 1958 my $imagePath = $imageURL; # in TeX mode, alias gives us a path, not a URL 1959 if (defined $envir->{texDisposition} and $envir->{texDisposition} eq "pdf") { 1960 # We're going to create PDF files with our TeX (using pdflatex), so 1961 # alias should have given us the path to a PNG image. What we need 1962 # to do is find out the dimmensions of this image, since pdflatex 1963 # is too dumb to live. 1964 1965 #my ($height, $width) = getImageDimmensions($imagePath); 1966 ##warn "&image: $imagePath $height $width\n"; 1967 #unless ($height and $width) { 1968 # warn "Couldn't get the dimmensions of image $imagePath.\n" 1969 #} 1970 #$out = "\\includegraphics[bb=0 0 $height $width,width=$width_ratio\\linewidth]{$imagePath}\n"; 1971 $out = "\\includegraphics[width=$width_ratio\\linewidth]{$imagePath}\n"; 1972 } else { 1973 # Since we're not creating PDF files, alias should have given us the 1974 # path to an EPS file. latex can get its dimmensions no problem! 1975 1976 $out = "\\includegraphics[width=$width_ratio\\linewidth]{$imagePath}\n"; 1977 } 1978 } elsif ($displayMode eq 'Latex2HTML') { 1979 my $wid = ($envir->{onTheFlyImageSize} || 0)+ 30; 1980 $out = qq!\\begin{rawhtml}\n<A HREF= "$imageURL" TARGET="_blank" onclick="window.open(this.href,this.target, 'width=$wid,height=$wid,scrollbars=yes,resizable=on'); return false;"><IMG SRC="$imageURL" WIDTH="$width" HEIGHT="$height"></A>\n 1981 \\end{rawhtml}\n ! 1982 } elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng' || $displayMode eq 'HTML_img' || $displayMode eq 'HTML_jsMath' || $displayMode eq 'HTML_asciimath') { 1983 my $wid = ($envir->{onTheFlyImageSize} || 0) +30; 1984 $out = qq!<A HREF= "$imageURL" TARGET="_blank" onclick="window.open(this.href,this.target, 'width=$wid,height=$wid,scrollbars=yes,resizable=on'); return false;"><IMG SRC="$imageURL" WIDTH="$width" HEIGHT="$height" $out_options{extra_html_tags} ></A> 1985 ! 1986 } else { 1987 $out = "Error: PGbasicmacros: image: Unknown displayMode: $displayMode.\n"; 1988 } 1989 push(@output_list, $out); 1990 } 1991 return wantarray ? @output_list : $output_list[0]; 1992 } 1993 1994 # This is legacy code. 1995 sub images { 1996 my @in = @_; 1997 my @outlist = (); 1998 while (@in) { 1999 push(@outlist,&image( shift(@in) ) ); 2000 } 2001 @outlist; 2002 } 2003 2004 2005 sub caption { 2006 my ($out) = @_; 2007 $out = " $out \n" if $displayMode eq 'TeX'; 2008 $out = " $out " if $displayMode eq 'HTML'; 2009 $out = " $out " if $displayMode eq 'HTML_tth'; 2010 $out = " $out " if $displayMode eq 'HTML_dpng'; 2011 $out = " $out " if $displayMode eq 'HTML_img'; 2012 $out = " $out " if $displayMode eq 'HTML_jsMath'; 2013 $out = " $out " if $displayMode eq 'HTML_asciimath'; 2014 $out = " $out " if $displayMode eq 'Latex2HTML'; 2015 $out; 2016 } 2017 2018 sub captions { 2019 my @in = @_; 2020 my @outlist = (); 2021 while (@in) { 2022 push(@outlist,&caption( shift(@in) ) ); 2023 } 2024 @outlist; 2025 } 2026 2027 sub imageRow { 2028 2029 my $pImages = shift; 2030 my $pCaptions=shift; 2031 my $out = ""; 2032 my @images = @$pImages; 2033 my @captions = @$pCaptions; 2034 my $number = @images; 2035 # standard options 2036 my %options = ( 'tex_size' => 200, # width for fitting 4 across 2037 'height' => 100, 2038 'width' => 100, 2039 @_ # overwrite any default options 2040 ); 2041 2042 if ($displayMode eq 'TeX') { 2043 $out .= "\n\\par\\smallskip\\begin{center}\\begin{tabular}{" . "|c" x $number . "|} \\hline\n"; 2044 while (@images) { 2045 $out .= &image( shift(@images),%options ) . '&'; 2046 } 2047 chop($out); 2048 $out .= "\\\\ \\hline \n"; 2049 while (@captions) { 2050 $out .= &caption( shift(@captions) ) . '&'; 2051 } 2052 chop($out); 2053 $out .= "\\\\ \\hline \n\\end {tabular}\\end{center}\\par\\smallskip\n"; 2054 } elsif ($displayMode eq 'Latex2HTML'){ 2055 2056 $out .= "\n\\begin{rawhtml} <TABLE BORDER=1><TR>\n\\end{rawhtml}\n"; 2057 while (@images) { 2058 $out .= "\n\\begin{rawhtml} <TD>\n\\end{rawhtml}\n" . &image( shift(@images),%options ) 2059 . "\n\\begin{rawhtml} </TD>\n\\end{rawhtml}\n" ; 2060 } 2061 2062 $out .= "\n\\begin{rawhtml}</TR><TR>\\end{rawhtml}\n"; 2063 while (@captions) { 2064 $out .= "\n\\begin{rawhtml} <TH>\n\\end{rawhtml}\n".&caption( shift(@captions) ) 2065 . "\n\\begin{rawhtml} </TH>\n\\end{rawhtml}\n" ; 2066 } 2067 2068 $out .= "\n\\begin{rawhtml} </TR> </TABLE >\n\\end{rawhtml}"; 2069 } elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng'|| $displayMode eq 'HTML_img' || $displayMode eq 'HTML_jsMath' || $displayMode eq 'HTML_asciimath'){ 2070 $out .= "<P>\n <TABLE BORDER=2 CELLPADDING=3 CELLSPACING=2 ><TR ALIGN=CENTER VALIGN=MIDDLE>\n"; 2071 while (@images) { 2072 $out .= " \n<TD>". &image( shift(@images),%options ) ."</TD>"; 2073 } 2074 $out .= "</TR>\n<TR>"; 2075 while (@captions) { 2076 $out .= " <TH>". &caption( shift(@captions) ) ."</TH>"; 2077 } 2078 $out .= "\n</TR></TABLE></P>\n" 2079 } 2080 else { 2081 $out = "Error: PGbasicmacros: imageRow: Unknown languageMode: $displayMode.\n"; 2082 warn $out; 2083 } 2084 $out; 2085 } 2086 2087 2088 ########### 2089 # Auxiliary macros 2090 2091 sub display_options2{ 2092 my %options = @_; 2093 my $out_string = ""; 2094 foreach my $key (keys %options) { 2095 $out_string .= " $key => $options{$key},<BR>"; 2096 } 2097 $out_string; 2098 } 2099 2100 2101 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |