Parent Directory
| 
Revision Log
Allow new option for image. extra_html_tags are added to the img tag of the image. Allows you to control the vertical alignment of an image.
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 # MODES() is now table driven 1071 our %DISPLAY_MODE_FAILOVER = ( 1072 TeX => [], 1073 HTML => [], 1074 HTML_tth => [ "HTML", ], 1075 HTML_dpng => [ "HTML_tth", "HTML", ], 1076 HTML_jsMath => [ "HTML_dpng", "HTML_tth", "HTML", ], 1077 HTML_asciimath => [ "HTML_dpng", "HTML_tth", "HTML", ], 1078 # legacy modes -- these are not supported, but some problems might try to 1079 # set the display mode to one of these values manually and some macros may 1080 # provide rendered versions for these modes but not the one we want. 1081 Latex2HTML => [ "TeX", "HTML", ], 1082 HTML_img => [ "HTML_dpng", "HTML_tth", "HTML", ], 1083 ); 1084 1085 # This replaces M3. You can add new modes at will to this one. 1086 sub MODES { 1087 my %options = @_; 1088 1089 # is a string supplied for the current display mode? if so, return it 1090 return $options{$displayMode} if defined $options{$displayMode}; 1091 1092 # otherwise, fail over to backup modes 1093 my @backup_modes; 1094 if (exists $DISPLAY_MODE_FAILOVER{$displayMode}) { 1095 @backup_modes = @{$DISPLAY_MODE_FAILOVER{$displayMode}}; 1096 foreach my $mode (@backup_modes) { 1097 return $options{$mode} if defined $options{$mode}; 1098 } 1099 } 1100 die "ERROR in defining MODES: neither display mode $displayMode nor", 1101 " any fallback modes (", join(", ", @backup_modes), ") supplied.\n"; 1102 } 1103 1104 # end display macros 1105 1106 1107 =head2 Display constants 1108 1109 @ALPHABET ALPHABET() capital letter alphabet -- ALPHABET[0] = 'A' 1110 $PAR PAR() paragraph character (\par or <p>) 1111 $BR BR() line break character 1112 $LQ LQ() left double quote 1113 $RQ RQ() right double quote 1114 $BM BM() begin math 1115 $EM EM() end math 1116 $BDM BDM() begin display math 1117 $EDM EDM() end display math 1118 $LTS LTS() strictly less than 1119 $GTS GTS() strictly greater than 1120 $LTE LTE() less than or equal 1121 $GTE GTE() greater than or equal 1122 $BEGIN_ONE_COLUMN BEGIN_ONE_COLUMN() begin one-column mode 1123 $END_ONE_COLUMN END_ONE_COLUMN() end one-column mode 1124 $SOL SOLUTION_HEADING() solution headline 1125 $SOLUTION SOLUTION_HEADING() solution headline 1126 $HINT HINT_HEADING() hint headline 1127 $US US() underscore character 1128 $SPACE SPACE() space character (tex and latex only) 1129 $BBOLD BBOLD() begin bold typeface 1130 $EBOLD EBOLD() end bold typeface 1131 $BITALIC BITALIC() begin italic typeface 1132 $EITALIC EITALIC() end italic typeface 1133 $BCENTER BCENTER() begin centered environment 1134 $ECENTER ECENTER() end centered environment 1135 $HR HR() horizontal rule 1136 $LBRACE LBRACE() left brace 1137 $LB LB () left brace 1138 $RBRACE RBRACE() right brace 1139 $RB RB () right brace 1140 $DOLLAR DOLLAR() a dollar sign 1141 $PERCENT PERCENT() a percent sign 1142 $CARET CARET() a caret sign 1143 $PI PI() the number pi 1144 $E E() the number e 1145 1146 =cut 1147 1148 1149 1150 1151 1152 # A utility variable. Notice that "B"=$ALPHABET[1] and 1153 # "ABCD"=@ALPHABET[0..3]. 1154 1155 sub ALPHABET { 1156 ('A'..'ZZ')[@_]; 1157 } 1158 1159 ############################################################### 1160 # Some constants which are different in tex and in HTML 1161 # The order of arguments is TeX, Latex2HTML, HTML 1162 # Adopted Davide Cervone's improvements to PAR, LTS, GTS, LTE, GTE, LBRACE, RBRACE, LB, RB. 7-14-03 AKP 1163 sub PAR { MODES( TeX => '\\par ', Latex2HTML => '\\begin{rawhtml}<P>\\end{rawhtml}', HTML => '<P>'); }; 1164 sub BR { MODES( TeX => '\\par\\noindent ', Latex2HTML => '\\begin{rawhtml}<BR>\\end{rawhtml}', HTML => '<BR>'); }; 1165 # Alternate definition of BR which is slightly more flexible and gives more white space in printed output 1166 # which looks better but kills more trees. 1167 #sub BR { MODES( TeX => '\\\\', Latex2HTML => '\\begin{rawhtml}<BR>\\end{rawhtml}', HTML => '<BR>'); }; 1168 sub LQ { MODES( TeX => "``", Latex2HTML => '"', HTML => '"' ); }; 1169 sub RQ { MODES( TeX => "''", Latex2HTML => '"', HTML => '"' ); }; 1170 sub BM { MODES(TeX => '\\(', Latex2HTML => '\\(', HTML => ''); }; # begin math mode 1171 sub EM { MODES(TeX => '\\)', Latex2HTML => '\\)', HTML => ''); }; # end math mode 1172 sub BDM { MODES(TeX => '\\[', Latex2HTML => '\\[', HTML => '<P ALIGN=CENTER>'); }; #begin displayMath mode 1173 sub EDM { MODES(TeX => '\\]', Latex2HTML => '\\]', HTML => '</P>'); }; #end displayMath mode 1174 sub LTS { MODES(TeX => '<', Latex2HTML => '\\lt ', HTML => '<', HTML_tth => '<' ); }; 1175 sub GTS { MODES(TeX => '>', Latex2HTML => '\\gt ', HTML => '>', HTML_tth => '>' ); }; 1176 sub LTE { MODES(TeX => '\\le ', Latex2HTML => '\\le ', HTML => '<U><</U>', HTML_tth => '\\le ' ); }; 1177 sub GTE { MODES(TeX => '\\ge ', Latex2HTML => '\\ge ', HTML => '<U>></U>', HTML_tth => '\\ge ' ); }; 1178 sub BEGIN_ONE_COLUMN { MODES(TeX => " \\end{multicols}\n", Latex2HTML => " ", HTML => " "); }; 1179 sub END_ONE_COLUMN { MODES(TeX => 1180 " \\begin{multicols}{2}\n\\columnwidth=\\linewidth\n", 1181 Latex2HTML => ' ', HTML => ' '); 1182 1183 }; 1184 sub SOLUTION_HEADING { MODES( TeX => '\\par {\\bf Solution:}', 1185 Latex2HTML => '\\par {\\bf Solution:}', 1186 HTML => '<P><B>Solution:</B>'); 1187 }; 1188 sub HINT_HEADING { MODES( TeX => "\\par {\\bf Hint:}", Latex2HTML => "\\par {\\bf Hint:}", HTML => "<P><B>Hint:</B>"); }; 1189 sub US { MODES(TeX => '\\_', Latex2HTML => '\\_', HTML => '_');}; # underscore, e.g. file${US}name 1190 sub SPACE { MODES(TeX => '\\ ', Latex2HTML => '\\ ', HTML => ' ');}; # force a space in latex, doesn't force extra space in html 1191 sub BBOLD { MODES(TeX => '{\\bf ', Latex2HTML => '{\\bf ', HTML => '<B>'); }; 1192 sub EBOLD { MODES( TeX => '}', Latex2HTML => '}',HTML => '</B>'); }; 1193 sub BITALIC { MODES(TeX => '{\\it ', Latex2HTML => '{\\it ', HTML => '<I>'); }; 1194 sub EITALIC { MODES(TeX => '} ', Latex2HTML => '} ', HTML => '</I>'); }; 1195 sub BCENTER { MODES(TeX => '\\begin{center} ', Latex2HTML => ' \\begin{rawhtml} <div align="center"> \\end{rawhtml} ', HTML => '<div align="center">'); }; 1196 sub ECENTER { MODES(TeX => '\\end{center} ', Latex2HTML => ' \\begin{rawhtml} </div> \\end{rawhtml} ', HTML => '</div>'); }; 1197 sub HR { MODES(TeX => '\\par\\hrulefill\\par ', Latex2HTML => '\\begin{rawhtml} <HR> \\end{rawhtml}', HTML => '<HR>'); }; 1198 sub LBRACE { MODES( TeX => '\{', Latex2HTML => '\\lbrace', HTML => '{' , HTML_tth=> '\\lbrace' ); }; 1199 sub RBRACE { MODES( TeX => '\}', Latex2HTML => '\\rbrace', HTML => '}' , HTML_tth=> '\\rbrace',); }; 1200 sub LB { MODES( TeX => '\{', Latex2HTML => '\\lbrace', HTML => '{' , HTML_tth=> '\\lbrace' ); }; 1201 sub RB { MODES( TeX => '\}', Latex2HTML => '\\rbrace', HTML => '}' , HTML_tth=> '\\rbrace',); }; 1202 sub DOLLAR { MODES( TeX => '\\$', Latex2HTML => '\\$', HTML => '$' ); }; 1203 sub PERCENT { MODES( TeX => '\\%', Latex2HTML => '\\%', HTML => '%' ); }; 1204 sub CARET { MODES( TeX => '\\verb+^+', Latex2HTML => '\\verb+^+', HTML => '^' ); }; 1205 sub PI {4*atan2(1,1);}; 1206 sub E {exp(1);}; 1207 1208 ############################################################### 1209 ## Evaluation macros 1210 1211 1212 =head2 TEXT macros 1213 1214 Usage: 1215 TEXT(@text); 1216 1217 This is the simplest way to print text from a problem. The strings in the array C<@text> are concatenated 1218 with spaces between them and printed out in the text of the problem. The text is not processed in any other way. 1219 C<TEXT> is defined in PG.pl. 1220 1221 Usage: 1222 BEGIN_TEXT 1223 text..... 1224 END_TEXT 1225 1226 This is the most common way to enter text into the problem. All of the text between BEGIN_TEXT and END_TEXT 1227 is processed by the C<EV3> macro described below and then printed using the C<TEXT> command. The two key words 1228 must appear on lines by themselves. The preprocessing that makes this construction work is done in F<PGtranslator.pm>. 1229 See C<EV3> below for details on the processing. 1230 1231 1232 =cut 1233 1234 =head2 Evaluation macros 1235 1236 =head3 EV3 1237 1238 TEXT(EV3("This is a formulat \( \int_0^5 x^2 \, dx \) "); 1239 TEXT(EV3(@text)); 1240 1241 TEXT(EV3(<<'END_TEXT')); 1242 text stuff... 1243 END_TEXT 1244 1245 1246 The BEGIN_TEXT/END_TEXT construction is translated into the construction above by PGtranslator.pm. END_TEXT must appear 1247 on a line by itself and be left justified. (The << construction is known as a "here document" in UNIX and in PERL.) 1248 1249 The single quotes around END_TEXT mean that no automatic interpolation of variables takes place in the text. 1250 Using EV3 with strings which have been evaluated by double quotes may lead to unexpected results. 1251 1252 1253 The evaluation macro E3 first evaluates perl code inside the braces: C<\{ code \}>. 1254 Any perl statment can be put inside the braces. The 1255 result of the evaluation (i.e. the last statement evaluated) replaces the C<\{ code \}> construction. 1256 1257 Next interpolation of all variables (e.g. C<$var or @array> ) is performed. 1258 1259 Then mathematical formulas in TeX are evaluated within the 1260 C<\( tex math mode \)> and 1261 C<\[ tex display math mode \] > 1262 constructions, in that order: 1263 1264 =head3 FEQ 1265 1266 FEQ($string); # processes and outputs the string 1267 1268 1269 The mathematical formulas are run through the macro C<FEQ> (Format EQuations) which performs 1270 several substitutions (see below). 1271 In C<HTML_tth> mode the resulting code is processed by tth to obtain an HTML version 1272 of the formula. (In the future processing by WebEQ may be added here as another option.) 1273 The Latex2HTML mode does nothing 1274 at this stage; it creates the entire problem before running it through 1275 TeX and creating the GIF images of the equations. 1276 1277 The resulting string is output (and usually fed into TEXT to be printed in the problem). 1278 1279 Usage: 1280 1281 $string2 = FEQ($string1); 1282 1283 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 1284 understood with an example. 1285 1286 $string1 = "${a}x^2 + ${b}x + {$c:%.1f}"; $a = 3;, $b = -2; $c = -7.345; 1287 1288 when interpolated becomes: 1289 1290 $string1 = '3x^2 + -2x + {-7.345:%0.1f} 1291 1292 FEQ first changes the number of decimal places displayed, so that the last term becomes -7.3 Then it removes the 1293 extraneous plus and minus signs, so that the final result is what you want: 1294 1295 $string2 = '3x^2 - 2x -7.3'; 1296 1297 (The %0.1f construction 1298 is the same formatting convention used by Perl and nearly identical to the one used by the C printf statement. Some common 1299 usage: %0.3f 3 decimal places, fixed notation; %0.3e 3 significant figures exponential notation; %0.3g uses either fixed 1300 or exponential notation depending on the size of the number.) 1301 1302 Two additional legacy formatting constructions are also supported: 1303 1304 C<?{$c:%0.3f} > will give a number with 3 decimal places and a negative 1305 sign if the number is negative, no sign if the number is positive. 1306 1307 C<!{$c:%0.3f}> determines the sign and prints it 1308 whether the number is positive or negative. 1309 1310 =head3 EV2 1311 1312 TEXT(EV2(@text)); 1313 1314 TEXT(EV2(<<END_OF_TEXT)); 1315 text stuff... 1316 END_OF_TEXT 1317 1318 This is a precursor to EV3. In this case the constants are interpolated first, before the evaluation of the \{ ...code...\} 1319 construct. This can lead to unexpected results. For example C<\{ join(" ", @text) \}> with C<@text = ("Hello","World");> becomes, 1320 after interpolation, C<\{ join(" ",Hello World) \}> which then causes an error when evaluated because Hello is a bare word. 1321 C<EV2> can still be useful if you allow for this, and in particular it works on double quoted strings, which lead to 1322 unexpected results with C<EV3>. Using single quoted strings with C<EV2> may lead to unexpected results. 1323 1324 The unexpected results have to do with the number of times backslashed constructions have to be escaped. It is quite messy. For 1325 more details get a good Perl book and then read the code. :-) 1326 1327 1328 1329 1330 =cut 1331 1332 1333 sub ev_substring { 1334 my $string = shift; 1335 my $start_delim = shift; 1336 my $end_delim = shift; 1337 my $actionRef = shift; 1338 my ($eval_out,$PG_eval_errors,$PG_full_error_report)=(); 1339 my $out = ""; 1340 # 1341 # DPVC -- 2001/12/07 1342 # original "while ($string)" fails to process the string "0" correctly 1343 # 1344 while ($string ne "") { 1345 # 1346 # end DPVC 1347 # 1348 if ($string =~ /\Q$start_delim\E/s) { 1349 #print "$start_delim $end_delim evaluating_substring=$string<BR>"; 1350 $string =~ s/^(.*?)\Q$start_delim\E//s; # get string up to next \{ ---treats string as a single line, ignoring returns 1351 $out .= $1; 1352 #print "$start_delim $end_delim substring_out=$out<BR>"; 1353 $string =~ s/^(.*?)\Q$end_delim\E//s; # get perl code up to \} ---treats string as a single line, ignoring returns 1354 #print "$start_delim $end_delim evaluate_string=$1<BR>"; 1355 ($eval_out,$PG_eval_errors,$PG_full_error_report) = &$actionRef($1); 1356 $eval_out = "$start_delim $eval_out $end_delim" if $PG_full_error_report; 1357 $out = $out . $eval_out; 1358 #print "$start_delim $end_delim new substring_out=$out<BR><p><BR>"; 1359 $out .="$PAR ERROR $0 in ev_substring, PGbasicmacros.pl:$PAR <PRE> $@ </PRE>$PAR" if $@; 1360 } 1361 else { 1362 $out .= $string; # flush the last part of the string 1363 last; 1364 } 1365 1366 } 1367 $out; 1368 } 1369 sub safe_ev { 1370 my ($out,$PG_eval_errors,$PG_full_error_report) = &old_safe_ev; # process input by old_safe_ev first 1371 $out =~s/\\/\\\\/g; # protect any new backslashes introduced. 1372 ($out,$PG_eval_errors,$PG_full_error_report) 1373 } 1374 1375 sub old_safe_ev { 1376 my $in = shift; 1377 my ($out,$PG_eval_errors,$PG_full_error_report) = PG_restricted_eval("$in;"); 1378 # the addition of the ; seems to provide better error reporting 1379 if ($PG_eval_errors) { 1380 my @errorLines = split("\n",$PG_eval_errors); 1381 #$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> "; 1382 warn " ERROR in old_safe_ev, PGbasicmacros.pl: <PRE> 1383 ## There is an error occuring inside evaluation brackets \\{ ...code... \\} 1384 ## somewhere in an EV2 or EV3 or BEGIN_TEXT block. 1385 ## Code evaluated: 1386 ## $in 1387 ##" .join("\n ", @errorLines). " 1388 ##</PRE>$BR 1389 "; 1390 $out ="$PAR $BBOLD $in $EBOLD $PAR"; 1391 1392 1393 } 1394 1395 ($out,$PG_eval_errors,$PG_full_error_report); 1396 } 1397 1398 sub FEQ { # Format EQuations 1399 my $in = shift; 1400 # formatting numbers -- the ?{} and !{} constructions 1401 $in =~s/\?\s*\{([.\-\$\w\d]+):?([%.\da-z]*)\}/${ \( &sspf($1,$2) )}/g; 1402 $in =~s/\!\s*\{([.\-\$\w\d]+):?([%.\da-z]*)\}/${ \( &spf($1,$2) )}/g; 1403 1404 # more formatting numbers -- {number:format} constructions 1405 $in =~ s/\{(\s*[\+\-\d\.]+[eE]*[\+\-]*\d*):(\%\d*.\d*\w)}/${ \( &spf($1,$2) )}/g; 1406 $in =~ s/\+\s*\-/ - /g; 1407 $in =~ s/\-\s*\+/ - /g; 1408 $in =~ s/\+\s*\+/ + /g; 1409 $in =~ s/\-\s*\-/ + /g; 1410 $in; 1411 } 1412 1413 #sub math_ev3 { 1414 # my $in = shift; #print "in=$in<BR>"; 1415 # my ($out,$PG_eval_errors,$PG_full_error_report); 1416 # $in = FEQ($in); 1417 # $in =~ s/%/\\%/g; # % causes trouble in TeX and HTML_tth it usually (always?) indicates an error, not comment 1418 # return("$BM $in $EM") unless ($displayMode eq 'HTML_tth'); 1419 # $in = "\\(" . $in . "\\)"; 1420 # $out = tth($in); 1421 # ($out,$PG_eval_errors,$PG_full_error_report); 1422 # 1423 #} 1424 # 1425 #sub display_math_ev3 { 1426 # my $in = shift; #print "in=$in<BR>"; 1427 # my ($out,$PG_eval_errors,$PG_full_error_report); 1428 # $in = FEQ($in); 1429 # $in =~ s/%/\\%/g; 1430 # return("$main::BDM $in $main::EDM") unless $displayMode eq 'HTML_tth' ; 1431 # $in = "\\[" . $in . "\\]"; 1432 # $out =tth($in); 1433 # ($out,$PG_eval_errors,$PG_full_error_report); 1434 #} 1435 1436 sub math_ev3 { 1437 my $in = shift; 1438 return general_math_ev3($in, "inline"); 1439 } 1440 1441 sub display_math_ev3 { 1442 my $in = shift; 1443 return general_math_ev3($in, "display"); 1444 } 1445 1446 sub general_math_ev3 { 1447 my $in = shift; 1448 my $mode = shift || "inline"; 1449 1450 $in = FEQ($in); # Format EQuations 1451 $in =~ s/%/\\%/g; # avoid % becoming TeX comments 1452 1453 ## remove leading and trailing spaces so that HTML mode will 1454 ## not include unwanted spaces as per Davide Cervone. 1455 $in =~ s/^\s+//; 1456 $in =~ s/\s+$//; 1457 ## If it ends with a backslash, there should be another space 1458 ## at the end 1459 if($in =~ /\\$/) { $in .= ' ';} 1460 1461 # some modes want the delimiters, some don't 1462 my $in_delim = $mode eq "inline" 1463 ? "\\($in\\)" 1464 : "\\[$in\\]"; 1465 1466 my $out; 1467 if($displayMode eq "HTML_tth") { 1468 $out = tth($in_delim); 1469 ## remove leading and trailing spaces as per Davide Cervone. 1470 $out =~ s/^\s+//; 1471 $out =~ s/\s+$//; 1472 } elsif ($displayMode eq "HTML_dpng") { 1473 # for jj's version of ImageGenerator 1474 $out = $envir->{'imagegen'}->add($in_delim); 1475 # for my version of ImageGenerator 1476 #$out = $envir->{'imagegen'}->add($in, $mode); 1477 } elsif ($displayMode eq "HTML_img") { 1478 $out = math2img($in, $mode); 1479 } elsif ($displayMode eq "HTML_jsMath") { 1480 $in =~ s/</</g; $in =~ s/>/>/g; 1481 $out = '<SPAN CLASS="math">'.$in.'</SPAN>' if $mode eq "inline"; 1482 $out = '<DIV CLASS="math">'.$in.'</DIV>' if $mode eq "display"; 1483 } elsif ($displayMode eq "HTML_asciimath") { 1484 $out = "`$in`" if $mode eq "inline"; 1485 $out = '<DIV ALIGN="CENTER">`'.$in.'`</DIV>' if $mode eq "display"; 1486 } else { 1487 $out = "\\($in\\)" if $mode eq "inline"; 1488 $out = "\\[$in\\]" if $mode eq "display"; 1489 } 1490 return $out; 1491 } 1492 1493 sub EV2 { 1494 my $string = join(" ",@_); 1495 # evaluate code inside of \{ \} (no nesting allowed) 1496 $string = ev_substring($string,"\\{","\\}",\&old_safe_ev); 1497 $string = ev_substring($string,"\\<","\\>",\&old_safe_ev); 1498 $string = ev_substring($string,"\\(","\\)",\&math_ev3); 1499 $string = ev_substring($string,"\\[","\\]",\&display_math_ev3); 1500 # macros for displaying math 1501 $string =~ s/\\\(/$BM/g; 1502 $string =~ s/\\\)/$EM/g; 1503 $string =~ s/\\\[/$BDM/g; 1504 $string =~ s/\\\]/$EDM/g; 1505 $string; 1506 } 1507 1508 sub EV3{ 1509 my $string = join(" ",@_); 1510 # evaluate code inside of \{ \} (no nesting allowed) 1511 $string = ev_substring($string,"\\\\{","\\\\}",\&safe_ev); # handles \{ \} in single quoted strings of PG files 1512 # interpolate variables 1513 my ($evaluated_string,$PG_eval_errors,$PG_full_errors) = PG_restricted_eval("<<END_OF_EVALUATION_STRING\n$string\nEND_OF_EVALUATION_STRING\n"); 1514 if ($PG_eval_errors) { 1515 my @errorLines = split("\n",$PG_eval_errors); 1516 $string =~ s/</</g; $string =~ s/>/>/g; 1517 $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> "; 1518 $@=""; 1519 } 1520 $string = $evaluated_string; 1521 $string = ev_substring($string,"\\(","\\)",\&math_ev3); 1522 $string = ev_substring($string,"\\[","\\]",\&display_math_ev3); 1523 $string; 1524 } 1525 1526 sub EV4{ 1527 if ($displayMode eq "HTML_dpng") { 1528 my $string = join(" ",@_); 1529 my ($evaluated_string,$PG_eval_errors,$PG_full_errors) = PG_restricted_eval("<<END_OF_EVALUATION_STRING\n$string\nEND_OF_EVALUATION_STRING\n"); 1530 if ($PG_eval_errors) { 1531 my @errorLines = split("\n",$PG_eval_errors); 1532 $string =~ s/</</g; $string =~ s/>/>/g; 1533 $evaluated_string = "<PRE>$PAR % ERROR in $0:EV3, PGbasicmacros.pl:". 1534 "$PAR % There is an error occuring in the following code:$BR ". 1535 "$string $BR % $BR % $errorLines[0]\n % $errorLines[1]$BR ". 1536 "% $BR % $BR </PRE> "; 1537 } 1538 $string = $evaluated_string; 1539 $string = $envir{'imagegen'}->add($string); 1540 $string; 1541 } else { 1542 EV3(@_); 1543 } 1544 } 1545 1546 1547 =head2 Formatting macros 1548 1549 beginproblem() # generates text listing number and the point value of 1550 # the problem. It will also print the file name containing 1551 # the problem for users listed in the PRINT_FILE_NAMES_FOR PG_environment 1552 # variable. 1553 OL(@array) # formats the array as an Ordered List ( <OL> </OL> ) enumerated by letters. 1554 1555 htmlLink($url, $text) 1556 # Places a reference to the URL with the specified text in the problem. 1557 # A common usage is \{ htmlLink(alias('prob1_help.html') \}, 'for help') 1558 # where alias finds the full address of the prob1_help.html file in the same directory 1559 # as the problem file 1560 appletLink($url, $parameters) 1561 # For example 1562 # appletLink(q! archive="http: //webwork.math.rochester.edu/gage/xFunctions/xFunctions.zip" 1563 code="xFunctionsLauncher.class" width=100 height=14!, 1564 " parameter text goes here") 1565 # will link to xFunctions. 1566 1567 low level: 1568 1569 spf($number, $format) # prints the number with the given format 1570 sspf($number, $format) # prints the number with the given format, always including a sign. 1571 nicestring($coefficients, $terms) # print a linear combinations of terms using coefficients 1572 nicestring($coefficients) # uses the coefficients to make a polynomial 1573 # For example 1574 # nicestring([1,-2, 0]) produces 'x^2-2x' 1575 # nicestring([2,0,-1],['', 't', 't^2']) produces '2-t^2' 1576 protect_underbar($string) # protects the underbar (class_name) in strings which may have to pass through TeX. 1577 1578 =cut 1579 1580 sub beginproblem { 1581 my $out = ""; 1582 my $problemValue = $envir->{problemValue}; 1583 my $fileName = $envir->{fileName}; 1584 my $probNum = $envir->{probNum}; 1585 my $TeXFileName = protect_underbar($envir->{fileName}); 1586 my $l2hFileName = protect_underbar($envir->{fileName}); 1587 my %inlist; 1588 my $points ='pts'; 1589 1590 $points = 'pt' if $problemValue == 1; 1591 ## Prepare header for the problem 1592 grep($inlist{$_}++,@{ $envir->{'PRINT_FILE_NAMES_FOR'} }); 1593 if ( defined($inlist{$envir->{studentLogin}}) and ($inlist{$envir->{studentLogin}} > 0) ) { 1594 $out = &M3("{\\bf ${probNum}. {\\footnotesize ($problemValue $points) $TeXFileName}}\\newline ", 1595 " \\begin{rawhtml} ($problemValue $points) <B>$l2hFileName</B><BR>\\end{rawhtml}", 1596 "($problemValue $points) <B>$fileName</B><BR>" 1597 ) if ($problemValue ne ""); 1598 } else { 1599 $out = &M3("{\\bf ${probNum}.} ($problemValue $points) ", 1600 "($problemValue $points) ", 1601 "($problemValue $points) " 1602 ) if ($problemValue ne ""); 1603 } 1604 $out; 1605 1606 } 1607 1608 sub nicestring { 1609 my($thingy) = shift; 1610 my(@coefs) = @{$thingy}; 1611 my $n = scalar(@coefs); 1612 $thingy = shift; 1613 my(@others); 1614 if(defined($thingy)) { 1615 @others = @{$thingy}; 1616 } else { 1617 my($j); 1618 for $j (1..($n-2)) { 1619 $others[$j-1] = "x^".($n-$j); 1620 } 1621 if($n>=2) { $others[$n-2] = "x";} 1622 $others[$n-1] = ""; 1623 } 1624 my($j, $k)=(0,0); 1625 while(($k<$n) && ($coefs[$k]==0)) {$k++;} 1626 if($k==$n) {return("0");} 1627 my $ans; 1628 if($coefs[$k]==1) {$ans = ($others[$k]) ? "$others[$k]" : "1";} 1629 elsif($coefs[$k]== -1) {$ans = ($others[$k]) ? "- $others[$k]" : "-1"} 1630 else { $ans = "$coefs[$k] $others[$k]";} 1631 $k++; 1632 for $j ($k..($n-1)) { 1633 if($coefs[$j] != 0) { 1634 if($coefs[$j] == 1) { 1635 $ans .= ($others[$j]) ? "+ $others[$j]" : "+ 1"; 1636 } elsif($coefs[$j] == -1) { 1637 $ans .= ($others[$j]) ? "- $others[$j]" : "-1"; 1638 } else { 1639 $ans .= "+ $coefs[$j] $others[$j]"; 1640 } 1641 } 1642 } 1643 return($ans); 1644 } 1645 1646 # kludge to clean up path names 1647 ## allow underscore character in set and section names and also allows line breaks at / 1648 sub protect_underbar { 1649 my $in = shift; 1650 if ($displayMode eq 'TeX') { 1651 1652 $in =~ s|_|\\\_|g; 1653 $in =~ s|/|\\\-/|g; # allows an optional hyphenation of the path (in tex) 1654 } 1655 $in; 1656 } 1657 1658 1659 # An example of a macro which prints out a list (with letters) 1660 sub OL { 1661 my(@array) = @_; 1662 my $i = 0; 1663 my $out= &M3( 1664 "\\begin{enumerate}\n", 1665 " \\begin{rawhtml} <OL TYPE=\"A\" VALUE=\"1\"> \\end{rawhtml} ", 1666 "<OL TYPE=\"A\" VALUE=\"1\">\n" 1667 ) ; 1668 my $elem; 1669 foreach $elem (@array) { 1670 $out .= MODES( 1671 TeX=> "\\item[$ALPHABET[$i].] $elem\n", 1672 Latex2HTML=> " \\begin{rawhtml} <LI> \\end{rawhtml} $elem ", 1673 HTML=> "<LI> $elem\n", 1674 HTML_dpng=> "<LI> $elem <br /> <br /> \n" 1675 ); 1676 $i++; 1677 } 1678 $out .= &M3( 1679 "\\end{enumerate}\n", 1680 " \\begin{rawhtml} </OL>\n \\end{rawhtml} ", 1681 "</OL>\n" 1682 ) ; 1683 } 1684 1685 sub htmlLink { 1686 my $url = shift; 1687 my $text = shift; 1688 my $options = shift; 1689 $options = "" unless defined($options); 1690 return "$BBOLD\[ broken link: $text \] $EBOLD" unless defined($url); 1691 M3( "{\\bf \\underline{$text}}", 1692 "\\begin{rawhtml}<A HREF=\"$url\" $options>$text</A>\\end{rawhtml}", 1693 "<A HREF=\"$url\" $options>$text</A>" 1694 ); 1695 } 1696 1697 1698 sub helpLink { 1699 my $type1 = shift; 1700 return "" if(not defined($envir{'localHelpURL'})); 1701 my $type = lc($type1); 1702 my %typeHash = ( 1703 'interval notation' => 'IntervalNotation.html', 1704 'units' => 'Units.html', 1705 ); 1706 1707 my $infoRef = $typeHash{$type}; 1708 return htmlLink( $envir{'localHelpURL'}.$infoRef, $type1, 1709 'target="ww_help" onclick="window.open(this.href,this.target,\'width=550,height=350,scrollbars=yes,resizable=on\'); return false;"'); 1710 } 1711 1712 sub appletLink { 1713 my $url = shift; 1714 my $options = shift; 1715 $options = "" unless defined($options); 1716 M3( "{\\bf \\underline{APPLET} }", 1717 "\\begin{rawhtml} <APPLET $url> $options </APPLET>\\end{rawhtml}", 1718 "<APPLET $url> $options </APPLET>" 1719 ); 1720 } 1721 sub spf { 1722 my($number,$format) = @_; # attention, the order of format and number are reversed 1723 $format = "%4.3g" unless $format; # default value for format 1724 sprintf($format, $number); 1725 } 1726 sub sspf { 1727 my($number,$format) = @_; # attention, the order of format and number are reversed 1728 $format = "%4.3g" unless $format; # default value for format 1729 my $sign = $number>=0 ? " + " : " - "; 1730 $number = $number>=0 ? $number : -$number; 1731 $sign .sprintf($format, $number); 1732 } 1733 1734 =head2 Sorting and other list macros 1735 1736 1737 1738 Usage: 1739 lex_sort(@list); # outputs list in lexigraphic (alphabetical) order 1740 num_sort(@list); # outputs list in numerical order 1741 uniq( @list); # outputs a list with no duplicates. Order is unspecified. 1742 1743 PGsort( \&sort_subroutine, @list); 1744 # &sort_subroutine defines order. It's output must be 1 or 0 (true or false) 1745 1746 =cut 1747 1748 # uniq gives unique elements of a list: 1749 sub uniq { 1750 my (@in) =@_; 1751 my %temp = (); 1752 while (@in) { 1753 $temp{shift(@in)}++; 1754 } 1755 my @out = keys %temp; # sort is causing trouble with Safe.?? 1756 @out; 1757 } 1758 1759 sub lex_sort { 1760 PGsort sub {$_[0] lt $_[1]}, @_; 1761 } 1762 sub num_sort { 1763 PGsort sub {$_[0] < $_[1]}, @_; 1764 } 1765 1766 1767 =head2 Macros for handling tables 1768 1769 Usage: 1770 begintable( number_of_columns_in_table) 1771 row(@dataelements) 1772 endtable() 1773 1774 Example of useage: 1775 1776 BEGIN_TEXT 1777 This problem tests calculating new functions from old ones:$BR 1778 From the table below calculate the quantities asked for:$BR 1779 \{begintable(scalar(@firstrow)+1)\} 1780 \{row(" \(x\) ",@firstrow)\} 1781 \{row(" \(f(x)\) ", @secondrow)\} 1782 \{row(" \(g(x)\) ", @thirdrow)\} 1783 \{row(" \(f'(x)\) ", @fourthrow)\} 1784 \{row(" \(g'(x)\) ", @fifthrow)\} 1785 \{endtable()\} 1786 1787 (The arrays contain numbers which are placed in the table.) 1788 1789 END_TEXT 1790 1791 =cut 1792 1793 sub begintable { 1794 my ($number)=shift; #number of columns in table 1795 my %options = @_; 1796 warn "begintable(cols) requires a number indicating the number of columns" unless defined($number); 1797 my $out = ""; 1798 if ($displayMode eq 'TeX') { 1799 $out .= "\n\\par\\smallskip\\begin{center}\\begin{tabular}{" . "|c" x $number . "|} \\hline\n"; 1800 } 1801 elsif ($displayMode eq 'Latex2HTML') { 1802 $out .= "\n\\begin{rawhtml} <TABLE , BORDER=1>\n\\end{rawhtml}"; 1803 } 1804 elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng' || $displayMode eq 'HTML_img' || $displayMode eq 'HTML_jsMath' || $displayMode eq 'HTML_asciimath') { 1805 $out .= "<TABLE BORDER=1>\n" 1806 } 1807 else { 1808 $out = "Error: PGbasicmacros: begintable: Unknown displayMode: $displayMode.\n"; 1809 } 1810 $out; 1811 } 1812 1813 sub endtable { 1814 my $out = ""; 1815 if ($displayMode eq 'TeX') { 1816 $out .= "\n\\end {tabular}\\end{center}\\par\\smallskip\n"; 1817 } 1818 elsif ($displayMode eq 'Latex2HTML') { 1819 $out .= "\n\\begin{rawhtml} </TABLE >\n\\end{rawhtml}"; 1820 } 1821 elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng' ||$displayMode eq 'HTML_img' || $displayMode eq 'HTML_jsMath' || $displayMode eq 'HTML_asciimath') { 1822 $out .= "</TABLE>\n"; 1823 } 1824 else { 1825 $out = "Error: PGbasicmacros: endtable: Unknown displayMode: $displayMode.\n"; 1826 } 1827 $out; 1828 } 1829 1830 1831 sub row { 1832 my @elements = @_; 1833 my $out = ""; 1834 if ($displayMode eq 'TeX') { 1835 while (@elements) { 1836 $out .= shift(@elements) . " &"; 1837 } 1838 chop($out); # remove last & 1839 $out .= "\\\\ \\hline \n"; 1840 # carriage returns must be added manually for tex 1841 } 1842 elsif ($displayMode eq 'Latex2HTML') { 1843 $out .= "\n\\begin{rawhtml}\n<TR>\n\\end{rawhtml}\n"; 1844 while (@elements) { 1845 $out .= " \n\\begin{rawhtml}\n<TD> \n\\end{rawhtml}\n" . shift(@elements) . " \n\\begin{rawhtml}\n</TD> \n\\end{rawhtml}\n"; 1846 } 1847 $out .= " \n\\begin{rawhtml}\n</TR> \n\\end{rawhtml}\n"; 1848 } 1849 elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng'||$displayMode eq 'HTML_img' || $displayMode eq 'HTML_jsMath' || $displayMode eq 'HTML_asciimath') { 1850 $out .= "<TR>\n"; 1851 while (@elements) { 1852 $out .= "<TD>" . shift(@elements) . "</TD>"; 1853 } 1854 $out .= "\n</TR>\n"; 1855 } 1856 else { 1857 $out = "Error: PGbasicmacros: row: Unknown displayMode: $displayMode.\n"; 1858 } 1859 $out; 1860 } 1861 1862 =head2 Macros for displaying static images 1863 1864 Usage: 1865 $string = image($image, width => 100, height => 100, tex_size => 800) 1866 $string = image($image, width => 100, height => 100, extra_html_tags => 'align="middle"', tex_size => 800) 1867 $string = image([$image1, $image2], width => 100, height => 100, tex_size => 800) 1868 $string = caption($string); 1869 $string = imageRow([$image1, $image2 ], [$caption1, $caption2]); 1870 # produces a complete table with rows of pictures. 1871 1872 1873 =cut 1874 1875 # More advanced macros 1876 sub image { 1877 my $image_ref = shift; 1878 my @opt = @_; 1879 unless (scalar(@opt) % 2 == 0 ) { 1880 warn "ERROR in image macro. A list of macros must be inclosed in square brackets."; 1881 } 1882 my %in_options = @opt; 1883 my %known_options = ( 1884 width => 100, 1885 height => 100, 1886 tex_size => 800, 1887 extra_html_tags => '', 1888 ); 1889 # handle options 1890 my %out_options = %known_options; 1891 foreach my $opt_name (keys %in_options) { 1892 if ( exists( $known_options{$opt_name} ) ) { 1893 $out_options{$opt_name} = $in_options{$opt_name} if exists( $in_options{$opt_name} ) ; 1894 } else { 1895 die "Option $opt_name not defined for image. " . 1896 "Default options are:<BR> ", display_options2(%known_options); 1897 } 1898 } 1899 my $width = $out_options{width}; 1900 my $height = $out_options{height}; 1901 my $tex_size = $out_options{tex_size}; 1902 my $width_ratio = $tex_size*(.001); 1903 my @image_list = (); 1904 1905 if (ref($image_ref) =~ /ARRAY/ ) { 1906 @image_list = @{$image_ref}; 1907 } else { 1908 push(@image_list,$image_ref); 1909 } 1910 1911 my @output_list = (); 1912 while(@image_list) { 1913 my $imageURL = alias(shift @image_list); 1914 my $out=""; 1915 1916 if ($displayMode eq 'TeX') { 1917 my $imagePath = $imageURL; # in TeX mode, alias gives us a path, not a URL 1918 if (defined $envir->{texDisposition} and $envir->{texDisposition} eq "pdf") { 1919 # We're going to create PDF files with our TeX (using pdflatex), so 1920 # alias should have given us the path to a PNG image. What we need 1921 # to do is find out the dimmensions of this image, since pdflatex 1922 # is too dumb to live. 1923 1924 #my ($height, $width) = getImageDimmensions($imagePath); 1925 ##warn "&image: $imagePath $height $width\n"; 1926 #unless ($height and $width) { 1927 # warn "Couldn't get the dimmensions of image $imagePath.\n" 1928 #} 1929 #$out = "\\includegraphics[bb=0 0 $height $width,width=$width_ratio\\linewidth]{$imagePath}\n"; 1930 $out = "\\includegraphics[width=$width_ratio\\linewidth]{$imagePath}\n"; 1931 } else { 1932 # Since we're not creating PDF files, alias should have given us the 1933 # path to an EPS file. latex can get its dimmensions no problem! 1934 1935 $out = "\\includegraphics[width=$width_ratio\\linewidth]{$imagePath}\n"; 1936 } 1937 } elsif ($displayMode eq 'Latex2HTML') { 1938 my $wid = ($envir->{onTheFlyImageSize} || 0)+ 30; 1939 $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 1940 \\end{rawhtml}\n ! 1941 } elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng' || $displayMode eq 'HTML_img' || $displayMode eq 'HTML_jsMath' || $displayMode eq 'HTML_asciimath') { 1942 my $wid = ($envir->{onTheFlyImageSize} || 0) +30; 1943 $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> 1944 ! 1945 } else { 1946 $out = "Error: PGbasicmacros: image: Unknown displayMode: $displayMode.\n"; 1947 } 1948 push(@output_list, $out); 1949 } 1950 return wantarray ? @output_list : $output_list[0]; 1951 } 1952 1953 # This is legacy code. 1954 sub images { 1955 my @in = @_; 1956 my @outlist = (); 1957 while (@in) { 1958 push(@outlist,&image( shift(@in) ) ); 1959 } 1960 @outlist; 1961 } 1962 1963 1964 sub caption { 1965 my ($out) = @_; 1966 $out = " $out \n" if $displayMode eq 'TeX'; 1967 $out = " $out " if $displayMode eq 'HTML'; 1968 $out = " $out " if $displayMode eq 'HTML_tth'; 1969 $out = " $out " if $displayMode eq 'HTML_dpng'; 1970 $out = " $out " if $displayMode eq 'HTML_img'; 1971 $out = " $out " if $displayMode eq 'HTML_jsMath'; 1972 $out = " $out " if $displayMode eq 'HTML_asciimath'; 1973 $out = " $out " if $displayMode eq 'Latex2HTML'; 1974 $out; 1975 } 1976 1977 sub captions { 1978 my @in = @_; 1979 my @outlist = (); 1980 while (@in) { 1981 push(@outlist,&caption( shift(@in) ) ); 1982 } 1983 @outlist; 1984 } 1985 1986 sub imageRow { 1987 1988 my $pImages = shift; 1989 my $pCaptions=shift; 1990 my $out = ""; 1991 my @images = @$pImages; 1992 my @captions = @$pCaptions; 1993 my $number = @images; 1994 # standard options 1995 my %options = ( 'tex_size' => 200, # width for fitting 4 across 1996 'height' => 100, 1997 'width' => 100, 1998 @_ # overwrite any default options 1999 ); 2000 2001 if ($displayMode eq 'TeX') { 2002 $out .= "\n\\par\\smallskip\\begin{center}\\begin{tabular}{" . "|c" x $number . "|} \\hline\n"; 2003 while (@images) { 2004 $out .= &image( shift(@images),%options ) . '&'; 2005 } 2006 chop($out); 2007 $out .= "\\\\ \\hline \n"; 2008 while (@captions) { 2009 $out .= &caption( shift(@captions) ) . '&'; 2010 } 2011 chop($out); 2012 $out .= "\\\\ \\hline \n\\end {tabular}\\end{center}\\par\\smallskip\n"; 2013 } elsif ($displayMode eq 'Latex2HTML'){ 2014 2015 $out .= "\n\\begin{rawhtml} <TABLE BORDER=1><TR>\n\\end{rawhtml}\n"; 2016 while (@images) { 2017 $out .= "\n\\begin{rawhtml} <TD>\n\\end{rawhtml}\n" . &image( shift(@images),%options ) 2018 . "\n\\begin{rawhtml} </TD>\n\\end{rawhtml}\n" ; 2019 } 2020 2021 $out .= "\n\\begin{rawhtml}</TR><TR>\\end{rawhtml}\n"; 2022 while (@captions) { 2023 $out .= "\n\\begin{rawhtml} <TH>\n\\end{rawhtml}\n".&caption( shift(@captions) ) 2024 . "\n\\begin{rawhtml} </TH>\n\\end{rawhtml}\n" ; 2025 } 2026 2027 $out .= "\n\\begin{rawhtml} </TR> </TABLE >\n\\end{rawhtml}"; 2028 } elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng'|| $displayMode eq 'HTML_img' || $displayMode eq 'HTML_jsMath' || $displayMode eq 'HTML_asciimath'){ 2029 $out .= "<P>\n <TABLE BORDER=2 CELLPADDING=3 CELLSPACING=2 ><TR ALIGN=CENTER VALIGN=MIDDLE>\n"; 2030 while (@images) { 2031 $out .= " \n<TD>". &image( shift(@images),%options ) ."</TD>"; 2032 } 2033 $out .= "</TR>\n<TR>"; 2034 while (@captions) { 2035 $out .= " <TH>". &caption( shift(@captions) ) ."</TH>"; 2036 } 2037 $out .= "\n</TR></TABLE></P>\n" 2038 } 2039 else { 2040 $out = "Error: PGbasicmacros: imageRow: Unknown languageMode: $displayMode.\n"; 2041 warn $out; 2042 } 2043 $out; 2044 } 2045 2046 2047 ########### 2048 # Auxiliary macros 2049 2050 sub display_options2{ 2051 my %options = @_; 2052 my $out_string = ""; 2053 foreach my $key (keys %options) { 2054 $out_string .= " $key => $options{$key},<BR>"; 2055 } 2056 $out_string; 2057 } 2058 2059 2060 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |