1: # The LearningOnline Network with CAPA
2: # image click response style
3: #
4: # $Id: imageresponse.pm,v 1.14 2001/12/04 15:17:56 albertel Exp $
5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28:
29: #FIXME assumes multiple possbile submissions but only one is possible currently
30:
31: package Apache::imageresponse;
32: use strict;
33:
34: sub BEGIN {
35: &Apache::lonxml::register('Apache::imageresponse',('imageresponse'));
36: }
37:
38: sub start_imageresponse {
39: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
40: my $result;
41: #when in a radiobutton response use these
42: &Apache::lonxml::register('Apache::imageresponse',('foilgroup','foil','text','image','rectangle','conceptgroup'));
43: push (@Apache::lonxml::namespace,'imageresponse');
44: my $id = &Apache::response::start_response($parstack,$safeeval);
45: if ($target eq 'meta') {
46: $result=&Apache::response::meta_package_write('imageresponse');
47: }
48: return $result;
49: }
50:
51: sub end_imageresponse {
52: &Apache::response::end_response;
53: pop @Apache::lonxml::namespace;
54: return '';
55: }
56:
57: %Apache::response::foilgroup={};
58: sub start_foilgroup {
59: %Apache::response::foilgroup={};
60: $Apache::imageresponse::conceptgroup=0;
61: &Apache::response::setrandomnumber();
62: return '';
63: }
64:
65: sub getfoilcounts {
66: my ($parstack,$safeeval)=@_;
67:
68: my $max = &Apache::lonxml::get_param('max',$parstack,$safeeval,'-2');
69: # +1 since instructors will count from 1
70: my $count = $#{ $Apache::response::foilgroup{'names'} }+1;
71: return ($count,$max);
72: }
73:
74: sub whichfoils {
75: my ($max)=@_;
76: if (!defined(@{ $Apache::response::foilgroup{'names'} })) { return; }
77: my @names = @{ $Apache::response::foilgroup{'names'} };
78: my @whichopt =();
79: while ((($#whichopt+1) < $max) && ($#names > -1)) {
80: &Apache::lonxml::debug("Have $#whichopt max is $max");
81: my $aopt=int(rand($#names+1));
82: &Apache::lonxml::debug("From $#names elms, picking $aopt");
83: $aopt=splice(@names,$aopt,1);
84: &Apache::lonxml::debug("Picked $aopt");
85: push (@whichopt,$aopt);
86: }
87: return @whichopt;
88: }
89:
90: sub displayfoils {
91: my (@whichopt) = @_;
92: my $result ='';
93: my $name;
94: my $temp=1;
95: foreach $name (@whichopt) {
96: $result.=$Apache::response::foilgroup{"$name.text"}."<br />\n";
97: my $image=$Apache::response::foilgroup{"$name.image"};
98: if ($Apache::lonhomework::history{"resource.$Apache::inputtags::part.solved"} =~ /^correct/ ) {
99: $result.="<img src=\"$image\"/> <br />\n";
100: } else {
101: $result.="<input type=\"image\" name=\"HWVAL_$Apache::inputtags::response['-1']:$temp\" src=\"$image\"/> <br />\n";
102: }
103: $temp++;
104: }
105: return $result;
106: }
107:
108: sub gradefoils {
109: my (@whichopt) = @_;
110: my $result='';
111: my $x;
112: my $y;
113: my $result;
114: my $id=$Apache::inputtags::response['-1'];
115: my $temp=1;
116: foreach my $name (@whichopt) {
117: $x=$ENV{"form.HWVAL_$id:$temp.x"};
118: $y=$ENV{"form.HWVAL_$id:$temp.y"};
119: &Apache::lonxml::debug("Got a x of $x and a y of $y for $name");
120: if (defined(@{ $Apache::response::foilgroup{"$name.area"} })) {
121: my @areas = @{ $Apache::response::foilgroup{"$name.area"} };
122: my $grade="INCORRECT";
123: foreach my $area (@areas) {
124: &Apache::lonxml::debug("Area is $area for $name");
125: $area =~ m/([a-z]*):/;
126: &Apache::lonxml::debug("Area of type $1");
127: if ($1 eq 'rectangle') {
128: $grade=&grade_rectangle($area,$x,$y);
129: } else {
130: &Apache::lonxml::error("Unknown area style $area");
131: }
132: &Apache::lonxml::debug("Area said $grade");
133: if ($grade eq 'APPROX_ANS') { last; }
134: }
135: &Apache::lonxml::debug("Foil was $grade");
136: if ($grade eq 'INCORRECT') { $result= 'INCORRECT'; }
137: if (($grade eq 'APPROX_ANS') && ($result ne 'APPROX_ANS')) { $result=$grade; }
138: &Apache::lonxml::debug("Question is $result");
139: $temp++;
140: }
141: }
142: $Apache::lonhomework::results{"resource.$Apache::inputtags::part.$id.submission"}="$x:$y";
143: $Apache::lonhomework::results{"resource.$Apache::inputtags::part.$id.awarddetail"}=$result;
144: return '';
145: }
146:
147: sub end_foilgroup {
148: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
149: my $result='';
150: my @whichopt;
151: if ($target eq 'web' || $target eq 'grade') {
152: my ($count,$max) = &getfoilcounts($parstack,$safeeval);
153: if ($count>$max) { $count=$max }
154: &Apache::lonxml::debug("Count is $count from $max");
155: @whichopt = &whichfoils($max);
156: }
157: if ($target eq 'web') {
158: $result=&displayfoils(@whichopt);
159: }
160: if ($target eq 'grade') {
161: if ( defined $ENV{'form.submitted'}) {
162: &gradefoils(@whichopt);
163: }
164: }
165: return $result;
166: }
167:
168: sub start_conceptgroup {
169: $Apache::imageresponse::conceptgroup=1;
170: %Apache::response::conceptgroup={};
171: return '';
172: }
173:
174: sub end_conceptgroup {
175: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
176: $Apache::imageresponse::conceptgroup=0;
177: if ($target eq 'web' || $target eq 'grade') {
178: if (defined(@{ $Apache::response::conceptgroup{'names'} })) {
179: my @names = @{ $Apache::response::conceptgroup{'names'} };
180: my $pick=int(rand($#names+1));
181: my $name=$names[$pick];
182: if (defined(@{ $Apache::response::conceptgroup{"$name.area"} })) {
183: push @{ $Apache::response::foilgroup{'names'} }, $name;
184: $Apache::response::foilgroup{"$name.text"} = $Apache::response::conceptgroup{"$name.text"};
185: $Apache::response::foilgroup{"$name.image"} = $Apache::response::conceptgroup{"$name.image"};
186: push(@{ $Apache::response::foilgroup{"$name.area"} }, @{ $Apache::response::conceptgroup{"$name.area"} });
187: my $concept = &Apache::lonxml::get_param('concept',$parstack,$safeeval);
188: $Apache::response::foilgroup{"$name.concept"} = $concept;
189: &Apache::lonxml::debug("Selecting $name in $concept");
190: }
191: }
192: }
193: return '';
194: }
195:
196: $Apache::imageresponse::curname='';
197: sub start_foil {
198: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
199: if ($target eq 'web' || $target eq 'grade') {
200: my $name = &Apache::lonxml::get_param('name',$parstack,$safeeval);
201: if ($name eq '') { $name=$Apache::lonxml::curdepth; }
202: if ( $Apache::imageresponse::conceptgroup ) {
203: push(@{ $Apache::response::conceptgroup{'names'} }, $name);
204: } else {
205: push(@{ $Apache::response::foilgroup{'names'} }, $name);
206: }
207: $Apache::imageresponse::curname=$name;
208: }
209: return '';
210: }
211:
212: sub end_foil {
213: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
214: return '';
215: }
216:
217: sub start_text {
218: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
219: if ($target eq 'web') { &Apache::lonxml::startredirection; }
220: return '';
221: }
222:
223: sub end_text {
224: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
225: if ($target eq 'web') {
226: my $name = $Apache::imageresponse::curname;
227: if ( $Apache::imageresponse::conceptgroup ) {
228: $Apache::response::conceptgroup{"$name.text"} = &Apache::lonxml::endredirection;
229: } else {
230: $Apache::response::foilgroup{"$name.text"} = &Apache::lonxml::endredirection;
231: }
232: }
233: return '';
234: }
235:
236: sub start_image {
237: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
238: if ($target eq 'web') { &Apache::lonxml::startredirection; }
239: return '';
240: }
241:
242: sub end_image {
243: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
244: if ($target eq 'web') {
245: my $name = $Apache::imageresponse::curname;
246: my $image = &Apache::lonxml::endredirection;
247: &Apache::lonxml::debug("out is $image");
248: if ( $Apache::imageresponse::conceptgroup ) {
249: $Apache::response::conceptgroup{"$name.image"} = $image;
250: } else {
251: $Apache::response::foilgroup{"$name.image"} = $image;
252: }
253: }
254: return '';
255: }
256:
257: sub start_rectangle {
258: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
259: if ($target eq 'web' || $target eq 'grade') { &Apache::lonxml::startredirection; }
260: return '';
261: }
262:
263: sub grade_rectangle {
264: my ($spec,$x,$y) = @_;
265: &Apache::lonxml::debug("Spec is $spec");
266: $spec=~m/rectangle:\(([0-9]+),([0-9]+)\)\-\(([0-9]+),([0-9]+)\)/;
267: my $x1=$1;
268: my $y1=$2;
269: my $x2=$3;
270: my $y2=$4;
271: &Apache::lonxml::debug("Point $x1,$y1,$x2,$y2");
272: if ($x1 > $x2) { my $temp=$x1;$x1=$x2;$x2=$temp; }
273: if ($y1 > $y2) { my $temp=$y1;$y1=$y2;$y2=$temp; }
274: if ($x => $x1) { if ($x <= $x2) { if ($y => $y1) { if ($y <= $y2) { return 'APPROX_ANS'; } } } }
275: return 'INCORRECT';
276: }
277:
278: sub end_rectangle {
279: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
280: if ($target eq 'web' || $target eq 'grade') {
281: my $name = $Apache::imageresponse::curname;
282: my $area = &Apache::lonxml::endredirection;
283: &Apache::lonxml::debug("out is $area for $name");
284: if ( $Apache::imageresponse::conceptgroup ) {
285: push @{ $Apache::response::conceptgroup{"$name.area"} },"rectangle:$area";
286: } else {
287: push @{ $Apache::response::foilgroup{"$name.area"} },"rectangle:$area";
288: }
289: }
290: return '';
291: }
292: 1;
293: __END__
294:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>