Annotation of loncom/homework/imageresponse.pm, revision 1.10
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.10 ! harris41 276: # ============================================================= Grade rectangle
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.10 ! harris41 295: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style) = @_;
1.3 albertel 296: if ($target eq 'web' || $target eq 'grade') {
1.2 albertel 297: my $name = $Apache::imageresponse::curname;
1.3 albertel 298: my $area = &Apache::lonxml::endredirection;
299: &Apache::lonxml::debug("out is $area for $name");
1.7 albertel 300: if ( $Apache::imageresponse::conceptgroup ) {
1.10 ! harris41 301: push @{ $Apache::response::conceptgroup{"$name.area"} },
! 302: "rectangle:$area";
1.7 albertel 303: } else {
304: push @{ $Apache::response::foilgroup{"$name.area"} },"rectangle:$area";
305: }
1.2 albertel 306: }
1.3 albertel 307: return '';
1.1 albertel 308: }
1.10 ! harris41 309:
1.1 albertel 310: 1;
1.10 ! harris41 311:
1.1 albertel 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