[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 5672 - (download) (as text) (annotate)
Mon May 12 20:49:49 2008 UTC (11 years, 9 months ago) by sh002i
File size: 11566 byte(s)
added the ability to specify an order for the choices or push some
choices to the top or bottom.

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright  2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader: pg/macros/parserRadioButtons.pl,v 1.10 2007/10/04 16:40:49 sh002i Exp $
    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(1);
  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 = $self->makeLabel($choice) unless defined $label;
  179     return $label if $label eq $value || $index == $i || $choice eq $value;
  180   }
  181 }
  182 
  183 #
  184 #  Locate the label of the correct answer
  185 #  The answer can be given as an index, as the full answer
  186 #    or as the label itself.
  187 #
  188 sub correctChoice {
  189   my $self = shift; my $value = shift;
  190   my $choice = $self->findChoice($value);
  191   return $choice if defined $choice;
  192   Value::Error("The correct answer should be one of the button choices");
  193 }
  194 
  195 #
  196 #  Create the hash of label => answer pairs to be used for the
  197 #  ans_radio_buttons() routine
  198 #
  199 sub choiceHash {
  200   my $self = shift; my $noChecked = shift;
  201   my @radio = ();
  202   my $index = $self->Index($self->{checked});
  203   my $checked = $self->{checked}; $checked = "" unless defined $checked;
  204   if ($noChecked) {$checked = ""; $index = -1}
  205   foreach my $i (0..scalar(@{$self->{choices}})-1) {
  206     my $label = $self->{labels}[$i]; my $choice = $self->{choices}[$i];
  207     $label = $self->makeLabel($choice) unless defined $label;
  208     $label = "%$label" if $label eq $checked || $index == $i || $choice eq $checked;
  209     push(@radio, $label,$choice);
  210   }
  211   return @radio;
  212 }
  213 
  214 #
  215 #  Create a label for the answer, either using the labels
  216 #  provided by the user, or by creating one from the answer
  217 #  string (restrict its length so that the results table
  218 #  will not be overflowed).
  219 #
  220 sub makeLabel {
  221   my $self = shift; my $choice = shift;
  222   return $choice if length($choice) < $self->{maxLabelSize};
  223   my @words = split(/\b/,$choice);
  224   my ($s,$e) = ('','');
  225   do {$s .= shift(@words); $e = pop(@words) . $e}
  226     while length($s) + length($e) + 15 < $self->{maxLabelSize} && scalar(@words);
  227   return $s . " ... " . $e;
  228 }
  229 
  230 #
  231 #  Get a numeric index (-1 if not defined or not a number)
  232 #
  233 sub Index {
  234   my $self = shift; my $index = shift;
  235   return -1 unless defined $index && $index =~ m/^\d$/;
  236   return $index;
  237 }
  238 
  239 #
  240 #  Print the JavaScript needed for uncheckable radio buttons
  241 #
  242 sub JavaScript {
  243   return if $main::displayMode eq 'TeX';
  244   return if $jsPrinted;
  245   main::TEXT(
  246     "\n<script>\n" .
  247     "if (window.ww == null) {var ww = {}}\n" .
  248     "if (ww.RadioButtons == null) {ww.RadioButtons = {}}\n" .
  249     "if (ww.RadioButtons.selected == null) {ww.RadioButtons.selected = {}}\n" .
  250     "ww.RadioButtons.Toggle = function (obj,event,shift) {\n" .
  251     "  if (!event) {event = window.event}\n" .
  252     "  if (shift && !event.shiftKey) {\n" .
  253     "    this.selected[obj.name] = obj\n" .
  254     "    return\n" .
  255     "  }\n" .
  256     "  var selected = this.selected[obj.name]\n" .
  257     "  if (selected && selected == obj) {\n".
  258     "    this.selected[obj.name] = null\n" .
  259     "    obj.checked = false\n" .
  260     "  } else {\n" .
  261     "    this.selected[obj.name] = obj\n".
  262     "  }\n" .
  263     "}\n".
  264     "</script>\n"
  265   );
  266   $jsSPrinted = 1;
  267 }
  268 
  269 sub makeUncheckable {
  270   my $self = shift;
  271   my $shift = ($self->{uncheckable} =~ m/shift/i ? ",1" : "");
  272   my $onclick = "onclick=\"ww.RadioButtons.Toggle(this,event$shift)\"";
  273   my @radio = @_;
  274   foreach (@radio) {$_ =~ s/<INPUT/<INPUT $onclick/i}
  275   return @radio;
  276 }
  277 
  278 #
  279 #  Determine the order the choices should be in.
  280 #
  281 sub orderedChoices {
  282   my $self = shift;
  283   my %choiceHash = $self->choiceHash;
  284   my @labels = keys %choiceHash;
  285 
  286   my @order = @{$self->{order}};
  287   my @first = @{$self->{first}};
  288   my @last  = @{$self->{last}};
  289 
  290   my @orderLabels;
  291 
  292   if (@order) {
  293     my %remainingChoices = %choiceHash;
  294     Value::Error("When using the 'order' option, you must list all possible choices.")
  295       unless @order == @labels;
  296     foreach my $i (0..$#order) {
  297       my $label = $self->findChoice($order[$i]);
  298       Value::Error("Item $i of the 'order' option is not a choice.")
  299         if not defined $label;
  300       Value::Error("Item $i of the 'order' option was already specified.")
  301         if not exists $remainingChoices{$label};
  302       push @orderLabels, $label;
  303       delete $remainingChoices{$label};
  304     }
  305   } elsif (@first or @last) {
  306     my @firstLabels;
  307     my @lastLabels;
  308     my %remainingChoices = %choiceHash;
  309 
  310     foreach my $i (0..$#first) {
  311       my $label = $self->findChoice($first[$i]);
  312       Value::Error("Item $i of the 'first' option is not a choice.")
  313   if not defined $label;
  314       Value::Error("Item $i of the 'first' option was already specified.")
  315   if not exists $remainingChoices{$label};
  316       push @firstLabels, $label;
  317       delete $remainingChoices{$label};
  318     }
  319 
  320     foreach my $i (0..$#last) {
  321       my $label = $self->findChoice($last[$i]);
  322       Value::Error("Item $i of the 'last' option is not a choice.")
  323   if not defined $label;
  324       Value::Error("Item $i of the 'last' option was already specified.")
  325   if not exists $remainingChoices{$label};
  326       push @lastLabels, $label;
  327       delete $remainingChoices{$label};
  328     }
  329 
  330     @orderLabels = (@firstLabels, keys %remainingChoices, @lastLabels);
  331   } else {
  332     # use the order of elements in the hash
  333     # this is the current behavior
  334     # might we want to explicitly randomize these?
  335     @orderLabels = @labels;
  336   }
  337 
  338   return map { $_ => $choiceHash{$_} } @orderLabels;
  339 }
  340 
  341 #
  342 #  Create the radio-buttons text
  343 #
  344 sub buttons {
  345   my $self = shift;
  346   my @radio = main::ans_radio_buttons($self->orderedChoices);
  347   @radio = $self->makeUncheckable(@radio) if $self->{uncheckable};
  348   (wantarray) ? @radio : join($self->{separator}, @radio);
  349 }
  350 sub named_buttons {
  351   my $self = shift; my $name = shift;
  352   my @radio = NAMED_ANS_RADIO_BUTTONS($name,$self->orderedChoices);
  353   @radio = $self->makeUncheckable(@radio) if $self->{uncheckable};
  354   #
  355   #  Taken from PGbasicmacros.pl
  356   #  It is wrong to have \item in the radio buttons and to add itemize here,
  357   #    but that is the way PGbasicmacros.pl does it.
  358   #
  359   if ($displayMode eq 'TeX') {
  360     $radio[0] = "\n\\begin{itemize}\n" . $radio[0];
  361     $radio[$#radio_buttons] .= "\n\\end{itemize}\n";
  362   }
  363   (wantarray) ? @radio: join($self->{separator}, @radio);
  364 }
  365 
  366 sub ans_rule {shift->buttons(@_)}
  367 sub named_ans_rule {shift->named_buttons(@_)}
  368 
  369 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9