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