[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 4773 - (download) (as text) (annotate)
Sun Feb 11 04:44:27 2007 UTC (13 years ago) by dpvc
File size: 8278 byte(s)
Added support for uncheckable radio buttons (when JavaScript it
active).  You specify an uncheckable buttons by including the
uncheckable=>1 or uncheckable=>"shift" options to the RadioButtons()
call.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9