Parent Directory
| 
Revision Log
Normalized comments and headers to that they will format their POD documentation properly. (I know that the POD processing was supposed to strip off the initial #, but that doesn't seem to happen, so I've added a space throughout.)
1 loadMacros('MathObjects.pl','contextString.pl'); 2 3 sub _parserRadioButtons_init {}; # don't reload this file 4 5 =head1 DESCRIPTION 6 7 #################################################################### 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 69 =cut 70 71 sub RadioButtons {parserRadioButtons->new(@_)} 72 73 # 74 # The package that implements RadioButtons 75 # 76 package parserRadioButtons; 77 our @ISA = qw(Value::String); 78 79 my $jsPrinted = 0; # true when the JavaScript has been printed 80 81 82 # 83 # Create a new RadioButtons object 84 # 85 sub new { 86 my $self = shift; my $class = ref($self) || $self; 87 my $context = (Value::isContext($_[0]) ? shift : $self->context); 88 my $choices = shift; my $value = shift; 89 my %options; 90 main::set_default_options(\%options, 91 labels => [], 92 separator => $main::BR, 93 checked => undef, 94 maxLabelSize => 25, 95 uncheckable => 0, 96 @_, 97 ); 98 $options{labels} = [1..scalar(@$choices)] if $options{labels} eq "123"; 99 $options{labels} = [@main::ALPHABET[0..scalar(@$choices)-1]] if $options{labels} eq "ABC"; 100 my $self = bless {%options, choices=>$choices}, $class; # temporary to so we can call our methods 101 Value::Error("A RadioButton's first argument should be a list of button labels") 102 unless ref($choices) eq 'ARRAY'; 103 Value::Error("A RadioButton's second argument should be the correct button choice") 104 unless defined($value) && $value ne ""; 105 my $context = Parser::Context->getCopy("String"); 106 my %choiceHash = $self->choiceHash(1); 107 $context->strings->add(map {$_=>{}} (keys %choiceHash)); 108 $value = $self->correctChoice($value); 109 $self = bless $context->Package("String")->new($context,$value)->with( 110 isValue => 1, choices => $choices, %options), $class; 111 $self->JavaScript if $self->{uncheckable}; 112 return $self; 113 } 114 115 # 116 # Locate the label of the correct answer 117 # The answer can be given as an index, as the full answer 118 # or as the label itself. 119 # 120 sub correctChoice { 121 my $self = shift; my $value = shift; 122 my $index = $self->Index($value); 123 foreach my $i (0..scalar(@{$self->{choices}})-1) { 124 my $label = $self->{labels}[$i]; my $choice = $self->{choices}[$i]; 125 $label = $self->makeLabel($choice) unless defined $label; 126 return $label if $label eq $value || $index == $i || $choice eq $value; 127 } 128 Value::Error("The correct answer should be one of the button choices"); 129 } 130 131 # 132 # Create the hash of label => answer pairs to be used for the 133 # ans_radio_buttons() routine 134 # 135 sub choiceHash { 136 my $self = shift; my $noChecked = shift; 137 my @radio = (); 138 my $index = $self->Index($self->{checked}); 139 my $checked = $self->{checked}; $checked = "" unless defined $checked; 140 if ($noChecked) {$checked = ""; $index = -1} 141 foreach my $i (0..scalar(@{$self->{choices}})-1) { 142 my $label = $self->{labels}[$i]; my $choice = $self->{choices}[$i]; 143 $label = $self->makeLabel($choice) unless defined $label; 144 $label = "%$label" if $label eq $checked || $index == $i || $choice eq $checked; 145 push(@radio, $label,$choice); 146 } 147 return @radio; 148 } 149 150 # 151 # Create a label for the answer, either using the labels 152 # provided by the user, or by creating one from the answer 153 # string (restrict its length so that the results table 154 # will not be overflowed). 155 # 156 sub makeLabel { 157 my $self = shift; my $choice = shift; 158 return $choice if length($choice) < $self->{maxLabelSize}; 159 my @words = split(/\b/,$choice); 160 my ($s,$e) = ('',''); 161 do {$s .= shift(@words); $e = pop(@words) . $e} 162 while length($s) + length($e) + 15 < $self->{maxLabelSize} && scalar(@words); 163 return $s . " ... " . $e; 164 } 165 166 # 167 # Get a numeric index (-1 if not defined or not a number) 168 # 169 sub Index { 170 my $self = shift; my $index = shift; 171 return -1 unless defined $index && $index =~ m/^\d$/; 172 return $index; 173 } 174 175 # 176 # Print the JavaScript needed for uncheckable radio buttons 177 # 178 sub JavaScript { 179 return if $main::displayMode eq 'TeX'; 180 return if $jsPrinted; 181 main::TEXT( 182 "\n<script>\n" . 183 "if (window.ww == null) {var ww = {}}\n" . 184 "if (ww.RadioButtons == null) {ww.RadioButtons = {}}\n" . 185 "if (ww.RadioButtons.selected == null) {ww.RadioButtons.selected = {}}\n" . 186 "ww.RadioButtons.Toggle = function (obj,event,shift) {\n" . 187 " if (!event) {event = window.event}\n" . 188 " if (shift && !event.shiftKey) {\n" . 189 " this.selected[obj.name] = obj\n" . 190 " return\n" . 191 " }\n" . 192 " var selected = this.selected[obj.name]\n" . 193 " if (selected && selected == obj) {\n". 194 " this.selected[obj.name] = null\n" . 195 " obj.checked = false\n" . 196 " } else {\n" . 197 " this.selected[obj.name] = obj\n". 198 " }\n" . 199 "}\n". 200 "</script>\n" 201 ); 202 $jsSPrinted = 1; 203 } 204 205 sub makeUncheckable { 206 my $self = shift; 207 my $shift = ($self->{uncheckable} =~ m/shift/i ? ",1" : ""); 208 my $onclick = "onclick=\"ww.RadioButtons.Toggle(this,event$shift)\""; 209 my @radio = @_; 210 foreach (@radio) {$_ =~ s/<INPUT/<INPUT $onclick/i} 211 return @radio; 212 } 213 214 # 215 # Create the radio-buttons text 216 # 217 sub buttons { 218 my $self = shift; 219 my @radio = main::ans_radio_buttons($self->choiceHash); 220 @radio = $self->makeUncheckable(@radio) if $self->{uncheckable}; 221 (wantarray) ? @radio : join($self->{separator}, @radio); 222 } 223 sub named_buttons { 224 my $self = shift; my $name = shift; 225 my @radio = NAMED_ANS_RADIO_BUTTONS($name,$self->choiceHash); 226 @radio = $self->makeUncheckable(@radio) if $self->{uncheckable}; 227 # 228 # Taken from PGbasicmacros.pl 229 # It is wrong to have \item in the radio buttons and to add itemize here, 230 # but that is the way PGbasicmacros.pl does it. 231 # 232 if ($displayMode eq 'TeX') { 233 $radio[0] = "\n\\begin{itemize}\n" . $radio[0]; 234 $radio[$#radio_buttons] .= "\n\\end{itemize}\n"; 235 } 236 (wantarray) ? @radio: join($self->{separator}, @radio); 237 } 238 239 sub ans_rule {shift->buttons(@_)} 240 sub named_ans_rule {shift->named_buttons(@_)} 241 242 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |