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
8:
9: #FIXME assumes multiple possible submissions but only one is possible currently
10:
11: package Apache::imageresponse;
12: use strict;
13:
14: # ======================================================================= BEGIN
15: sub BEGIN {
16: &Apache::lonxml::register('Apache::imageresponse',('imageresponse'));
17: }
18:
19: # ======================================================== Start image response
20: sub start_imageresponse {
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 '';
30: }
31:
32: # ========================================================== End image response
33: sub end_imageresponse {
34: &Apache::response::end_response;
35: pop @Apache::lonxml::namespace;
36: return '';
37: }
38:
39: %Apache::response::foilgroup = {};
40: # ============================================================ Start foil group
41: sub start_foilgroup {
42: %Apache::response::foilgroup = {};
43: $Apache::imageresponse::conceptgroup = 0;
44: &Apache::response::setrandomnumber();
45: return '';
46: }
47:
48: # =================================== Get foil counts (returns 2 element array)
49: sub getfoilcounts {
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);
55: }
56:
57: # ============================================== Which foils (returns an array)
58: sub whichfoils {
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;
72: }
73:
74: # ======================================= Display foils (returns scalar string)
75: sub displayfoils {
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++;
93: }
94: return $result;
95: }
96:
97: # ================================================================= Grade foils
98: sub gradefoils {
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++;
131: }
132: }
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 '';
140: }
141:
142: # ======================================= End foil group (return scalar string)
143: sub end_foilgroup {
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: }
160: }
161: return $result;
162: }
163:
164: # ========================================================= Start concept group
165: sub start_conceptgroup {
166: $Apache::imageresponse::conceptgroup = 1;
167: %Apache::response::conceptgroup = {};
168: return '';
169: }
170:
171: # =========================================================== End concept group
172: sub end_conceptgroup {
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: }
194: }
195: return '';
196: }
197:
198: $Apache::imageresponse::curname = '';
199: # ================================================================== Start foil
200: sub start_foil {
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;
211: }
212: return '';
213: }
214:
215: # ==================================================================== End foil
216: sub end_foil {
217: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style) = @_;
218: return '';
219: }
220:
221: # ================================================================== Start text
222: sub start_text {
223: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style) = @_;
224: if ($target eq 'web') { &Apache::lonxml::startredirection; }
225: return '';
226: }
227:
228: # ==================================================================== End text
229: sub end_text {
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: }
240: }
241: return '';
242: }
243:
244: # ================================================================= Start image
245: sub start_image {
246: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style) = @_;
247: if ($target eq 'web') { &Apache::lonxml::startredirection; }
248: return '';
249: }
250:
251: # =================================================================== End image
252: sub end_image {
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: }
263: }
264: return '';
265: }
266:
267: # ============================================================= Start rectangle
268: sub start_rectangle {
269: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style) = @_;
270: if ($target eq 'web' || $target eq 'grade') {
271: &Apache::lonxml::startredirection;
272: }
273: return '';
274: }
275:
276: # ============================================================= Grade rectangle
277: sub grade_rectangle {
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';
291: }
292:
293: # =============================================================== End rectangle
294: sub end_rectangle {
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"} },"rectangle:$area";
305: }
306: }
307: return '';
308: }
309:
310: 1;
311:
312: __END__
313:
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