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