[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 5672 - (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 : sh002i 5672 # $CVSHeader: pg/macros/parserRadioButtons.pl,v 1.10 2007/10/04 16:40: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 4772 my %choiceHash = $self->choiceHash(1);
162 :     $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 :     }
182 :    
183 : dpvc 4772 #
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 : sh002i 5672 my $choice = $self->findChoice($value);
191 :     return $choice if defined $choice;
192 : dpvc 4772 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 : dpvc 4773 # 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 : sh002i 5672 #
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 : dpvc 4773 #
342 : dpvc 4772 # Create the radio-buttons text
343 :     #
344 :     sub buttons {
345 :     my $self = shift;
346 : sh002i 5672 my @radio = main::ans_radio_buttons($self->orderedChoices);
347 : dpvc 4773 @radio = $self->makeUncheckable(@radio) if $self->{uncheckable};
348 : dpvc 4772 (wantarray) ? @radio : join($self->{separator}, @radio);
349 :     }
350 :     sub named_buttons {
351 :     my $self = shift; my $name = shift;
352 : sh002i 5672 my @radio = NAMED_ANS_RADIO_BUTTONS($name,$self->orderedChoices);
353 : dpvc 4773 @radio = $self->makeUncheckable(@radio) if $self->{uncheckable};
354 : dpvc 4772 #
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