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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6418 - (download) (as text) (annotate)
Tue Sep 7 21:19:14 2010 UTC (9 years, 4 months ago) by apizer
File size: 33679 byte(s)
Add MathJax display mode

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9