[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 5556 - (download) (as text) (annotate)
Thu Oct 4 16:40:49 2007 UTC (12 years, 4 months ago) by sh002i
File size: 8692 byte(s)
added standard copyright/license header

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright  2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader: webwork2/lib/WeBWorK.pm,v 1.100 2007/08/13 22:59:53 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<< labels => [label1,...] >>>
   37 
   38 Specifies the text to be used
   39 as the student answer for each
   40 entry in the radio group.
   41 This can also be set to the string
   42 "ABC" to get lettered labels or
   43 "123" to get numbered labels.
   44 The default is to use a few words
   45 from the text string for each button.
   46 
   47 =item C<S<< separator => string >>>
   48 
   49 text to put between the radio
   50 buttons.
   51 Default: $BR
   52 
   53 =item C<S<< checked => choice >>>
   54 
   55 the text or index (starting at zero)
   56 of the button to be checked
   57 Default: none checked
   58 
   59 =item C<S<< maxLabelSize => n >>>
   60 
   61 the approximate largest size that should
   62 be used for the answer strings to be
   63 generated by the radio buttons (if
   64 the choice strings are too long, they
   65 will be trimmed and "..." inserted)
   66 Default: 25
   67 
   68 =item C<S<< uncheckable => 0 or 1 or "shift" >>>
   69 
   70 determines whether the radio buttons can
   71 be unchecked (requires JavaScript).
   72 To uncheck, click a second time; when
   73 set to "shift", unchecking requires the
   74 shift key to be pressed.
   75 Default: 0
   76 
   77 =back
   78 
   79 To insert the radio buttons into the problem text, use
   80 
   81   BEGIN_TEXT
   82   \{$radio->buttons\}
   83   END_TEXT
   84 
   85 and then
   86 
   87   ANS($radio->cmp);
   88 
   89 to get the answer checker for the radion buttons.
   90 
   91 You can use the RadioButtons object in MultiPart objects.  This is
   92 the reason for the RadioButton's ans_rule method (since that is what
   93 MultiPart calls to get answer rules).
   94 
   95 =cut
   96 
   97 loadMacros('MathObjects.pl','contextString.pl');
   98 
   99 sub _parserRadioButtons_init {parserRadioButtons::Init()}; # don't reload this file
  100 
  101 ##################################################
  102 #
  103 #  The package that implements RadioButtons
  104 #
  105 package parserRadioButtons;
  106 our @ISA = qw(Value::String);
  107 
  108 my $jsPrinted = 0;  # true when the JavaScript has been printed
  109 
  110 #
  111 #  Set up the main:: namespace
  112 #
  113 sub Init {
  114   $jsPrinted = 0;
  115   main::PG_restricted_eval('sub RadioButtons {parserRadioButtons->new(@_)}');
  116 }
  117 
  118 #
  119 #  Create a new RadioButtons object
  120 #
  121 sub new {
  122   my $self = shift; my $class = ref($self) || $self;
  123   my $context = (Value::isContext($_[0]) ? shift : $self->context);
  124   my $choices = shift; my $value = shift;
  125   my %options;
  126   main::set_default_options(\%options,
  127     labels => [],
  128     separator => $main::BR,
  129     checked => undef,
  130     maxLabelSize => 25,
  131     uncheckable => 0,
  132     @_,
  133   );
  134   $options{labels} = [1..scalar(@$choices)] if $options{labels} eq "123";
  135   $options{labels} = [@main::ALPHABET[0..scalar(@$choices)-1]] if $options{labels} eq "ABC";
  136   my $self = bless {%options, choices=>$choices}, $class; # temporary to so we can call our methods
  137   Value::Error("A RadioButton's first argument should be a list of button labels")
  138     unless ref($choices) eq 'ARRAY';
  139   Value::Error("A RadioButton's second argument should be the correct button choice")
  140     unless defined($value) && $value ne "";
  141   my $context = Parser::Context->getCopy("String");
  142   my %choiceHash = $self->choiceHash(1);
  143   $context->strings->add(map {$_=>{}} (keys %choiceHash));
  144   $value = $self->correctChoice($value);
  145   $self = bless $context->Package("String")->new($context,$value)->with(choices => $choices, %options), $class;
  146   $self->JavaScript if $self->{uncheckable};
  147   return $self;
  148 }
  149 
  150 #
  151 #  Locate the label of the correct answer
  152 #  The answer can be given as an index, as the full answer
  153 #    or as the label itself.
  154 #
  155 sub correctChoice {
  156   my $self = shift; my $value = shift;
  157   my $index = $self->Index($value);
  158   foreach my $i (0..scalar(@{$self->{choices}})-1) {
  159     my $label = $self->{labels}[$i]; my $choice = $self->{choices}[$i];
  160     $label = $self->makeLabel($choice) unless defined $label;
  161     return $label if $label eq $value || $index == $i || $choice eq $value;
  162   }
  163   Value::Error("The correct answer should be one of the button choices");
  164 }
  165 
  166 #
  167 #  Create the hash of label => answer pairs to be used for the
  168 #  ans_radio_buttons() routine
  169 #
  170 sub choiceHash {
  171   my $self = shift; my $noChecked = shift;
  172   my @radio = ();
  173   my $index = $self->Index($self->{checked});
  174   my $checked = $self->{checked}; $checked = "" unless defined $checked;
  175   if ($noChecked) {$checked = ""; $index = -1}
  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     $label = "%$label" if $label eq $checked || $index == $i || $choice eq $checked;
  180     push(@radio, $label,$choice);
  181   }
  182   return @radio;
  183 }
  184 
  185 #
  186 #  Create a label for the answer, either using the labels
  187 #  provided by the user, or by creating one from the answer
  188 #  string (restrict its length so that the results table
  189 #  will not be overflowed).
  190 #
  191 sub makeLabel {
  192   my $self = shift; my $choice = shift;
  193   return $choice if length($choice) < $self->{maxLabelSize};
  194   my @words = split(/\b/,$choice);
  195   my ($s,$e) = ('','');
  196   do {$s .= shift(@words); $e = pop(@words) . $e}
  197     while length($s) + length($e) + 15 < $self->{maxLabelSize} && scalar(@words);
  198   return $s . " ... " . $e;
  199 }
  200 
  201 #
  202 #  Get a numeric index (-1 if not defined or not a number)
  203 #
  204 sub Index {
  205   my $self = shift; my $index = shift;
  206   return -1 unless defined $index && $index =~ m/^\d$/;
  207   return $index;
  208 }
  209 
  210 #
  211 #  Print the JavaScript needed for uncheckable radio buttons
  212 #
  213 sub JavaScript {
  214   return if $main::displayMode eq 'TeX';
  215   return if $jsPrinted;
  216   main::TEXT(
  217     "\n<script>\n" .
  218     "if (window.ww == null) {var ww = {}}\n" .
  219     "if (ww.RadioButtons == null) {ww.RadioButtons = {}}\n" .
  220     "if (ww.RadioButtons.selected == null) {ww.RadioButtons.selected = {}}\n" .
  221     "ww.RadioButtons.Toggle = function (obj,event,shift) {\n" .
  222     "  if (!event) {event = window.event}\n" .
  223     "  if (shift && !event.shiftKey) {\n" .
  224     "    this.selected[obj.name] = obj\n" .
  225     "    return\n" .
  226     "  }\n" .
  227     "  var selected = this.selected[obj.name]\n" .
  228     "  if (selected && selected == obj) {\n".
  229     "    this.selected[obj.name] = null\n" .
  230     "    obj.checked = false\n" .
  231     "  } else {\n" .
  232     "    this.selected[obj.name] = obj\n".
  233     "  }\n" .
  234     "}\n".
  235     "</script>\n"
  236   );
  237   $jsSPrinted = 1;
  238 }
  239 
  240 sub makeUncheckable {
  241   my $self = shift;
  242   my $shift = ($self->{uncheckable} =~ m/shift/i ? ",1" : "");
  243   my $onclick = "onclick=\"ww.RadioButtons.Toggle(this,event$shift)\"";
  244   my @radio = @_;
  245   foreach (@radio) {$_ =~ s/<INPUT/<INPUT $onclick/i}
  246   return @radio;
  247 }
  248 
  249 #
  250 #  Create the radio-buttons text
  251 #
  252 sub buttons {
  253   my $self = shift;
  254   my @radio = main::ans_radio_buttons($self->choiceHash);
  255   @radio = $self->makeUncheckable(@radio) if $self->{uncheckable};
  256   (wantarray) ? @radio : join($self->{separator}, @radio);
  257 }
  258 sub named_buttons {
  259   my $self = shift; my $name = shift;
  260   my @radio = NAMED_ANS_RADIO_BUTTONS($name,$self->choiceHash);
  261   @radio = $self->makeUncheckable(@radio) if $self->{uncheckable};
  262   #
  263   #  Taken from PGbasicmacros.pl
  264   #  It is wrong to have \item in the radio buttons and to add itemize here,
  265   #    but that is the way PGbasicmacros.pl does it.
  266   #
  267   if ($displayMode eq 'TeX') {
  268     $radio[0] = "\n\\begin{itemize}\n" . $radio[0];
  269     $radio[$#radio_buttons] .= "\n\\end{itemize}\n";
  270   }
  271   (wantarray) ? @radio: join($self->{separator}, @radio);
  272 }
  273 
  274 sub ans_rule {shift->buttons(@_)}
  275 sub named_ans_rule {shift->named_buttons(@_)}
  276 
  277 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9