[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 5392 - (view) (download) (as text)

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9