Annotation of loncom/homework/imageresponse.pm, revision 1.14
1.12 albertel 1: # The LearningOnline Network with CAPA
1.14 ! albertel 2: # image click response style
! 3: #
! 4: # $Id: gplheader.pl,v 1.1 2001/11/29 18:19:27 www 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: #
1.1 albertel 28:
1.12 albertel 29: #FIXME assumes multiple possbile submissions but only one is possible currently
1.3 albertel 30:
1.1 albertel 31: package Apache::imageresponse;
32: use strict;
33:
34: sub BEGIN {
1.12 albertel 35: &Apache::lonxml::register('Apache::imageresponse',('imageresponse'));
1.1 albertel 36: }
37:
38: sub start_imageresponse {
1.12 albertel 39: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.13 albertel 40: my $result;
1.12 albertel 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);
1.13 albertel 45: if ($target eq 'meta') {
46: $result=&Apache::response::meta_package_write('imageresponse');
47: }
48: return $result;
1.1 albertel 49: }
50:
51: sub end_imageresponse {
1.12 albertel 52: &Apache::response::end_response;
53: pop @Apache::lonxml::namespace;
54: return '';
1.1 albertel 55: }
56:
1.12 albertel 57: %Apache::response::foilgroup={};
1.1 albertel 58: sub start_foilgroup {
1.12 albertel 59: %Apache::response::foilgroup={};
60: $Apache::imageresponse::conceptgroup=0;
61: &Apache::response::setrandomnumber();
62: return '';
1.1 albertel 63: }
64:
1.2 albertel 65: sub getfoilcounts {
1.12 albertel 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);
1.2 albertel 72: }
73:
74: sub whichfoils {
1.12 albertel 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;
1.2 albertel 88: }
89:
90: sub displayfoils {
1.12 albertel 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;
1.2 albertel 106: }
107:
1.3 albertel 108: sub gradefoils {
1.12 albertel 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");
1.9 albertel 131: }
1.12 albertel 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 '';
1.3 albertel 145: }
146:
1.1 albertel 147: sub end_foilgroup {
1.12 albertel 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);
1.3 albertel 163: }
1.12 albertel 164: }
165: return $result;
1.1 albertel 166: }
167:
168: sub start_conceptgroup {
1.12 albertel 169: $Apache::imageresponse::conceptgroup=1;
170: %Apache::response::conceptgroup={};
171: return '';
1.1 albertel 172: }
173:
174: sub end_conceptgroup {
1.12 albertel 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: }
1.9 albertel 191: }
1.12 albertel 192: }
193: return '';
1.1 albertel 194: }
195:
1.12 albertel 196: $Apache::imageresponse::curname='';
1.1 albertel 197: sub start_foil {
1.12 albertel 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 '';
1.1 albertel 210: }
211:
212: sub end_foil {
1.12 albertel 213: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
214: return '';
1.1 albertel 215: }
216:
217: sub start_text {
1.12 albertel 218: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
219: if ($target eq 'web') { &Apache::lonxml::startredirection; }
220: return '';
1.1 albertel 221: }
222:
223: sub end_text {
1.12 albertel 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;
1.7 albertel 231: }
1.12 albertel 232: }
233: return '';
1.1 albertel 234: }
235:
236: sub start_image {
1.12 albertel 237: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
238: if ($target eq 'web') { &Apache::lonxml::startredirection; }
239: return '';
1.1 albertel 240: }
241:
242: sub end_image {
1.12 albertel 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;
1.7 albertel 252: }
1.12 albertel 253: }
254: return '';
1.1 albertel 255: }
256:
257: sub start_rectangle {
1.12 albertel 258: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
259: if ($target eq 'web' || $target eq 'grade') { &Apache::lonxml::startredirection; }
260: return '';
1.1 albertel 261: }
262:
1.3 albertel 263: sub grade_rectangle {
1.12 albertel 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';
1.3 albertel 276: }
277:
1.1 albertel 278: sub end_rectangle {
1.12 albertel 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";
1.7 albertel 288: }
1.12 albertel 289: }
290: return '';
1.1 albertel 291: }
292: 1;
293: __END__
294:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to imageresponse.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / homework