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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6048 - (view) (download) (as text)

1 : sh002i 5556 ################################################################################
2 :     # WeBWorK Online Homework Delivery System
3 :     # Copyright 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
4 : dpvc 6048 # $CVSHeader: pg/macros/parserRadioButtons.pl,v 1.11 2008/05/12 20:49:49 sh002i Exp $
5 : sh002i 5556 #
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 : sh002i 5553 =head1 NAME
18 : dpvc 4772
19 : sh002i 5553 parserRadioButtons.pl - Radio buttons compatible with Value objects, specifically MultiAnswer objects.
20 : dpvc 4772
21 : gage 4997 =head1 DESCRIPTION
22 :    
23 : sh002i 5553 This file implements a radio button group object that is compatible
24 :     with Value objects, and in particular, with the MultiAnswer object.
25 : dpvc 4772
26 : sh002i 5553 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 : sh002i 5672 =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 : sh002i 5553 =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 : gage 4997 =cut
112 :    
113 : sh002i 5553 loadMacros('MathObjects.pl','contextString.pl');
114 :    
115 :     sub _parserRadioButtons_init {parserRadioButtons::Init()}; # don't reload this file
116 :    
117 : dpvc 5392 ##################################################
118 : dpvc 4772 #
119 :     # The package that implements RadioButtons
120 :     #
121 :     package parserRadioButtons;
122 :     our @ISA = qw(Value::String);
123 :    
124 : dpvc 4773 my $jsPrinted = 0; # true when the JavaScript has been printed
125 : dpvc 4772
126 : dpvc 5392 #
127 :     # Set up the main:: namespace
128 :     #
129 :     sub Init {
130 :     $jsPrinted = 0;
131 :     main::PG_restricted_eval('sub RadioButtons {parserRadioButtons->new(@_)}');
132 :     }
133 : dpvc 4773
134 : dpvc 4772 #
135 :     # Create a new RadioButtons object
136 :     #
137 :     sub new {
138 :     my $self = shift; my $class = ref($self) || $self;
139 : dpvc 5073 my $context = (Value::isContext($_[0]) ? shift : $self->context);
140 : dpvc 4772 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 : dpvc 4773 uncheckable => 0,
148 : sh002i 5672 first => undef,
149 :     last => undef,
150 :     order => undef,
151 : dpvc 4772 @_,
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 : dpvc 5370 my $context = Parser::Context->getCopy("String");
161 : dpvc 6048 my %choiceHash = $self->choiceHash;
162 : dpvc 4772 $context->strings->add(map {$_=>{}} (keys %choiceHash));
163 :     $value = $self->correctChoice($value);
164 : dpvc 5392 $self = bless $context->Package("String")->new($context,$value)->with(choices => $choices, %options), $class;
165 : dpvc 4773 $self->JavaScript if $self->{uncheckable};
166 : dpvc 4772 return $self;
167 :     }
168 :    
169 : sh002i 5672 #
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 : dpvc 6048 return undef;
182 : sh002i 5672 }
183 :    
184 : dpvc 4772 #
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 : sh002i 5672 my $choice = $self->findChoice($value);
192 :     return $choice if defined $choice;
193 : dpvc 4772 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 : dpvc 6048 my $self = shift; my @radio = ();
202 : dpvc 4772 foreach my $i (0..scalar(@{$self->{choices}})-1) {
203 :     my $label = $self->{labels}[$i]; my $choice = $self->{choices}[$i];
204 :     $label = $self->makeLabel($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 user, 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 makeLabel {
217 :     my $self = shift; my $choice = shift;
218 :     return $choice if length($choice) < $self->{maxLabelSize};
219 :     my @words = split(/\b/,$choice);
220 :     my ($s,$e) = ('','');
221 :     do {$s .= shift(@words); $e = pop(@words) . $e}
222 :     while length($s) + length($e) + 15 < $self->{maxLabelSize} && scalar(@words);
223 :     return $s . " ... " . $e;
224 :     }
225 :    
226 :     #
227 :     # Get a numeric index (-1 if not defined or not a number)
228 :     #
229 :     sub Index {
230 :     my $self = shift; my $index = shift;
231 :     return -1 unless defined $index && $index =~ m/^\d$/;
232 :     return $index;
233 :     }
234 :    
235 :     #
236 : dpvc 4773 # Print the JavaScript needed for uncheckable radio buttons
237 :     #
238 :     sub JavaScript {
239 :     return if $main::displayMode eq 'TeX';
240 :     return if $jsPrinted;
241 :     main::TEXT(
242 :     "\n<script>\n" .
243 :     "if (window.ww == null) {var ww = {}}\n" .
244 :     "if (ww.RadioButtons == null) {ww.RadioButtons = {}}\n" .
245 :     "if (ww.RadioButtons.selected == null) {ww.RadioButtons.selected = {}}\n" .
246 :     "ww.RadioButtons.Toggle = function (obj,event,shift) {\n" .
247 :     " if (!event) {event = window.event}\n" .
248 :     " if (shift && !event.shiftKey) {\n" .
249 :     " this.selected[obj.name] = obj\n" .
250 :     " return\n" .
251 :     " }\n" .
252 :     " var selected = this.selected[obj.name]\n" .
253 :     " if (selected && selected == obj) {\n".
254 :     " this.selected[obj.name] = null\n" .
255 :     " obj.checked = false\n" .
256 :     " } else {\n" .
257 :     " this.selected[obj.name] = obj\n".
258 :     " }\n" .
259 :     "}\n".
260 :     "</script>\n"
261 :     );
262 :     $jsSPrinted = 1;
263 :     }
264 :    
265 :     sub makeUncheckable {
266 :     my $self = shift;
267 :     my $shift = ($self->{uncheckable} =~ m/shift/i ? ",1" : "");
268 :     my $onclick = "onclick=\"ww.RadioButtons.Toggle(this,event$shift)\"";
269 :     my @radio = @_;
270 :     foreach (@radio) {$_ =~ s/<INPUT/<INPUT $onclick/i}
271 :     return @radio;
272 :     }
273 :    
274 : sh002i 5672 #
275 :     # Determine the order the choices should be in.
276 :     #
277 :     sub orderedChoices {
278 :     my $self = shift;
279 :     my %choiceHash = $self->choiceHash;
280 :     my @labels = keys %choiceHash;
281 :    
282 : dpvc 6048 my @order = @{$self->{order} || []};
283 :     my @first = @{$self->{first} || []};
284 :     my @last = @{$self->{last} || []};
285 : sh002i 5672
286 :     my @orderLabels;
287 :    
288 :     if (@order) {
289 :     my %remainingChoices = %choiceHash;
290 :     Value::Error("When using the 'order' option, you must list all possible choices.")
291 :     unless @order == @labels;
292 :     foreach my $i (0..$#order) {
293 :     my $label = $self->findChoice($order[$i]);
294 :     Value::Error("Item $i of the 'order' option is not a choice.")
295 :     if not defined $label;
296 :     Value::Error("Item $i of the 'order' option was already specified.")
297 :     if not exists $remainingChoices{$label};
298 :     push @orderLabels, $label;
299 :     delete $remainingChoices{$label};
300 :     }
301 :     } elsif (@first or @last) {
302 :     my @firstLabels;
303 :     my @lastLabels;
304 :     my %remainingChoices = %choiceHash;
305 :    
306 :     foreach my $i (0..$#first) {
307 :     my $label = $self->findChoice($first[$i]);
308 :     Value::Error("Item $i of the 'first' option is not a choice.")
309 :     if not defined $label;
310 :     Value::Error("Item $i of the 'first' option was already specified.")
311 :     if not exists $remainingChoices{$label};
312 :     push @firstLabels, $label;
313 :     delete $remainingChoices{$label};
314 :     }
315 :    
316 :     foreach my $i (0..$#last) {
317 :     my $label = $self->findChoice($last[$i]);
318 :     Value::Error("Item $i of the 'last' option is not a choice.")
319 :     if not defined $label;
320 :     Value::Error("Item $i of the 'last' option was already specified.")
321 :     if not exists $remainingChoices{$label};
322 :     push @lastLabels, $label;
323 :     delete $remainingChoices{$label};
324 :     }
325 :    
326 :     @orderLabels = (@firstLabels, keys %remainingChoices, @lastLabels);
327 :     } else {
328 :     # use the order of elements in the hash
329 :     # this is the current behavior
330 :     # might we want to explicitly randomize these?
331 :     @orderLabels = @labels;
332 :     }
333 :    
334 : dpvc 6048 my $label = $self->findChoice($self->{checked});
335 :     return map { ($_ eq $label ? "%$_" : $_) => $choiceHash{$_} } @orderLabels;
336 : sh002i 5672 }
337 :    
338 : dpvc 4773 #
339 : dpvc 4772 # Create the radio-buttons text
340 :     #
341 :     sub buttons {
342 :     my $self = shift;
343 : sh002i 5672 my @radio = main::ans_radio_buttons($self->orderedChoices);
344 : dpvc 4773 @radio = $self->makeUncheckable(@radio) if $self->{uncheckable};
345 : dpvc 4772 (wantarray) ? @radio : join($self->{separator}, @radio);
346 :     }
347 :     sub named_buttons {
348 :     my $self = shift; my $name = shift;
349 : sh002i 5672 my @radio = NAMED_ANS_RADIO_BUTTONS($name,$self->orderedChoices);
350 : dpvc 4773 @radio = $self->makeUncheckable(@radio) if $self->{uncheckable};
351 : dpvc 4772 #
352 :     # Taken from PGbasicmacros.pl
353 :     # It is wrong to have \item in the radio buttons and to add itemize here,
354 :     # but that is the way PGbasicmacros.pl does it.
355 :     #
356 :     if ($displayMode eq 'TeX') {
357 :     $radio[0] = "\n\\begin{itemize}\n" . $radio[0];
358 :     $radio[$#radio_buttons] .= "\n\\end{itemize}\n";
359 :     }
360 :     (wantarray) ? @radio: join($self->{separator}, @radio);
361 :     }
362 :    
363 :     sub ans_rule {shift->buttons(@_)}
364 :     sub named_ans_rule {shift->named_buttons(@_)}
365 :    
366 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9