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