[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 6817 - (download) (as text) (annotate)
Fri May 20 02:22:16 2011 UTC (8 years, 8 months ago) by gage
File size: 33907 byte(s)
fix the coloring of matrices.  Still not completely satisfactory since only the
first element in a matrix or vector is colored.  Required that we replace the colons
in the labels with - since apparently colons are not allowed in css ids. (they worked
for HTML but not for this.)


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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9