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