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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6058 - (download) (as text) (annotate)
Thu Jun 25 23:28:44 2009 UTC (10 years, 6 months ago) by gage
File size: 11502 byte(s)
syncing pg HEAD with pg2.4.7 on 6/25/2009

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright  2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader$
    5 #
    6 # This program is free software; you can redistribute it and/or modify it under
    7 # the terms of either: (a) the GNU General Public License as published by the
    8 # Free Software Foundation; either version 2, or (at your option) any later
    9 # version, or (b) the "Artistic License" which comes with this package.
   10 #
   11 # This program is distributed in the hope that it will be useful, but WITHOUT
   12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
   13 # FOR A PARTICULAR PURPOSE.  See either the GNU General Public License or the
   14 # Artistic License for more details.
   15 ################################################################################
   16 
   17 =head1 NAME
   18 
   19 parserRadioButtons.pl - Radio buttons compatible with Value objects, specifically MultiAnswer objects.
   20 
   21 =head1 DESCRIPTION
   22 
   23 This file implements a radio button group object that is compatible
   24 with Value objects, and in particular, with the MultiAnswer object.
   25 
   26 To create a RadioButtons object, use
   27 
   28   $radio = RadioButtons([choices,...],correct,options);
   29 
   30 where "choices" are the strings for the items in the radio buttons,
   31 "correct" is the choice that is the correct answer for the group,
   32 and options are chosen from among:
   33 
   34 =over
   35 
   36 =item C<S<< order => [choice,...] >>>
   37 
   38 Specifies the order in which choices should be presented. All choices must be
   39 listed. If this option is specified, the C<first> and C<last> options are
   40 ignored.
   41 
   42 =item C<S<< first => [choice,...] >>>
   43 
   44 Specifies choices which should appear first, in the order specified, in the list
   45 of choices. Ignored if the C<order> option is specified.
   46 
   47 =item C<S<< last => [choice,...] >>>
   48 
   49 Specifies choices which should appear last, in the order specified, in the list
   50 of choices. Ignored if the C<order> option is specified.
   51 
   52 =item C<S<< labels => [label1,...] >>>
   53 
   54 Specifies the text to be used
   55 as the student answer for each
   56 entry in the radio group.
   57 This can also be set to the string
   58 "ABC" to get lettered labels or
   59 "123" to get numbered labels.
   60 The default is to use a few words
   61 from the text string for each button.
   62 
   63 =item C<S<< separator => string >>>
   64 
   65 text to put between the radio
   66 buttons.
   67 Default: $BR
   68 
   69 =item C<S<< checked => choice >>>
   70 
   71 the text or index (starting at zero)
   72 of the button to be checked
   73 Default: none checked
   74 
   75 =item C<S<< maxLabelSize => n >>>
   76 
   77 the approximate largest size that should
   78 be used for the answer strings to be
   79 generated by the radio buttons (if
   80 the choice strings are too long, they
   81 will be trimmed and "..." inserted)
   82 Default: 25
   83 
   84 =item C<S<< uncheckable => 0 or 1 or "shift" >>>
   85 
   86 determines whether the radio buttons can
   87 be unchecked (requires JavaScript).
   88 To uncheck, click a second time; when
   89 set to "shift", unchecking requires the
   90 shift key to be pressed.
   91 Default: 0
   92 
   93 =back
   94 
   95 To insert the radio buttons into the problem text, use
   96 
   97   BEGIN_TEXT
   98   \{$radio->buttons\}
   99   END_TEXT
  100 
  101 and then
  102 
  103   ANS($radio->cmp);
  104 
  105 to get the answer checker for the radion buttons.
  106 
  107 You can use the RadioButtons object in MultiPart objects.  This is
  108 the reason for the RadioButton's ans_rule method (since that is what
  109 MultiPart calls to get answer rules).
  110 
  111 =cut
  112 
  113 loadMacros('MathObjects.pl','contextString.pl');
  114 
  115 sub _parserRadioButtons_init {parserRadioButtons::Init()}; # don't reload this file
  116 
  117 ##################################################
  118 #
  119 #  The package that implements RadioButtons
  120 #
  121 package parserRadioButtons;
  122 our @ISA = qw(Value::String);
  123 
  124 my $jsPrinted = 0;  # true when the JavaScript has been printed
  125 
  126 #
  127 #  Set up the main:: namespace
  128 #
  129 sub Init {
  130   $jsPrinted = 0;
  131   main::PG_restricted_eval('sub RadioButtons {parserRadioButtons->new(@_)}');
  132 }
  133 
  134 #
  135 #  Create a new RadioButtons object
  136 #
  137 sub new {
  138   my $self = shift; my $class = ref($self) || $self;
  139   my $context = (Value::isContext($_[0]) ? shift : $self->context);
  140   my $choices = shift; my $value = shift;
  141   my %options;
  142   main::set_default_options(\%options,
  143     labels => [],
  144     separator => $main::BR,
  145     checked => undef,
  146     maxLabelSize => 25,
  147     uncheckable => 0,
  148     first => undef,
  149     last => undef,
  150     order => undef,
  151     @_,
  152   );
  153   $options{labels} = [1..scalar(@$choices)] if $options{labels} eq "123";
  154   $options{labels} = [@main::ALPHABET[0..scalar(@$choices)-1]] if $options{labels} eq "ABC";
  155   my $self = bless {%options, choices=>$choices}, $class; # temporary to so we can call our methods
  156   Value::Error("A RadioButton's first argument should be a list of button labels")
  157     unless ref($choices) eq 'ARRAY';
  158   Value::Error("A RadioButton's second argument should be the correct button choice")
  159     unless defined($value) && $value ne "";
  160   my $context = Parser::Context->getCopy("String");
  161   my %choiceHash = $self->choiceHash;
  162   $context->strings->add(map {$_=>{}} (keys %choiceHash));
  163   $value = $self->correctChoice($value);
  164   $self = bless $context->Package("String")->new($context,$value)->with(choices => $choices, %options), $class;
  165   $self->JavaScript if $self->{uncheckable};
  166   return $self;
  167 }
  168 
  169 #
  170 #  Given a choice, a label, or an index into the choices array,
  171 #    return the label.
  172 #
  173 sub findChoice {
  174   my $self = shift; my $value = shift;
  175   my $index = $self->Index($value);
  176   foreach my $i (0..scalar(@{$self->{choices}})-1) {
  177     my $label = $self->{labels}[$i]; my $choice = $self->{choices}[$i];
  178     $label = $choice unless defined $label;
  179     return $label if $label eq $value || $index == $i || $choice eq $value;
  180   }
  181  return undef;
  182 }
  183 
  184 #
  185 #  Locate the label of the correct answer
  186 #  The answer can be given as an index, as the full answer
  187 #    or as the label itself.
  188 #
  189 sub correctChoice {
  190   my $self = shift; my $value = shift;
  191   my $choice = $self->findChoice($value);
  192   return $choice if defined $choice;
  193   Value::Error("The correct answer should be one of the button choices");
  194 }
  195 
  196 #
  197 #  Create the hash of label => answer pairs to be used for the
  198 #  ans_radio_buttons() routine
  199 #
  200 sub choiceHash {
  201   my $self = shift; my @radio = (); my %labels;
  202   foreach my $i (0..scalar(@{$self->{choices}})-1) {
  203     my $label = $self->{labels}[$i]; my $choice = $self->{choices}[$i];
  204     $label = $choice unless defined $label;
  205     push(@radio, $label,$choice);
  206   }
  207   return @radio;
  208 }
  209 
  210 #
  211 #  Create a label for the answer, either using the labels
  212 #  provided by the author, or by creating one from the answer
  213 #  string (restrict its length so that the results table
  214 #  will not be overflowed).
  215 #
  216 sub labelText {
  217   my $self = shift; my $choice = shift;
  218   return $choice if length($choice) < $self->{maxLabelSize};
  219   my @words = split(/\b/,$choice); my ($s,$e) = ('','');
  220   do {$s .= shift(@words); $e = pop(@words) . $e}
  221     while length($s) + length($e) + 15 < $self->{maxLabelSize} && scalar(@words);
  222   return $s . " ... " . $e;
  223 }
  224 
  225 #
  226 #  Get a numeric index (-1 if not defined or not a number)
  227 #
  228 sub Index {
  229   my $self = shift; my $index = shift;
  230   return -1 unless defined $index && $index =~ m/^\d$/;
  231   return $index;
  232 }
  233 
  234 #
  235 #  Print the JavaScript needed for uncheckable radio buttons
  236 #
  237 sub JavaScript {
  238   return if $jsPrinted || $main::displayMode eq 'TeX';
  239   main::TEXT(
  240     "\n<script>\n" .
  241     "if (window.ww == null) {var ww = {}}\n" .
  242     "if (ww.RadioButtons == null) {ww.RadioButtons = {}}\n" .
  243     "if (ww.RadioButtons.selected == null) {ww.RadioButtons.selected = {}}\n" .
  244     "ww.RadioButtons.Toggle = function (obj,event,shift) {\n" .
  245     "  if (!event) {event = window.event}\n" .
  246     "  if (shift && !event.shiftKey) {\n" .
  247     "    this.selected[obj.name] = obj\n" .
  248     "    return\n" .
  249     "  }\n" .
  250     "  var selected = this.selected[obj.name]\n" .
  251     "  if (selected && selected == obj) {\n".
  252     "    this.selected[obj.name] = null\n" .
  253     "    obj.checked = false\n" .
  254     "  } else {\n" .
  255     "    this.selected[obj.name] = obj\n".
  256     "  }\n" .
  257     "}\n".
  258     "</script>\n"
  259   );
  260   $jsPrinted = 1;
  261 }
  262 
  263 sub makeUncheckable {
  264   my $self = shift;
  265   my $shift = ($self->{uncheckable} =~ m/shift/i ? ",1" : "");
  266   my $onclick = "onclick=\"ww.RadioButtons.Toggle(this,event$shift)\"";
  267   my @radio = @_;
  268   foreach (@radio) {$_ =~ s/<INPUT/<INPUT $onclick/i}
  269   return @radio;
  270 }
  271 
  272 #
  273 #  Determine the order the choices should be in.
  274 #
  275 sub orderedChoices {
  276   my $self = shift;
  277   my %choiceHash = $self->choiceHash;
  278   my @labels = keys %choiceHash;
  279 
  280   my @order = @{$self->{order} || []};
  281   my @first = @{$self->{first} || []};
  282   my @last  = @{$self->{last}  || []};
  283 
  284   my @orderLabels;
  285 
  286   if (@order) {
  287     my %remainingChoices = %choiceHash;
  288     Value::Error("When using the 'order' option, you must list all possible choices.")
  289       unless @order == @labels;
  290     foreach my $i (0..$#order) {
  291       my $label = $self->findChoice($order[$i]);
  292       Value::Error("Item $i of the 'order' option is not a choice.")
  293         if not defined $label;
  294       Value::Error("Item $i of the 'order' option was already specified.")
  295         if not exists $remainingChoices{$label};
  296       push @orderLabels, $label;
  297       delete $remainingChoices{$label};
  298     }
  299   } elsif (@first or @last) {
  300     my @firstLabels;
  301     my @lastLabels;
  302     my %remainingChoices = %choiceHash;
  303 
  304     foreach my $i (0..$#first) {
  305       my $label = $self->findChoice($first[$i]);
  306       Value::Error("Item $i of the 'first' option is not a choice.")
  307   if not defined $label;
  308       Value::Error("Item $i of the 'first' option was already specified.")
  309   if not exists $remainingChoices{$label};
  310       push @firstLabels, $label;
  311       delete $remainingChoices{$label};
  312     }
  313 
  314     foreach my $i (0..$#last) {
  315       my $label = $self->findChoice($last[$i]);
  316       Value::Error("Item $i of the 'last' option is not a choice.")
  317   if not defined $label;
  318       Value::Error("Item $i of the 'last' option was already specified.")
  319   if not exists $remainingChoices{$label};
  320       push @lastLabels, $label;
  321       delete $remainingChoices{$label};
  322     }
  323 
  324     @orderLabels = (@firstLabels, keys %remainingChoices, @lastLabels);
  325   } else {
  326     # use the order of elements in the hash
  327     # this is the current behavior
  328     # might we want to explicitly randomize these?
  329     @orderLabels = @labels;
  330   }
  331 
  332   my $label = $self->findChoice($self->{checked});
  333   return map { ($_ eq $label ? "%$_" : $_) => $choiceHash{$_} } @orderLabels;
  334 }
  335 
  336 #
  337 #  Create the radio-buttons text
  338 #
  339 sub buttons {
  340   my $self = shift;
  341   my @radio = main::ans_radio_buttons($self->orderedChoices);
  342   @radio = $self->makeUncheckable(@radio) if $self->{uncheckable};
  343   (wantarray) ? @radio : join($self->{separator}, @radio);
  344 }
  345 sub named_buttons {
  346   my $self = shift; my $name = shift;
  347   my @radio = NAMED_ANS_RADIO_BUTTONS($name,$self->orderedChoices);
  348   @radio = $self->makeUncheckable(@radio) if $self->{uncheckable};
  349   #
  350   #  Taken from PGbasicmacros.pl
  351   #  It is wrong to have \item in the radio buttons and to add itemize here,
  352   #    but that is the way PGbasicmacros.pl does it.
  353   #
  354   if ($displayMode eq 'TeX') {
  355     $radio[0] = "\n\\begin{itemize}\n" . $radio[0];
  356     $radio[$#radio_buttons] .= "\n\\end{itemize}\n";
  357   }
  358   (wantarray) ? @radio: join($self->{separator}, @radio);
  359 }
  360 
  361 sub ans_rule {shift->buttons(@_)}
  362 sub named_ans_rule {shift->named_buttons(@_)}
  363 
  364 sub cmp_postprocess {
  365   my $self = shift; my $ans = shift;
  366   my $text = $self->labelText($ans->{student_value}->value);
  367   $ans->{preview_text_string} = $ans->{student_ans} = $text;
  368   $ans->{preview_latex_string} = "\\hbox{$text}";
  369 }
  370 
  371 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9