[system] / trunk / pg / macros / PG.pl Repository:
ViewVC logotype

Diff of /trunk/pg/macros/PG.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 6247 Revision 6248
1
2#use AnswerEvaluator;
3
4
5# provided by the translator
6# initialize PGcore and PGrandom
7
8
9 $main::VERSION ="WW2";
10
11sub _PG_init{
12 $main::VERSION ="WW2.9+";
13}
14sub not_null {PGcore::not_null(@_)};
15
16
17our $PG;
18
19sub DEBUG_MESSAGE {
20 $PG->append_debug_message(@_);
21}
22
23
24sub DOCUMENT {
25
26 # get environment
27 $rh_envir = \%envir; #KLUDGE FIXME
28 # warn "rh_envir is ",ref($rh_envir);
29 $PG = new PGcore($rh_envir, # can add key/value options to modify
30 );
31 $PG->clear_internal_debug_messages;
32
33 # initialize main:: variables
34
35 $ANSWER_PREFIX = $PG->{ANSWER_PREFIX};
36 $QUIZ_PREFIX = $PG->{QUIZ_PREFIX};
37 $showPartialCorrectAnswers = $PG->{PG_FLAGS}->{showPartialCorrectAnswers};
38 $showHint = $PG->{PG_FLAGS}->{showHint};
39 $solutionExists = $PG->{PG_FLAGS}->{solutionExists};
40 $hintExists = $PG->{PG_FLAGS}->{hintExists};
41 $pgComment = '';
42 %gifs_created = %{ $PG->{gifs_created}};
43 %external_refs = %{ $PG->{external_refs}};
44
45 @KEPT_EXTRA_ANSWERS =(); #temporary hack
46
47 my %envir = %$rh_envir;
48 $displayMode = $PG->{displayMode};
49 $PG_random_generator = $PG->{PG_random_generator};
50 # Save the file name for use in error messages
51 # Doesn't appear to be used FIXME
52# my ($callpkg,$callfile) = caller(0);
53# $envir{__files__}{$callfile} = $envir{templateDirectory}.$envir{fileName};
54
55 #no strict;
56 foreach my $var (keys %envir) {
57 PG_restricted_eval(qq!\$main::$var = \$envir{$var}!); #whew!! makes sure $var is interpolated but $main:: is evaluated at run time.
58 warn "Problem defining $var while initializing the PG problem: $@" if $@;
59 }
60 #use strict;
61 #FIXME
62 # load java script needed for displayModes
63 if ($envir{displayMode} eq 'HTML_jsMath') {
64 my $prefix = "";
65 if (!$envir{jsMath}{reportMissingFonts}) {
66 $prefix .= '<SCRIPT>noFontMessage = 1</SCRIPT>'."\n";
67 } elsif ($main::envir{jsMath}{missingFontMessage}) {
68 $prefix .= '<SCRIPT>missingFontMessage = "'.$main::envir{jsMath}{missingFontMessage}.'"</SCRIPT>'."\n";
69 }
70 $prefix .= '<SCRIPT>processDoubleClicks = '.($main::envir{jsMath}{processDoubleClicks}?'1':'0')."</SCRIPT>\n";
71 TEXT(
72 $prefix,
73 '<SCRIPT SRC="'.$envir{jsMathURL}. '"></SCRIPT>' . "\n" ,
74 '<NOSCRIPT><CENTER><FONT COLOR="#CC0000">' ,
75 "$BBOLD", 'Warning: the mathematics on this page requires JavaScript.', ,$BR,
76 'If your browser supports it, be sure it is enabled.',
77 "$EBOLD",
78 '</FONT></CENTER><p>
79 </NOSCRIPT>'
80 );
81 TEXT('<SCRIPT>jsMath.Setup.Script("plugins/noImageFonts.js")</SCRIPT>')
82 if ($envir{jsMath}{noImageFonts});
83 } elsif ($envir{displayMode} eq 'HTML_asciimath') {
84 TEXT('<SCRIPT SRC="'.$main::envir{asciimathURL}.'"></SCRIPT>' . "\n" ,
85 '<SCRIPT>mathcolor = "black"</SCRIPT>' );
86 } elsif ($envir{displayMode} eq 'HTML_LaTeXMathML') {
87 TEXT('<SCRIPT SRC="'.$envir{LaTeXMathMLURL}.'"></SCRIPT>'."\n");
88
89 }
90
91}
92$main::displayMode = $PG->{displayMode};
93$main::PG = $PG;
94sub TEXT {
95 $PG->TEXT(@_) ;
96}
97
98sub HEADER_TEXT {
99 $PG->HEADER_TEXT(@_);
100}
101
102sub LABELED_ANS {
103 $PG->LABELED_ANS(@_); # returns pointer to the labeled answer group
104}
105
106sub NAMED_ANS {
107 $PG->LABELED_ANS(@_); # returns pointer to the labeled answer group
108}
109
110sub ANS {
111 #warn "using PGnew for ANS";
112 $PG->ANS(@_); # returns pointer to the labeled answer group
113}
114
115sub RECORD_ANS_NAME {
116 $PG->record_ans_name(@_);
117}
118
119sub inc_ans_rule_count {
120 #$PG->{unlabeled_answer_blank_count}++;
121 #my $num = $PG->{unlabeled_answer_blank_count};
122 DEBUG_MESSAGE( " using PG to inc_ans_rule_count = $num ", caller(2));
123 warn " using PG to inc_ans_rule_count = $num ", caller(2);
124 $PG->{unlabeled_answer_blank_count};
125}
126sub ans_rule_count {
127 $PG->{unlabeled_answer_blank_count};
128}
129sub NEW_ANS_NAME {
130 return "" if $PG_STOP_FLAG;
131 #my $number=shift;
132 # we have an internal count so the number not actually used.
133 my $name =$PG->record_unlabeled_ans_name();
134 $name;
135}
136sub NEW_ARRAY_NAME {
137 return "" if $PG_STOP_FLAG;
138 my $name =$PG->record_unlabeled_array_name();
139 $name;
140}
141
142# new subroutine
143sub NEW_ANS_BLANK {
144 return "" if $PG_STOP_FLAG;
145 $PG->record_unlabeled_ans_name(@_);
146}
147
148sub ANS_NUM_TO_NAME {
149 $PG->new_label(@_); # behaves as in PG.pl
150}
151
152sub store_persistent_data {
153 $PG->store_persistent_data(@_); #needs testing
154}
155sub RECORD_FORM_LABEL { # this stores form data (such as sticky answers), but does nothing more
156 # it's a bit of hack since we are storing these in the
157 # KEPT_EXTRA_ANSWERS queue even if they aren't answers per se.
158 warn "Using RECORD_FORM_LABEL -- deprecated?";
159 RECORD_EXTRA_ANSWERS(@_);
160}
161
162sub RECORD_EXTRA_ANSWERS {
163 return "" if $PG_STOP_FLAG;
164 my $label = shift; # the label of the input box or textarea
165 eval(q!push(@main::KEPT_EXTRA_ANSWERS, $label)!); #put the labels into the hash to be caught later for recording purposes
166 $label;
167
168}
169
170
171sub NEW_ANS_ARRAY_NAME { # this keeps track of the answers within an array which are entered implicitly,
172 # rather than with a specific label
173 return "" if $PG_STOP_FLAG;
174 my $number=shift;
175 $main::vecnum = -1;
176 my $row = shift;
177 my $col = shift;
178# my $array_ans_eval_label = "ArRaY"."$number"."__"."$vecnum".":";
179 my $label = $PG->{QUIZ_PREFIX}.$PG->{ARRAY_PREFIX}."$number"."__"."$vecnum".":"."$row".":"."$col"."__";
180# my $response_group = new PGresponsegroup($label,undef);
181# $PG->record_ans_name($array_ans_eval_label, $response_group);
182# What does vecnum do?
183# The name is simply so that it won't conflict when placed on the HTML page
184# my $array_label = shift;
185 $PG->record_array_name($label); # returns $array_label, $ans_label
186}
187
188sub NEW_ANS_ARRAY_NAME_EXTENSION {
189 NEW_ANS_ARRAY_ELEMENT_NAME(@_);
190}
191
192sub NEW_ANS_ARRAY_ELEMENT_NAME { # creates a new array element answer name and records it
193
194 return "" if $PG_STOP_FLAG;
195 my $number=shift;
196 my $row_num = shift;
197 my $col_num = shift;
198 if( $row_num == 0 && $col_num == 0 ){
199 $main::vecnum += 1;
200 }
201# my $ans_label = "ArRaY".sprintf("%04u", $number);
202 my $ans_label = $PG->new_array_label($number);
203 my $element_ans_label = $PG->new_array_element_label($ans_label,$row_num, $col_num,vec_num=>$vecnum);
204 my $response = new PGresponsegroup($ans_label,$element_ans_label, undef);
205 $PG->extend_ans_group($ans_label,$response);
206 $element_ans_label;
207}
208sub NEW_LABELED_ANS_ARRAY { #not in PG_original
209 my $ans_label = shift;
210 my @response_list = @_;
211 #$PG->extend_ans_group($ans_label,@response_list);
212 $PG->{PG_ANSWERS_HASH}->{$ans_label}->insert_responses(@response_list);
213 # should this return an array of labeled answer blanks???
214}
215sub EXTEND_ANS_ARRAY { #not in PG_original
216 my $ans_label = shift;
217 my @response_list = @_;
218 #$PG->extend_ans_group($ans_label,@response_list);
219 $PG->{PG_ANSWERS_HASH}->{$ans_label}->append_responses(@response_list);
220}
221sub CLEAR_RESPONSES {
222 my $ans_label = shift;
223# my $response_label = shift;
224# my $ans_value = shift;
225 if (defined ($PG->{PG_ANSWERS_HASH}->{$ans_label}) ) {
226 my $responsegroup = $PG->{PG_ANSWERS_HASH}->{$ans_label}->{response};
227 if ( ref($responsegroup) ) {
228 $responsegroup->clear;
229 } else {
230 $responsegroup = $PG->{PG_ANSWERS_HASH}->{$ans_label}->{response} = new PGresponsegroup($label);
231 }
232 }
233 '';
234}
235sub INSERT_RESPONSE {
236 my $ans_label = shift;
237 my $response_label = shift;
238 my $ans_value = shift;
239 my $selected = shift;
240 # warn "\n\nanslabel $ans_label responselabel $response_label value $ans_value";
241 if (defined ($PG->{PG_ANSWERS_HASH}->{$ans_label}) ) {
242 my $responsegroup = $PG->{PG_ANSWERS_HASH}->{$ans_label}->{response};
243 $responsegroup->append_response($response_label, $ans_value, $selected);
244 #warn "\n$responsegroup responses are now ", $responsegroup->responses;
245 }
246 '';
247}
248
249sub EXTEND_RESPONSE { # for radio buttons and checkboxes
250 my $ans_label = shift;
251 my $response_label = shift;
252 my $ans_value = shift;
253 my $selected = shift;
254 # warn "\n\nanslabel $ans_label responselabel $response_label value $ans_value";
255 if (defined ($PG->{PG_ANSWERS_HASH}->{$ans_label}) ) {
256 my $responsegroup = $PG->{PG_ANSWERS_HASH}->{$ans_label}->{response};
257 $responsegroup->extend_response($response_label, $ans_value,$selected);
258 warn "\n$responsegroup responses are now ", pretty_print($response_group);
259 }
260 '';
261}
262sub ENDDOCUMENT {
263 # check that answers match
264 # gather up PG_FLAGS elements
265
266
267 my @elements = qw(showPartialCorrectAnswers
268 recordSubmittedAnswers refreshCachedImages
269 hintExists solutionExists
270 );
271 while (@elements) {
272 my $var= shift @elements;
273 $PG->{PG_FLAGS}->{$var} = ${$var};
274 }
275 $PG->{PG_FLAGS}->{comment} = $pgComment; #KLUDGE #FIXME
276 $PG->{PG_FLAGS}->{showHintLimit} = $showHint; #KLUDGE #FIXME
277
278
279 # install problem grader
280 if (defined($PG->{PG_FLAGS}->{PROBLEM_GRADER_TO_USE}) ) {
281 # problem grader defined within problem -- no further action needed
282 } elsif ( defined( $rh_envir->{PROBLEM_GRADER_TO_USE} ) ) {
283 if (ref($rh_envir->{PROBLEM_GRADER_TO_USE}) eq 'CODE' ) { # user defined grader
284 $PG->{PG_FLAGS}->{PROBLEM_GRADER_TO_USE} = $rh_envir->{PROBLEM_GRADER_TO_USE};
285 } elsif ($rh_envir->{PROBLEM_GRADER_TO_USE} eq 'std_problem_grader' ) {
286 if (defined(&std_problem_grader) ){
287 $PG->{PG_FLAGS}->{PROBLEM_GRADER_TO_USE} = \&std_problem_grader; # defined in PGanswermacros.pl
288 } # std_problem_grader is the default in any case so don't give a warning.
289 } elsif ($rh_envir->{PROBLEM_GRADER_TO_USE} eq 'avg_problem_grader' ) {
290 if (defined(&avg_problem_grader) ){
291 $PG->{PG_FLAGS}->{PROBLEM_GRADER_TO_USE} = \&avg_problem_grader; # defined in PGanswermacros.pl
292 }
293 } else {
294 warn "Error: ". $PG->{PG_FLAGS}->{PROBLEM_GRADER_TO_USE} . "is not a known program grader.";
295 }
296 } elsif (defined(&std_problem_grader)) {
297 $PG->{PG_FLAGS}->{PROBLEM_GRADER_TO_USE} = \&std_problem_grader; # defined in PGanswermacros.pl
298 } else {
299 # PGtranslator will install its default problem grader
300 }
301
302 # add javaScripts
303 if ($rh_envir->{displayMode} eq 'HTML_jsMath') {
304 TEXT('<SCRIPT> jsMath.wwProcess() </SCRIPT>');
305 } elsif ($rh_envir->{displayMode} eq 'HTML_asciimath') {
306 TEXT('<SCRIPT> translate() </SCRIPT>');
307 my $STRING = join("", @{$PG->{HEADER_ARRAY} });
308 unless ($STRING =~ m/mathplayer/) {
309 HEADER_TEXT('<object id="mathplayer" classid="clsid:32F66A20-7614-11D4-BD11-00104BD3F987">' . "\n" .
310 '</object><?import namespace="mml" implementation="#mathplayer"?>'
311 );
312 }
313
314 }
315 TEXT( MODES(%{$rh_envir->{problemPostamble}}) );
316
317
318
319
320
321 @PG_ANSWERS=();
322
323 #warn keys %{ $PG->{PG_ANSWERS_HASH} };
324 @PG_ANSWER_ENTRY_ORDER = ();
325 my $ans_debug = 0;
326 foreach my $key (keys %{ $PG->{PG_ANSWERS_HASH} }) {
327 $answergroup = $PG->{PG_ANSWERS_HASH}->{$key};
328 #warn "$key is defined =", defined($answergroup), "PG object is $PG";
329 #################
330 # EXTRA ANSWERS KLUDGE
331 #################
332 # The first response in each answer group is placed in @PG_ANSER_ENTRY_ORDER and %PG_ANSWERS_HASH
333 # The remainder of the response keys are placed in the EXTRA ANSWERS ARRAY
334 if (defined($answergroup)) {
335 my @response_keys = $answergroup->{response}->response_labels;
336 warn pretty_print($answergroup->{response}) if $ans_debug==1;
337 my $response_key = shift @response_keys;
338 #unshift @response_keys, $response_key unless ($response_key eq $answer_group->{ans_label});
339 # don't save the first response key if it is the same as the ans_label
340 # maybe we should insure that the first response key is always the same as the answer label?
341 # even if no answer blank is printed for it? or a hidden answer blank?
342 # this is still a KLUDGE
343 # for compatibility the first response key is closer to the old method than the $ans_label
344 # this is because a response key might indicate an array but an answer label won't
345 push @PG_ANSWERS, $response_key,$answergroup->{ans_eval};
346 push @PG_ANSWER_ENTRY_ORDER, $response_key;
347 push @KEPT_EXTRA_ANSWERS, @response_keys;
348 } else {
349 #warn "$key is ", join("|",%{$PG->{PG_ANSWERS_HASH}->{$key}});
350 }
351 }
352 push @KEPT_EXTRA_ANSWERS, keys %{$PG->{PERSISTENCE_HASH}};
353 my %PG_ANSWERS_HASH = @PG_ANSWERS;
354 $PG->{PG_FLAGS}->{KEPT_EXTRA_ANSWERS} = \@KEPT_EXTRA_ANSWERS;
355 $PG->{PG_FLAGS}->{ANSWER_ENTRY_ORDER} = \@PG_ANSWER_ENTRY_ORDER;
356 warn "KEPT_EXTRA_ANSWERS", join(" ", @KEPT_EXTRA_ANSWERS), $BR if $ans_debug==1;
357 warn "PG_ANSWER_ENTRY_ORDER",join(" ",@PG_ANSWER_ENTRY_ORDER), $BR if $ans_debug==1;
358 warn "DEBUG messages", join( "$BR",@{$PG->get_debug_messages} ) if $ans_debug==1;
359 warn "INTERNAL_DEBUG messages", join( "$BR",@{$PG->get_internal_debug_messages} ) if $ans_debug==1;
360 $STRINGforOUTPUT = join("", @{$PG->{OUTPUT_ARRAY} });
361
362
363 $STRINGforHEADER_TEXT = join("", @{$PG->{HEADER_ARRAY} });
364
365 # warn pretty_print($PG->{PG_ANSWERS_HASH});
366 #warn "printing another warning";
367
368 (\$STRINGforOUTPUT, \$STRINGforHEADER_TEXT,\%PG_ANSWERS_HASH, $PG->{PG_FLAGS} , $PG );
369}
370################################################################################
371#
372# macros from dangerousMacros
373#
374################################################################################
375sub alias {
376 #warn "alias called ",@_;
377 $PG->{PG_alias}->make_alias(@_) ;
378}
379sub insertGraph {
380 $PG->insertGraph(@_);
381}
382
383sub findMacroFile {
384 $PG->{PG_alias}->findMacroFile(@_);
385}
386sub check_url {
387 $PG->{PG_alias}->check_url(@_);
388}
389sub findAppletCodebase {
390 $PG->{PG_alias}->findAppletCodebase(@_);
391}
392
393sub loadMacros {
394 $PG->{PG_loadMacros}->loadMacros(@_);
395}
396# FIXME? these were taken from the former dangerousMacros.pl file and might have issues when placed here.
397#
398# Some constants that can be used in perl experssions
399#
400
401# ^function i
402# ^uses $_parser_loaded
403# ^uses &Complex::i
404# ^uses &Value::Package
405sub i () {
406 # check if Parser.pl is loaded, otherwise use Complex package
407 if (!eval(q!$main::_parser_loaded!)) {return Complex::i}
408 return Value->Package("Formula")->new('i')->eval;
409}
410
411# ^function j
412# ^uses $_parser_loaded
413# ^uses &Value::Package
414sub j () {
415 if (!eval(q!$main::_parser_loaded!)) {return 'j'}
416 Value->Package("Formula")->new('j')->eval;
417}
418
419# ^function k
420# ^uses $_parser_loaded
421# ^uses &Value::Package
422sub k () {
423 if (!eval(q!$main::_parser_loaded!)) {return 'k'}
424 Value->Package("Formula")->new('k')->eval;
425}
426
427# ^function pi
428# ^uses &Value::Package
429sub pi () {Value->Package("Formula")->new('pi')->eval}
430
431# ^function Infinity
432# ^uses &Value::Package
433sub Infinity () {Value->Package("Infinity")->new()}
434
435
436# ^function abs
437# ^function sqrt
438# ^function exp
439# ^function log
440# ^function sin
441# ^function cos
442# ^function atan2
443#
444# Allow these functions to be overridden
445# (needed for log() to implement $useBaseTenLog)
446#
447use subs 'abs', 'sqrt', 'exp', 'log', 'sin', 'cos', 'atan2';
448sub abs($) {return CORE::abs($_[0])};
449sub sqrt($) {return CORE::sqrt($_[0])};
450sub exp($) {return CORE::exp($_[0])};
451sub log($) {return CORE::log($_[0])};
452sub sin($) {return CORE::sin($_[0])};
453sub cos($) {return CORE::cos($_[0])};
454sub atan2($$) {return CORE::atan2($_[0],$_[1])};
455
456sub Parser::defineLog {eval {sub log($) {CommonFunction->Call("log",@_)}}};
457=head2 Filter utilities
458
459These two subroutines can be used in filters to set default options. They
460help make filters perform in uniform, predictable ways, and also make it
461easy to recognize from the code which options a given filter expects.
462
463
464=head4 assign_option_aliases
465
466Use this to assign aliases for the standard options. It must come before set_default_options
467within the subroutine.
468
469 assign_option_aliases(\%options,
470 'alias1' => 'option5'
471 'alias2' => 'option7'
472 );
473
474
475If the subroutine is called with an option " alias1 => 23 " it will behave as if it had been
476called with the option " option5 => 23 "
477
478=cut
479
480
481# ^function assign_option_aliases
482sub assign_option_aliases {
483 my $rh_options = shift;
484 warn "The first entry to set_default_options must be a reference to the option hash" unless ref($rh_options) eq 'HASH';
485 my @option_aliases = @_;
486 while (@option_aliases) {
487 my $alias = shift @option_aliases;
488 my $option_key = shift @option_aliases;
489
490 if (defined($rh_options->{$alias} )) { # if the alias appears in the option list
491 if (not defined($rh_options->{$option_key}) ) { # and the option itself is not defined,
492 $rh_options->{$option_key} = $rh_options->{$alias}; # insert the value defined by the alias into the option value
493 # the FIRST alias for a given option takes precedence
494 # (after the option itself)
495 } else {
496 warn "option $option_key is already defined as", $rh_options->{$option_key}, "<br>\n",
497 "The attempt to override this option with the alias $alias with value ", $rh_options->{$alias},
498 " was ignored.";
499 }
500 }
501 delete($rh_options->{$alias}); # remove the alias from the initial list
502 }
503
504}
505
506=head4 set_default_options
507
508 set_default_options(\%options,
509 '_filter_name' => 'filter',
510 'option5' => .0001,
511 'option7' => 'ascii',
512 'allow_unknown_options => 0,
513 }
514
515Note that the first entry is a reference to the options with which the filter was called.
516
517The option5 is set to .0001 unless the option is explicitly set when the subroutine is called.
518
519The B<'_filter_name'> option should always be set, although there is no error if it is missing.
520It is used mainly for debugging answer evaluators and allows
521you to keep track of which filter is currently processing the answer.
522
523If B<'allow_unknown_options'> is set to 0 then if the filter is called with options which do NOT appear in the
524set_default_options list an error will be signaled and a warning message will be printed out. This provides
525error checking against misspelling an option and is generally what is desired for most filters.
526
527Occasionally one wants to write a filter which accepts a long list of options, not all of which are known in advance,
528but only uses a subset of the options
529provided. In this case, setting 'allow_unkown_options' to 1 prevents the error from being signaled.
530
531=cut
532
533# ^function set_default_options
534# ^uses pretty_print
535sub set_default_options {
536 my $rh_options = shift;
537 warn "The first entry to set_default_options must be a reference to the option hash" unless ref($rh_options) eq 'HASH';
538 my %default_options = @_;
539 unless ( defined($default_options{allow_unknown_options}) and $default_options{allow_unknown_options} == 1 ) {
540 foreach my $key1 (keys %$rh_options) {
541 warn "This option |$key1| is not recognized in this subroutine<br> ", pretty_print($rh_options) unless exists($default_options{$key1});
542 }
543 }
544 foreach my $key (keys %default_options) {
545 if ( not defined($rh_options->{$key} ) and defined( $default_options{$key} ) ) {
546 $rh_options->{$key} = $default_options{$key}; #this allows tol => undef to allow the tol option, but doesn't define
547 # this key unless tol is explicitly defined.
548 }
549 }
550}
5511;
552__END__
553
1################################################################################ 554################################################################################
2# WeBWorK Online Homework Delivery System 555# WeBWorK Online Homework Delivery System
3# Copyright 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/ 556# Copyright 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
4# $CVSHeader$ 557# $CVSHeader: pg/macros/PG.pl,v 1.40 2009/06/25 23:28:44 gage Exp $
5# 558#
6# This program is free software; you can redistribute it and/or modify it under 559# 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 560# 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 561# Free Software Foundation; either version 2, or (at your option) any later
9# version, or (b) the "Artistic License" which comes with this package. 562# version, or (b) the "Artistic License" which comes with this package.
91up the results of problem processing for delivery back to WeBWorK. 644up the results of problem processing for delivery back to WeBWorK.
92 645
93The HEADER_TEXT(), TEXT(), and ANS() macros add to the header text string, 646The HEADER_TEXT(), TEXT(), and ANS() macros add to the header text string,
94body text string, and answer evaluator queue, respectively. 647body text string, and answer evaluator queue, respectively.
95 648
96=cut
97
98BEGIN {
99 be_strict();
100}
101
102sub _PG_init{
103
104}
105
106#package PG;
107
108# Private variables for the PG.pl file.
109
110# ^variable my $STRINGforOUTPUT
111my $STRINGforOUTPUT;
112# ^variable my $STRINGforHEADER_TEXT
113my $STRINGforHEADER_TEXT;
114# ^variable my @PG_ANSWERS
115my @PG_ANSWERS;
116# ^variable my @PG_UNLABELED_ANSWERS
117my @PG_UNLABELED_ANSWERS;
118# ^variable my %PG_ANSWERS_HASH
119my %PG_ANSWERS_HASH;
120
121# ^variable our $PG_STOP_FLAG
122our $PG_STOP_FLAG;
123
124# my variables are unreliable if two DOCUMENTS were to be called before an ENDDOCUMENT
125# there could be conflicts. As I understand the behavior of the Apache child
126# this cannot occur -- a child finishes with one request before obtaining the next
127
128################################################################################
129
130=head1 MACROS
131
132These macros may be used from PG problem files.
133
134=over 649=over
135
136=item DOCUMENT()
137
138DOCUMENT() should be the first statement in each problem template. It can
139only be used once in each problem.
140
141DOCUMENT() initializes some empty variables and unpacks the variables in the
142%envir hash which is implicitly passed from WeBWorK to the problem. It must be
143the first statement in any problem. It also unpacks any answers submitted and
144places them in the @submittedAnswer list, saves the problem seed in
145$PG_original_problemSeed in case you need it later, and initializes the pseudo
146random number generator object in $PG_random_generator.
147
148You can reset the standard number generator using the command:
149
150 $PG_random_generator->srand($new_seed_value);
151
152See also SRAND() in the L<PGbasicmacros.pl> file.
153
154=cut
155
156# ^function DOCUMENT
157# ^uses $STRINGforOUTPUT
158# ^uses $STRINGforHEADER_TEXT
159# ^uses @PG_ANSWERS
160# ^uses $PG_STOP_FLAG
161# ^uses @PG_UNLABELED_ANSWERS
162# ^uses %PG_ANSWERS_HASH
163# ^uses @PG_ANSWER_ENTRY_ORDER
164# ^uses $ANSWER_PREFIX
165# ^uses %PG_FLAGS
166# ^uses $showPartialCorrectAnswers
167# ^uses $showHints
168# ^uses $solutionExists
169# ^uses $hintExists
170# ^uses $pgComment
171# ^uses %gifs_created
172# ^uses %envir
173# ^uses $refSubmittedAnswers
174# ^uses @submittedAnswers
175# ^uses $PG_original_problemSeed
176# ^uses $problemSeed
177# ^uses $PG_random_generator
178# ^uses $ans_rule_count
179# ^uses $QUIZ_PREFIX
180# (Also creates a package scalar named after each key in %envir containing a copy of the corresponding value.)
181# ^uses &PGrandom::new
182sub DOCUMENT {
183
184 $STRINGforOUTPUT ="";
185 $STRINGforHEADER_TEXT ="";
186 @PG_ANSWERS=();
187 $PG_STOP_FLAG=0;
188 @PG_UNLABELED_ANSWERS = ();
189 %PG_ANSWERS_HASH = ();
190 # FIXME: We are initializing these variables into both Safe::Root1 (the cached safe compartment)
191 # and Safe::Root2 (the current one)
192 # There is a good chance they won't be properly updated in one or the other of these compartments.
193
194
195# @main::PG_ANSWER_ENTRY_ORDER = ();
196# $main::ANSWER_PREFIX = 'AnSwEr';
197# %main::PG_FLAGS=(); #global flags
198# $main::showPartialCorrectAnswers = 0 unless defined($main::showPartialCorrectAnswers );
199# $main::showHint = 1 unless defined($main::showHint);
200# $main::solutionExists =0;
201# $main::hintExists =0;
202# %main::gifs_created = ();
203 eval(q!
204 # set perl to use capital E for scientific notation: e.g. 5.4E-05 instead of 5.4e-05
205 # $#="%G"; #FIXME -- this causes bad warnings in perl 5.10
206
207 @main::PG_ANSWER_ENTRY_ORDER = ();
208 $main::ANSWER_PREFIX = 'AnSwEr';
209 %main::PG_FLAGS=(); #global flags
210 $main::showPartialCorrectAnswers = 0 unless defined($main::showPartialCorrectAnswers );
211 $main::showHint = 1 unless defined($main::showHint);
212 $main::solutionExists =0;
213 $main::hintExists =0;
214 $main::pgComment = '';
215 %main::gifs_created = ();
216
217 !);
218# warn eval(q! "PG.pl: The envir variable $main::{envir} is".join(" ",%main::envir)!);
219 my $rh_envir = eval(q!\%main::envir!);
220 my %envir = %$rh_envir;
221
222 # Save the file name for use in error messages
223 my ($callpkg,$callfile) = caller(0);
224 $envir{__files__}{$callfile} = $envir{templateDirectory}.$envir{fileName};
225
226 #no strict;
227 foreach my $var (keys %envir) {
228 eval(q!$main::!.$var.q! = $main::envir{!.$var.q!}! ); #whew!! makes sure $var is interpolated but $main:: is evaluated at run time.
229 # warn eval(q! "var $var is defined ". $main::!.$var);
230 warn "Problem defining ", q{\$main::}.$var, " while initializing the PG problem: $@" if $@;
231 }
232 #use strict;
233 #FIXME these strict pragmas don't seem to be needed and they cause trouble in perl 5.6.0
234
235
236
237 eval(q!
238 @main::submittedAnswers = @{$main::refSubmittedAnswers} if defined($main::refSubmittedAnswers);
239 $main::PG_original_problemSeed = $main::problemSeed;
240 $main::PG_random_generator = new PGrandom($main::problemSeed) || die "Can't create random number generator.";
241 $main::ans_rule_count = 0; # counts questions
242
243 # end unpacking of environment variables.
244 $main::QUIZ_PREFIX = '' unless defined($main::QUIZ_PREFIX)
245
246 !);
247# @main::submittedAnswers = @{$main::refSubmittedAnswers} if defined($main::refSubmittedAnswers);
248# $main::PG_original_problemSeed = $main::problemSeed;
249# $main::PG_random_generator = new PGrandom($main::problemSeed) || die "Can't create random number generator.";
250# $main::ans_rule_count = 0; # counts questions
251
252 # end unpacking of environment variables.
253# $main::QUIZ_PREFIX = '' unless defined($main::QUIZ_PREFIX)
254
255 if ($main::envir{displayMode} eq 'HTML_jsMath') {
256 my $prefix = "";
257 if (!$main::envir{jsMath}{reportMissingFonts}) {
258 $prefix .= '<SCRIPT>noFontMessage = 1</SCRIPT>'."\n";
259 } elsif ($main::envir{jsMath}{missingFontMessage}) {
260 $prefix .= '<SCRIPT>missingFontMessage = "'.$main::envir{jsMath}{missingFontMessage}.'"</SCRIPT>'."\n";
261 }
262 $prefix .= '<SCRIPT>processDoubleClicks = '.($main::envir{jsMath}{processDoubleClicks}?'1':'0')."</SCRIPT>\n";
263 $STRINGforOUTPUT =
264 $prefix .
265 '<SCRIPT SRC="'.$main::envir{jsMathURL}.'"></SCRIPT>' . "\n" .
266 '<NOSCRIPT><CENTER><FONT COLOR="#CC0000">' .
267 '<B>Warning: the mathematics on this page requires JavaScript.<BR>' .
268 'If your browser supports it, be sure it is enabled.</B>'.
269 '</FONT></CENTER><p></NOSCRIPT>' .
270 $STRINGforOUTPUT;
271 $STRINGforOUTPUT .=
272 '<SCRIPT>jsMath.Setup.Script("plugins/noImageFonts.js")</SCRIPT>'
273 if ($main::envir{jsMath}{noImageFonts});
274 }
275
276 $STRINGforOUTPUT = '<SCRIPT SRC="'.$main::envir{asciimathURL}.'"></SCRIPT>' . "\n" .
277 '<SCRIPT>mathcolor = "black"</SCRIPT>' . $STRINGforOUTPUT
278 if ($main::envir{displayMode} eq 'HTML_asciimath');
279
280 $STRINGforOUTPUT = '<SCRIPT SRC="'.$main::envir{LaTeXMathMLURL}.'"></SCRIPT>'."\n" . $STRINGforOUTPUT
281 if ($main::envir{displayMode} eq 'HTML_LaTeXMathML');
282
283}
284 650
285=item HEADER_TEXT() 651=item HEADER_TEXT()
286 652
287 HEADER_TEXT("string1", "string2", "string3"); 653 HEADER_TEXT("string1", "string2", "string3");
288 654
294 660
295Spaces are placed between the arguments during concatenation, but no spaces are 661Spaces are placed between the arguments during concatenation, but no spaces are
296introduced between the existing content of the header text string and the new 662introduced between the existing content of the header text string and the new
297content being appended. 663content being appended.
298 664
299=cut
300 665
301# ^function HEADER_TEXT
302# ^uses $STRINGforHEADER_TEXT
303sub HEADER_TEXT {
304 my @in = @_;
305 $STRINGforHEADER_TEXT .= join(" ",@in);
306 }
307 666
308=item TEXT() 667=item TEXT()
309 668
310 TEXT("string1", "string2", "string3"); 669 TEXT("string1", "string2", "string3");
311 670
324 683
325Spaces are placed between the arguments during concatenation, but no spaces are 684Spaces are placed between the arguments during concatenation, but no spaces are
326introduced between the existing content of the header text string and the new 685introduced between the existing content of the header text string and the new
327content being appended. 686content being appended.
328 687
329=cut
330 688
331# ^function TEXT
332# ^uses $PG_STOP_FLAG
333# ^uses $STRINGforOUTPUT
334sub TEXT {
335 return "" if $PG_STOP_FLAG;
336 my @in = @_;
337 $STRINGforOUTPUT .= join(" ",@in);
338}
339 689
340=item ANS() 690=item ANS()
341 691
342 TEXT(ans_rule(), ans_rule(), ans_rule()); 692 TEXT(ans_rule(), ans_rule(), ans_rule());
343 ANS($answer_evaluator1, $answer_evaluator2, $answer_evaluator3); 693 ANS($answer_evaluator1, $answer_evaluator2, $answer_evaluator3);
350answer rule, answer_evaluator2 with the second, and answer_evaluator3 with the 700answer rule, answer_evaluator2 with the second, and answer_evaluator3 with the
351third. In practice, the arguments to ANS() will usually be calls to an answer 701third. In practice, the arguments to ANS() will usually be calls to an answer
352evaluator generator such as the cmp() method of MathObjects or the num_cmp() 702evaluator generator such as the cmp() method of MathObjects or the num_cmp()
353macro in L<PGanswermacros.pl>. 703macro in L<PGanswermacros.pl>.
354 704
355=cut
356 705
357# ^function ANS
358# ^uses $PG_STOP_FLAG
359# ^uses @PG_ANSWERS
360sub ANS{
361 return "" if $PG_STOP_FLAG;
362 my @in = @_;
363 while (@in ) {
364 warn("<BR><B>Error in ANS:$in[0]</B> -- inputs must be references to
365 subroutines<BR>")
366 unless ref($in[0]);
367 push(@PG_ANSWERS, shift @in );
368 }
369}
370 706
371=item LABELED_ANS() 707=item LABELED_ANS()
372 708
373 TEXT(labeled_ans_rule("name1"), labeled_ans_rule("name2")); 709 TEXT(labeled_ans_rule("name1"), labeled_ans_rule("name2"));
374 LABELED_ANS(name1 => answer_evaluator1, name2 => answer_evaluator2); 710 LABELED_ANS(name1 => answer_evaluator1, name2 => answer_evaluator2);
376Adds the answer evaluators listed to the list of labeled answer evaluators. 712Adds the answer evaluators listed to the list of labeled answer evaluators.
377They will be paired with labeled answer rules (a.k.a. answer blanks) in the 713They will be paired with labeled answer rules (a.k.a. answer blanks) in the
378order entered. This allows pairing of answer evaluators and answer rules that 714order entered. This allows pairing of answer evaluators and answer rules that
379may not have been entered in the same order. 715may not have been entered in the same order.
380 716
381=cut
382 717
383# ^function LABELED_ANS
384# ^uses &NAMED_ANS
385sub LABELED_ANS {
386 &NAMED_ANS;
387}
388 718
389=item NAMED_ANS()
390
391Old name for LABELED_ANS(). DEPRECATED.
392
393=cut
394
395# ^function NAMED_ANS
396# ^uses $PG_STOP_FLAG
397sub NAMED_ANS{
398 return "" if $PG_STOP_FLAG;
399 my @in = @_;
400 while (@in ) {
401 my $label = shift @in;
402 $label = eval(q!$main::QUIZ_PREFIX.$label!);
403 my $ans_eval = shift @in;
404 TEXT("<BR><B>Error in NAMED_ANS:$in[0]</B>
405 -- inputs must be references to subroutines<BR>")
406 unless ref($ans_eval);
407 $PG_ANSWERS_HASH{$label}= $ans_eval;
408 }
409}
410 719
411=item STOP_RENDERING() 720=item STOP_RENDERING()
412 721
413 STOP_RENDERING() unless all_answers_are_correct(); 722 STOP_RENDERING() unless all_answers_are_correct();
414 723
415Temporarily suspends accumulation of problem text and storing of answer blanks 724Temporarily suspends accumulation of problem text and storing of answer blanks
416and answer evaluators until RESUME_RENDERING() is called. 725and answer evaluators until RESUME_RENDERING() is called.
417 726
418=cut
419 727
420# ^function STOP_RENDERING
421# ^uses $PG_STOP_FLAG
422sub STOP_RENDERING {
423 $PG_STOP_FLAG=1;
424 "";
425}
426 728
427=item RESUME_RENDERING() 729=item RESUME_RENDERING()
428 730
429 RESUME_RENDERING(); 731 RESUME_RENDERING();
430 732
431Resumes accumulating problem text and storing answer blanks and answer 733Resumes accumulating problem text and storing answer blanks and answer
432evaluators. Reverses the effect of STOP_RENDERING(). 734evaluators. Reverses the effect of STOP_RENDERING().
433 735
434=cut
435 736
436# ^function RESUME_RENDERING
437# ^uses $PG_STOP_FLAG
438sub RESUME_RENDERING {
439 $PG_STOP_FLAG=0;
440 "";
441}
442 737
443=item ENDDOCUMENT() 738=item ENDDOCUMENT()
444 739
445 ENDDOCUMENT(); 740 ENDDOCUMENT();
446 741
447When PG problems are evaluated, the result of evaluating the entire problem is 742When PG problems are evaluated, the result of evaluating the entire problem is
448interpreted as the return value of ENDDOCUMENT(). Therefore, ENDDOCUMENT() must 743interpreted as the return value of ENDDOCUMENT(). Therefore, ENDDOCUMENT() must
449be the last executable statement of every problem. It can only appear once. It 744be the last executable statement of every problem. It can only appear once. It
450returns a list consisting of: 745returns a list consisting of:
451 746
452=over 747
748
453 749
454=item * 750=item *
455 751
456A reference to a string containing the rendered text of the problem. 752A reference to a string containing the rendered text of the problem.
457 753
466 762
467=item * 763=item *
468 764
469A reference to a hash containing various flags: 765A reference to a hash containing various flags:
470 766
471=over 767
472 768
473=item * 769=item *
474 770
475C<showPartialCorrectAnswers>: determines whether students are told which of their answers in a problem are wrong. 771C<showPartialCorrectAnswers>: determines whether students are told which of their answers in a problem are wrong.
476 772
530 826
531=back 827=back
532 828
533=back 829=back
534 830
535=back
536 831
537=cut
538 832
539# ^function ENDDOCUMENT 833=cut
540# ^uses @PG_UNLABELED_ANSWERS
541# ^uses %PG_ANSWERS_HASH
542# ^uses @PG_ANSWERS
543sub ENDDOCUMENT {
544
545 my $index=0;
546 foreach my $label (@PG_UNLABELED_ANSWERS) {
547 if ( defined($PG_ANSWERS[$index]) ) {
548 $PG_ANSWERS_HASH{"$label"}= $PG_ANSWERS[$index];
549 #warn "recording answer label = $label";
550 } else {
551 warn "No answer provided by instructor for answer $label";
552 }
553 $index++;
554 }
555
556 $STRINGforOUTPUT .="\n";
557 eval q{ #make sure that "main" points to the current safe compartment by evaluating these lines.
558 $main::PG_FLAGS{'showPartialCorrectAnswers'} = $main::showPartialCorrectAnswers;
559 $main::PG_FLAGS{'recordSubmittedAnswers'} = $main::recordSubmittedAnswers;
560 $main::PG_FLAGS{'refreshCachedImages'} = $main::refreshCachedImages;
561 $main::PG_FLAGS{'comment'} = $main::pgComment;
562 $main::PG_FLAGS{'hintExists'} = $main::hintExists;
563 $main::PG_FLAGS{'showHintLimit'} = $main::showHint;
564 $main::PG_FLAGS{'solutionExists'} = $main::solutionExists;
565 $main::PG_FLAGS{ANSWER_ENTRY_ORDER} = \@main::PG_ANSWER_ENTRY_ORDER;
566 $main::PG_FLAGS{KEPT_EXTRA_ANSWERS} = \@main::KEPT_EXTRA_ANSWERS;##need to keep array labels that don't call "RECORD_ANS_NAME"
567 $main::PG_FLAGS{ANSWER_PREFIX} = $main::ANSWER_PREFIX;
568 # install problem grader
569 if (defined($main::PG_FLAGS{PROBLEM_GRADER_TO_USE}) ) {
570 # problem grader defined within problem -- no further action needed
571 } elsif ( defined( $main::envir{PROBLEM_GRADER_TO_USE} ) ) {
572 if (ref($main::envir{PROBLEM_GRADER_TO_USE}) eq 'CODE' ) { # user defined grader
573 $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} = $main::envir{PROBLEM_GRADER_TO_USE};
574 } elsif ($main::envir{PROBLEM_GRADER_TO_USE} eq 'std_problem_grader' ) {
575 if (defined(&std_problem_grader) ){
576 $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} = \&std_problem_grader; # defined in PGanswermacros.pl
577 } # std_problem_grader is the default in any case so don't give a warning.
578 } elsif ($main::envir{PROBLEM_GRADER_TO_USE} eq 'avg_problem_grader' ) {
579 if (defined(&avg_problem_grader) ){
580 $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} = \&avg_problem_grader; # defined in PGanswermacros.pl
581 }
582 #else { # avg_problem_grader will be installed by PGtranslator so there is no need for a warning.
583 # warn "The problem grader 'avg_problem_grader' has not been defined. Has PGanswermacros.pl been loaded?";
584 #}
585 } else {
586 warn "Error: $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} is not a known program grader.";
587 }
588 } elsif (defined(&std_problem_grader)) {
589 $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} = \&std_problem_grader; # defined in PGanswermacros.pl
590 } else {
591 # PGtranslator will install its default problem grader
592 }
593
594 warn "ERROR: The problem grader is not a subroutine" unless ref( $main::PG_FLAGS{PROBLEM_GRADER_TO_USE}) eq 'CODE'
595 or $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} = 'std_problem_grader'
596 or $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} = 'avg_problem_grader';
597 # return results
598 };
599
600 $STRINGforOUTPUT .= '<SCRIPT> jsMath.wwProcess() </SCRIPT>'
601 if ($main::envir{displayMode} eq 'HTML_jsMath');
602
603 if ($main::envir{displayMode} eq 'HTML_asciimath') {
604 $STRINGforOUTPUT .= '<SCRIPT> translate() </SCRIPT>';
605 $STRINGforHEADER_TEXT .=
606 '<object id="mathplayer" classid="clsid:32F66A20-7614-11D4-BD11-00104BD3F987">' . "\n" .
607 '</object><?import namespace="mml" implementation="#mathplayer"?>'
608 unless ($STRINGforHEADER_TEXT =~ m/mathplayer/);
609 }
610 $STRINGforOUTPUT .= MODES(%{PG_restricted_eval('$main::problemPostamble')});
611
612 (\$STRINGforOUTPUT, \$STRINGforHEADER_TEXT,\%PG_ANSWERS_HASH,eval(q!\%main::PG_FLAGS!));
613}
614 834
615 835
616################################################################################ 836################################################################################
617 837
618=head1 PRIVATE MACROS 838=head1 PRIVATE MACROS
622 842
623=over 843=over
624 844
625=item inc_ans_rule_count() 845=item inc_ans_rule_count()
626 846
627 NEW_ANS_NAME(inc_ans_rule_count()); 847 NEW_ANS_NAME();
628 848
629Increments the internal count of the number of answer blanks that have been 849Increments the internal count of the number of answer blanks that have been
630defined ($ans_rule_count) and returns the new count. This should only be used 850defined ($ans_rule_count) and returns the new count. This should only be used
631when one is about to define a new answer blank, for example with NEW_ANS_NAME(). 851when one is about to define a new answer blank, for example with NEW_ANS_NAME().
632 852
633=cut 853=cut
634 854
635# ^function inc_ans_rule_count
636# ^uses $ans_rule_count
637sub inc_ans_rule_count {
638 eval(q!++$main::ans_rule_count!); # evalute at runtime to get correct main::
639}
640
641=item RECORD_ANS_NAME() 855=item RECORD_ANS_NAME()
642 856
643 RECORD_ANS_NAME("label"); 857 RECORD_ANS_NAME("label", "VALUE");
644 858
645Records the label for an answer blank. Used internally by L<PGbasicmacros.pl> 859Records the label for an answer blank. Used internally by L<PGbasicmacros.pl>
646to record the order of explicitly-labelled answer blanks. 860to record the order of explicitly-labelled answer blanks.
647 861
648=cut 862=cut
649 863
650# ^function RECORD_ANS_NAME
651# ^uses $PG_STOP_FLAG
652# ^uses @PG_ANSWER_ENTRY_ORDER
653sub RECORD_ANS_NAME {
654 return "" if $PG_STOP_FLAG;
655 my $label = shift;
656 eval(q!push(@main::PG_ANSWER_ENTRY_ORDER, $label)!);
657 $label;
658}
659
660=item NEW_ANS_NAME() 864=item NEW_ANS_NAME()
661 865
662 NEW_ANS_NAME($num); 866 NEW_ANS_NAME();
663 867
664Generates an answer label from the supplied answer number. The label is 868Generates an anonymous answer label from the internal count The label is
665added to the list of implicity-labeled answers. Used internally by 869added to the list of implicity-labeled answers. Used internally by
666L<PGbasicmacros.pl> to generate labels for unlabeled answer blanks. 870L<PGbasicmacros.pl> to generate labels for unlabeled answer blanks.
667 871
668=cut 872=cut
669
670# ^function NEW_ANS_NAME
671# ^uses $PG_STOP_FLAG
672# ^uses $QUIZ_PREFIX
673# ^uses $ANSWER_PREFIX
674# ^uses @PG_UNLABELED_ANSWERS
675sub NEW_ANS_NAME {
676 return "" if $PG_STOP_FLAG;
677 my $number=shift;
678 my $prefix = eval(q!$main::QUIZ_PREFIX.$main::ANSWER_PREFIX!);
679 my $label = $prefix.$number;
680 push(@PG_UNLABELED_ANSWERS,$label);
681 $label;
682}
683 873
684=item ANS_NUM_TO_NAME() 874=item ANS_NUM_TO_NAME()
685 875
686 ANS_NUM_TO_NAME($num); 876 ANS_NUM_TO_NAME($num);
687 877
692the same label, but the label should only be added to the list of implicitly- 882the same label, but the label should only be added to the list of implicitly-
693labeled answers once.) 883labeled answers once.)
694 884
695=cut 885=cut
696 886
697# ^function ANS_NUM_TO_NAME
698# ^uses $QUIZ_PREFIX
699# ^uses $ANSWER_PREFIX
700sub ANS_NUM_TO_NAME {
701 my $number=shift;
702 my $label = eval(q!$main::QUIZ_PREFIX.$main::ANSWER_PREFIX!).$number;
703 $label;
704}
705
706my $vecnum;
707
708=item RECORD_FROM_LABEL() 887=item RECORD_FROM_LABEL()
709 888
710 RECORD_FORM_LABEL("label"); 889 RECORD_FORM_LABEL("label");
711 890
712Stores the label of a form field in the "extra" answers list. This is used to 891Stores the label of a form field in the "extra" answers list. This is used to
713keep track of answer blanks that are not associated with an answer evaluator. 892keep track of answer blanks that are not associated with an answer evaluator.
714 893
715=cut 894=cut
716 895
717# ^function RECORD_FORM_LABEL
718# ^uses $PG_STOP_FLAG
719# ^uses @KEPT_EXTRA_ANSWERS
720sub RECORD_FORM_LABEL { # this stores form data (such as sticky answers), but does nothing more
721 # it's a bit of hack since we are storing these in the KEPT_EXTRA_ANSWERS queue even if they aren't answers per se.
722 return "" if $PG_STOP_FLAG;
723 my $label = shift; # the label of the input box or textarea
724 eval(q!push(@main::KEPT_EXTRA_ANSWERS, $label)!); #put the labels into the hash to be caught later for recording purposes
725 $label;
726}
727
728=item NEW_ANS_ARRAY_NAME() 896=item NEW_ANS_ARRAY_NAME()
729 897
730 NEW_ANS_ARRAY_NAME($num, $row, $col); 898 NEW_ANS_ARRAY_NAME($num, $row, $col);
731 899
732Generates a new answer label for an array (vector) element and adds it to the 900Generates a new answer label for an array (vector) element and adds it to the
733list of implicitly-labeled answers. 901list of implicitly-labeled answers.
734 902
735=cut 903=cut
736 904
737# ^function NEW_ANS_ARRAY_NAME
738# ^uses $PG_STOP_FLAG
739# ^uses $QUIZ_PREFIX
740# ^uses @PG_UNLABELED_ANSWERS
741sub NEW_ANS_ARRAY_NAME { # this keeps track of the answers which are entered implicitly,
742 # rather than with a specific label
743 return "" if $PG_STOP_FLAG;
744 my $number=shift;
745 $vecnum = 0;
746 my $row = shift;
747 my $col = shift;
748# my $label = "ArRaY"."$number"."["."$vecnum".","."$row".","."$col"."]";
749 my $label = eval(q!$main::QUIZ_PREFIX."ArRaY"."$number"."__"."$vecnum".":"."$row".":"."$col"."__"!);
750 push(@PG_UNLABELED_ANSWERS,$label);
751 $label;
752}
753
754=item NEW_ANS_ARRAY_NAME_EXTENSION() 905=item NEW_ANS_ARRAY_NAME_EXTENSION()
755 906
756 NEW_ANS_ARRAY_NAME_EXTENSION($num, $row, $col); 907 NEW_ANS_ARRAY_NAME_EXTENSION($num, $row, $col);
757 908
758Generate an additional answer label for an existing array (vector) element and 909Generate an additional answer label for an existing array (vector) element and
759add it to the list of "extra" answers. 910add it to the list of "extra" answers.
760 911
761=cut 912=cut
762 913
763# ^function NEW_ANS_ARRAY_NAME_EXTENSION
764# ^uses $PG_STOP_FLAG
765sub NEW_ANS_ARRAY_NAME_EXTENSION { # this keeps track of the answers which are entered implicitly,
766 # rather than with a specific label
767 return "" if $PG_STOP_FLAG;
768 my $number=shift;
769 my $row = shift;
770 my $col = shift;
771 if( $row == 0 && $col == 0 ){
772 $vecnum += 1;
773 }
774 #FIXME change made to conform to HTML 4.01 standards. "Name" attributes can only contain
775 # alphanumeric characters, _ : and .
776 # Also need to make corresponding changes in PGmorematrixmacros. grep for ArRaY.
777 #my $label = "ArRaY"."$number"."["."$vecnum".","."$row".","."$col"."]";
778 my $label = eval(q!$main::QUIZ_PREFIX."ArRaY"."$number"."__"."$vecnum".":"."$row".":"."$col"."__"!);
779 eval(q!push(@main::KEPT_EXTRA_ANSWERS, $label)!);#put the labels into the hash to be caught later for recording purposes
780 $label;
781}
782
783=item get_PG_ANSWERS_HASH() 914=item get_PG_ANSWERS_HASH()
784 915
785 get_PG_ANSWERS_HASH(); 916 get_PG_ANSWERS_HASH();
786 get_PG_ANSWERS_HASH($key); 917 get_PG_ANSWERS_HASH($key);
787 918
788 919
789 920
790=cut 921=cut
791
792# ^function get_PG_ANSWERS_HASH
793# ^uses %PG_ANSWERS_HASH
794# ^uses @PG_UNLABELED_ANSWERS
795# ^uses @PG_ANSWERS
796sub get_PG_ANSWERS_HASH {
797 # update the PG_ANSWWERS_HASH, then report the result.
798 # This is used in writing sequential problems
799 # if there is an input, use that as a key into the answer hash
800 my $key = shift;
801 my (%pg_answers_hash, @pg_unlabeled_answers);
802 %pg_answers_hash= %PG_ANSWERS_HASH;
803 #warn "order ", eval(q!@main::PG_ANSWER_ENTRY_ORDER!);
804 #warn "pg answers", %PG_ANSWERS_HASH;
805 #warn "unlabeled", @PG_UNLABELED_ANSWERS;
806 my $index=0;
807 foreach my $label (@PG_UNLABELED_ANSWERS) {
808 if ( defined($PG_ANSWERS[$index]) ) {
809 $pg_answers_hash{"$label"}= $PG_ANSWERS[$index];
810 #warn "recording answer label = $label";
811 } else {
812 warn "No answer provided by instructor for answer $label";
813 }
814 $index++;
815 }
816 if ($key) {
817 return $pg_answers_hash{$key};
818 } else {
819 return %pg_answers_hash;
820 }
821}
822 922
823=item includePGproblem($filePath) 923=item includePGproblem($filePath)
824 924
825 includePGproblem($filePath); 925 includePGproblem($filePath);
826 926
828 a path relative to the top of the templates directory. The output 928 a path relative to the top of the templates directory. The output
829 of that problem appears in the given problem. 929 of that problem appears in the given problem.
830 930
831=cut 931=cut
832 932
833# ^function includePGproblem
834# ^uses %envir
835# ^uses &read_whole_problem_file
836# ^uses &includePGtext
837sub includePGproblem {
838 my $filePath = shift;
839 my %save_envir = %main::envir;
840 my $fullfilePath = $main::envir{templateDirectory}.$filePath;
841 my $r_string = read_whole_problem_file($fullfilePath);
842 if (ref($r_string) eq 'SCALAR') {
843 $r_string = $$r_string;
844 }
845
846 # The problem calling this should provide DOCUMENT and ENDDOCUMENT,
847 # so we remove them from the included file.
848 $r_string=~ s/^\s*(END)?DOCUMENT(\(\s*\));?//gm;
849
850 # Reset the problem path so that static images can be found via
851 # their relative paths.
852 eval('$main::envir{probFileName} = $filePath');
853 eval('$main::envir{fileName} = $filePath');
854 includePGtext($r_string);
855 # Reset the environment to what it is before.
856 %main::envir = %save_envir;
857}
858
859
860=back 933=back
861 934
862=head1 SEE ALSO 935=head1 SEE ALSO
863 936
864L<PGbasicmacros.pl>, L<PGanswermacros.pl>. 937L<PGbasicmacros.pl>, L<PGanswermacros.pl>.
865 938
866=cut 939=cut
867 940
941
942
943
8681; 9441;

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9