[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 6883 - (download) (as text) (annotate)
Thu Jun 23 01:19:10 2011 UTC (8 years, 7 months ago) by gage
File size: 34060 byte(s)
updated PG to allow material to be placed before the question main form



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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9