Annotation of loncom/homework/imageresponse.pm, revision 1.11
1.10 harris41 1: # The LON-CAPA image response handler
2: #
3: # Image click response style
4: #
5: # YEAR=2001
6: # 2/7,2/9,2/22,3/1,5/4,5/15,5/31,6/2,6/26 Guy Albertelli
7: # 8/6 Scott Harrison
1.1 albertel 8:
1.10 harris41 9: #FIXME assumes multiple possible submissions but only one is possible currently
1.3 albertel 10:
1.1 albertel 11: package Apache::imageresponse;
12: use strict;
13:
1.10 harris41 14: # ======================================================================= BEGIN
1.1 albertel 15: sub BEGIN {
1.10 harris41 16: &Apache::lonxml::register('Apache::imageresponse',('imageresponse'));
1.1 albertel 17: }
18:
1.10 harris41 19: # ======================================================== Start image response
1.1 albertel 20: sub start_imageresponse {
1.10 harris41 21: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style) = @_;
22: #when in a radiobutton response use these
23: &Apache::lonxml::register('Apache::imageresponse',('foilgroup','foil',
24: 'text','image',
25: 'rectangle',
26: 'conceptgroup'));
27: push (@Apache::lonxml::namespace,'imageresponse');
28: my $id = &Apache::response::start_response($parstack,$safeeval);
29: return '';
1.1 albertel 30: }
31:
1.10 harris41 32: # ========================================================== End image response
1.1 albertel 33: sub end_imageresponse {
1.10 harris41 34: &Apache::response::end_response;
35: pop @Apache::lonxml::namespace;
36: return '';
1.1 albertel 37: }
38:
1.10 harris41 39: %Apache::response::foilgroup = {};
40: # ============================================================ Start foil group
1.1 albertel 41: sub start_foilgroup {
1.10 harris41 42: %Apache::response::foilgroup = {};
43: $Apache::imageresponse::conceptgroup = 0;
44: &Apache::response::setrandomnumber();
45: return '';
1.1 albertel 46: }
47:
1.10 harris41 48: # =================================== Get foil counts (returns 2 element array)
1.2 albertel 49: sub getfoilcounts {
1.10 harris41 50: my ($parstack,$safeeval) = @_;
51: my $max = &Apache::lonxml::get_param('max',$parstack,$safeeval,'-2');
52: # +1 since instructors will count from 1
53: my $count = $#{ $Apache::response::foilgroup{'names'} }+1;
54: return ($count,$max);
1.2 albertel 55: }
56:
1.10 harris41 57: # ============================================== Which foils (returns an array)
1.2 albertel 58: sub whichfoils {
1.10 harris41 59: my ($max) = @_;
60: if (!defined(@{ $Apache::response::foilgroup{'names'} })) { return; }
61: my @names = @{ $Apache::response::foilgroup{'names'} };
62: my @whichopt =();
63: while ((($#whichopt+1) < $max) && ($#names > -1)) {
64: &Apache::lonxml::debug("Have $#whichopt max is $max");
65: my $aopt = int(rand($#names+1));
66: &Apache::lonxml::debug("From $#names elms, picking $aopt");
67: $aopt = splice(@names,$aopt,1);
68: &Apache::lonxml::debug("Picked $aopt");
69: push (@whichopt,$aopt);
70: }
71: return @whichopt;
1.2 albertel 72: }
73:
1.10 harris41 74: # ======================================= Display foils (returns scalar string)
1.2 albertel 75: sub displayfoils {
1.10 harris41 76: my (@whichopt) = @_;
77: my $result ='';
78: my $name;
79: my $temp = 1;
80: foreach $name (@whichopt) {
81: $result .= $Apache::response::foilgroup{"$name.text"}."<br />\n";
82: my $image = $Apache::response::foilgroup{"$name.image"};
83: if ($Apache::lonhomework::history{'resource.'.
84: $Apache::inputtags::part.
85: '.solved'} =~ /^correct/) {
86: $result .= "<img src=\"$image\"/> <br />\n";
87: } else {
88: $result .= "<input type=\"image\" name=\"HWVAL_".
89: $Apache::inputtags::response['-1'].
90: ":$temp\" src=\"$image\"/> <br />\n";
91: }
92: $temp++;
1.3 albertel 93: }
1.10 harris41 94: return $result;
1.2 albertel 95: }
96:
1.10 harris41 97: # ================================================================= Grade foils
1.3 albertel 98: sub gradefoils {
1.10 harris41 99: my (@whichopt) = @_;
100: my $result = '';
101: my $x;
102: my $y;
103: my $result;
104: my $id = $Apache::inputtags::response['-1'];
105: my $temp = 1;
106: foreach my $name (@whichopt) {
107: $x = $ENV{"form.HWVAL_$id:$temp.x"};
108: $y = $ENV{"form.HWVAL_$id:$temp.y"};
109: &Apache::lonxml::debug("Got a x of $x and a y of $y for $name");
110: if (defined(@{ $Apache::response::foilgroup{"$name.area"} })) {
111: my @areas = @{ $Apache::response::foilgroup{"$name.area"} };
112: my $grade = "INCORRECT";
113: foreach my $area (@areas) {
114: &Apache::lonxml::debug("Area is $area for $name");
115: $area =~ m/([a-z]*):/;
116: &Apache::lonxml::debug("Area of type $1");
117: if ($1 eq 'rectangle') {
118: $grade = &grade_rectangle($area,$x,$y);
119: } else {
120: &Apache::lonxml::error("Unknown area style $area");
121: }
122: &Apache::lonxml::debug("Area said $grade");
123: if ($grade eq 'APPROX_ANS') { last; }
124: }
125: &Apache::lonxml::debug("Foil was $grade");
126: if ($grade eq 'INCORRECT') { $result = 'INCORRECT'; }
127: if (($grade eq 'APPROX_ANS') && ($result ne 'APPROX_ANS')) {
128: $result = $grade; }
129: &Apache::lonxml::debug("Question is $result");
130: $temp++;
1.9 albertel 131: }
1.3 albertel 132: }
1.10 harris41 133: $Apache::lonhomework::results{'resource.'.
134: $Apache::inputtags::part.
135: ".$id.submission"} = "$x:$y";
136: $Apache::lonhomework::results{'resource.'.
137: $Apache::inputtags::part.
138: ".$id.awarddetail"} = $result;
139: return '';
1.3 albertel 140: }
141:
1.10 harris41 142: # ======================================= End foil group (return scalar string)
1.1 albertel 143: sub end_foilgroup {
1.10 harris41 144: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style) = @_;
145: my $result = '';
146: my @whichopt;
147: if ($target eq 'web' || $target eq 'grade') {
148: my ($count,$max) = &getfoilcounts($parstack,$safeeval);
149: if ($count > $max) { $count = $max }
150: &Apache::lonxml::debug("Count is $count from $max");
151: @whichopt = &whichfoils($max);
152: }
153: if ($target eq 'web') {
154: $result = &displayfoils(@whichopt);
155: }
156: if ($target eq 'grade') {
157: if ( defined $ENV{'form.submitted'}) {
158: &gradefoils(@whichopt);
159: }
1.3 albertel 160: }
1.10 harris41 161: return $result;
1.1 albertel 162: }
163:
1.10 harris41 164: # ========================================================= Start concept group
1.1 albertel 165: sub start_conceptgroup {
1.10 harris41 166: $Apache::imageresponse::conceptgroup = 1;
167: %Apache::response::conceptgroup = {};
168: return '';
1.1 albertel 169: }
170:
1.10 harris41 171: # =========================================================== End concept group
1.1 albertel 172: sub end_conceptgroup {
1.10 harris41 173: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style) = @_;
174: $Apache::imageresponse::conceptgroup = 0;
175: if ($target eq 'web' || $target eq 'grade') {
176: if (defined(@{ $Apache::response::conceptgroup{'names'} })) {
177: my @names = @{ $Apache::response::conceptgroup{'names'} };
178: my $pick = int(rand($#names+1));
179: my $name = $names[$pick];
180: if (defined(@{ $Apache::response::conceptgroup{"$name.area"} })) {
181: push @{ $Apache::response::foilgroup{'names'} }, $name;
182: $Apache::response::foilgroup{"$name.text"} =
183: $Apache::response::conceptgroup{"$name.text"};
184: $Apache::response::foilgroup{"$name.image"} =
185: $Apache::response::conceptgroup{"$name.image"};
186: push(@{ $Apache::response::foilgroup{"$name.area"} },
187: @{ $Apache::response::conceptgroup{"$name.area"} });
188: my $concept = &Apache::lonxml::get_param('concept',$parstack,
189: $safeeval);
190: $Apache::response::foilgroup{"$name.concept"} = $concept;
191: &Apache::lonxml::debug("Selecting $name in $concept");
192: }
193: }
1.9 albertel 194: }
1.10 harris41 195: return '';
1.1 albertel 196: }
197:
1.10 harris41 198: $Apache::imageresponse::curname = '';
199: # ================================================================== Start foil
1.1 albertel 200: sub start_foil {
1.10 harris41 201: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
202: if ($target eq 'web' || $target eq 'grade') {
203: my $name = &Apache::lonxml::get_param('name',$parstack,$safeeval);
204: if ($name eq '') { $name=$Apache::lonxml::curdepth; }
205: if ( $Apache::imageresponse::conceptgroup ) {
206: push(@{ $Apache::response::conceptgroup{'names'} }, $name);
207: } else {
208: push(@{ $Apache::response::foilgroup{'names'} }, $name);
209: }
210: $Apache::imageresponse::curname=$name;
1.7 albertel 211: }
1.10 harris41 212: return '';
1.1 albertel 213: }
214:
1.10 harris41 215: # ==================================================================== End foil
1.1 albertel 216: sub end_foil {
1.10 harris41 217: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style) = @_;
218: return '';
1.1 albertel 219: }
220:
1.10 harris41 221: # ================================================================== Start text
1.1 albertel 222: sub start_text {
1.10 harris41 223: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style) = @_;
224: if ($target eq 'web') { &Apache::lonxml::startredirection; }
225: return '';
1.1 albertel 226: }
227:
1.10 harris41 228: # ==================================================================== End text
1.1 albertel 229: sub end_text {
1.10 harris41 230: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style) = @_;
231: if ($target eq 'web') {
232: my $name = $Apache::imageresponse::curname;
233: if ( $Apache::imageresponse::conceptgroup ) {
234: $Apache::response::conceptgroup{"$name.text"} =
235: &Apache::lonxml::endredirection;
236: } else {
237: $Apache::response::foilgroup{"$name.text"} =
238: &Apache::lonxml::endredirection;
239: }
1.7 albertel 240: }
1.10 harris41 241: return '';
1.1 albertel 242: }
243:
1.10 harris41 244: # ================================================================= Start image
1.1 albertel 245: sub start_image {
1.10 harris41 246: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style) = @_;
247: if ($target eq 'web') { &Apache::lonxml::startredirection; }
248: return '';
1.1 albertel 249: }
250:
1.10 harris41 251: # =================================================================== End image
1.1 albertel 252: sub end_image {
1.10 harris41 253: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style) = @_;
254: if ($target eq 'web') {
255: my $name = $Apache::imageresponse::curname;
256: my $image = &Apache::lonxml::endredirection;
257: &Apache::lonxml::debug("out is $image");
258: if ( $Apache::imageresponse::conceptgroup ) {
259: $Apache::response::conceptgroup{"$name.image"} = $image;
260: } else {
261: $Apache::response::foilgroup{"$name.image"} = $image;
262: }
1.7 albertel 263: }
1.10 harris41 264: return '';
1.1 albertel 265: }
266:
1.10 harris41 267: # ============================================================= Start rectangle
1.1 albertel 268: sub start_rectangle {
1.10 harris41 269: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style) = @_;
270: if ($target eq 'web' || $target eq 'grade') {
271: &Apache::lonxml::startredirection;
272: }
273: return '';
1.1 albertel 274: }
275:
1.11 ! harris41 276: # ====================================== Grade rectangle (return scalar string)
1.3 albertel 277: sub grade_rectangle {
1.10 harris41 278: my ($spec,$x,$y) = @_;
279: &Apache::lonxml::debug("Spec is $spec");
280: $spec =~ m/rectangle:\(([0-9]+),([0-9]+)\)\-\(([0-9]+),([0-9]+)\)/;
281: my $x1 = $1;
282: my $y1 = $2;
283: my $x2 = $3;
284: my $y2 = $4;
285: &Apache::lonxml::debug("Point $x1,$y1,$x2,$y2");
286: if ($x1 > $x2) { my $temp = $x1; $x1 = $x2; $x2 = $temp; }
287: if ($y1 > $y2) { my $temp = $y1; $y1 = $y2; $y2 = $temp; }
288: if ($x => $x1) { if ($x <= $x2) { if ($y => $y1) {
289: if ($y <= $y2) { return 'APPROX_ANS'; } } } }
290: return 'INCORRECT';
1.3 albertel 291: }
292:
1.10 harris41 293: # =============================================================== End rectangle
1.1 albertel 294: sub end_rectangle {
1.11 ! harris41 295: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style) = @_;
! 296: if ($target eq 'web' || $target eq 'grade') {
! 297: my $name = $Apache::imageresponse::curname;
! 298: my $area = &Apache::lonxml::endredirection;
! 299: &Apache::lonxml::debug("out is $area for $name");
! 300: if ( $Apache::imageresponse::conceptgroup ) {
! 301: push @{ $Apache::response::conceptgroup{"$name.area"} },
! 302: "rectangle:$area";
! 303: } else {
! 304: push @{ $Apache::response::foilgroup{"$name.area"} },
! 305: "rectangle:$area";
! 306: }
1.7 albertel 307: }
1.11 ! harris41 308: return '';
1.1 albertel 309: }
1.10 harris41 310:
1.1 albertel 311: 1;
1.10 harris41 312:
1.1 albertel 313: __END__
314:
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