1: # The LearningOnline Network with CAPA
2: # image click response style
3: #
4: # $Id: imageresponse.pm,v 1.40 2003/11/10 23:29:27 albertel Exp $
5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28: #FIXME LATER assumes multiple possible submissions but only one is possible
29: #currently
30:
31: package Apache::imageresponse;
32: use strict;
33: use Image::Magick;
34: use Apache::randomlylabel;
35: use Apache::Constants qw(:common :http);
36:
37: BEGIN {
38: &Apache::lonxml::register('Apache::imageresponse',('imageresponse'));
39: }
40:
41: sub start_imageresponse {
42: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
43: my $result;
44: #when in a radiobutton response use these
45: &Apache::lonxml::register('Apache::imageresponse',('foilgroup','foil','text','image','rectangle','conceptgroup'));
46: push (@Apache::lonxml::namespace,'imageresponse');
47: my $id = &Apache::response::start_response($parstack,$safeeval);
48: if ($target eq 'meta') {
49: $result=&Apache::response::meta_package_write('imageresponse');
50: } elsif ($target eq 'analyze') {
51: my $part_id="$Apache::inputtags::part.$id";
52: push (@{ $Apache::lonhomework::analyze{"parts"} },$part_id);
53: }
54: return $result;
55: }
56:
57: sub end_imageresponse {
58: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
59: &Apache::response::end_response;
60: pop @Apache::lonxml::namespace;
61: &Apache::lonxml::deregister('Apache::imageresponse',('foilgroup','foil','text','image','rectangle','conceptgroup'));
62: my $result;
63: if ($target eq 'edit') { $result=&Apache::edit::end_table(); }
64: return $result;
65: }
66:
67: %Apache::response::foilgroup=();
68: sub start_foilgroup {
69: %Apache::response::foilgroup=();
70: $Apache::imageresponse::conceptgroup=0;
71: &Apache::response::setrandomnumber();
72: return '';
73: }
74:
75: sub getfoilcounts {
76: my ($parstack,$safeeval)=@_;
77:
78: my $max = &Apache::lonxml::get_param('max',$parstack,$safeeval,'-2');
79: # +1 since instructors will count from 1
80: my $count = $#{ $Apache::response::foilgroup{'names'} }+1;
81: if (&Apache::response::showallfoils()) { $max=$count; }
82: return ($count,$max);
83: }
84:
85: sub whichfoils {
86: my ($max)=@_;
87: if (!defined(@{ $Apache::response::foilgroup{'names'} })) { return; }
88: my @names = @{ $Apache::response::foilgroup{'names'} };
89: my @whichopt =();
90: while ((($#whichopt+1) < $max) && ($#names > -1)) {
91: &Apache::lonxml::debug("Have $#whichopt max is $max");
92: my $aopt;
93: if (&Apache::response::showallfoils()) {
94: $aopt=0;
95: } else {
96: $aopt=int(&Math::Random::random_uniform() * ($#names+1));
97: }
98: &Apache::lonxml::debug("From $#names elms, picking $aopt");
99: $aopt=splice(@names,$aopt,1);
100: &Apache::lonxml::debug("Picked $aopt");
101: push (@whichopt,$aopt);
102: }
103: return @whichopt;
104: }
105:
106: sub prep_image {
107: my ($image)=@_;
108: my $part=$Apache::inputtags::part;
109: my $id=$Apache::inputtags::response['-1'];
110: my $token=$Apache::lonxml::curdepth.'_'.$$;
111: my $args="BGIMG=".$image;
112: &Apache::lonxml::debug("args is $args image is $image");
113: my ($x,$y)=split(/:/,$Apache::lonhomework::history{"resource.$part.$id.submission"});
114: #draws 2 xs on the image at the clicked location
115: #one in white and then one in red on top of the one in white
116: if (defined($x) && defined($y)) {
117: $args.="&LINECOUNT=4";
118: my $length = 6;
119: my $width = 1;
120: my $extrawidth = 2;
121: $args.="&LINEW0=".($width+$extrawidth);
122: $args.="&LINEC0=FFFFFF";
123: $args.="&LINEX10=".($x-$length)."&LINEY10=".($y-$length);
124: $args.="&LINEX20=".($x+$length)."&LINEY20=".($y+$length);
125: $args.="&LINEW1=".($width+$extrawidth);
126: $args.="&LINEC1=FFFFFF";
127: $args.="&LINEX11=".($x-$length)."&LINEY11=".($y+$length);
128: $args.="&LINEX21=".($x+$length)."&LINEY21=".($y-$length);
129: $args.="&LINEW2=$width";
130: $args.="&LINEC2=FF0000";
131: $args.="&LINEX12=".($x-$length)."&LINEY12=".($y-$length);
132: $args.="&LINEX22=".($x+$length)."&LINEY22=".($y+$length);
133: $args.="&LINEW3=$width";
134: $args.="&LINEC3=FF0000";
135: $args.="&LINEX13=".($x-$length)."&LINEY13=".($y+$length);
136: $args.="&LINEX23=".($x+$length)."&LINEY23=".($y-$length);
137: }
138: &Apache::lonxml::debug("args is $args image is $image");
139: &Apache::lonnet::appenv(("imagerequest.$token"=>
140: &Apache::lonnet::escape($args)));
141: return $token;
142: }
143:
144: sub displayfoils {
145: my ($target,@whichopt) = @_;
146: my $result ='';
147: my $name;
148: my $temp=1;
149: foreach $name (@whichopt) {
150: $result.=$Apache::response::foilgroup{"$name.text"};
151: &Apache::lonxml::debug("Text is $result");
152: if ($target eq 'tex') {$result.="\\vskip 0 mm \n";} else {$result.="<br />\n";}
153: my $image=$Apache::response::foilgroup{"$name.image"};
154: &Apache::lonxml::debug("image is $image");
155: if ( $target eq 'web' && $image !~ /^http:/ ) {
156: $image=&Apache::lonnet::filelocation($Apache::lonxml::pwd[-1],$image);
157: if (&Apache::lonnet::repcopy($image) ne OK) {
158: $image='/home/httpd/html/adm/lonKaputt/lonlogo_broken.gif';
159: }
160: }
161: &Apache::lonxml::debug("image is $image");
162: if ( &Apache::response::show_answer() ) {
163: if ($target eq 'tex') {
164: $result.=$Apache::response::foilgroup{"$name.image"}."\\vskip 0 mm \n";
165: } else {
166: my $token=&prep_image($image);
167: $result.="<img src=\"/adm/randomlabel.png?token=$token\" /><br />\n";
168: }
169: } else {
170: if ($target eq 'tex') {
171: $result.=$Apache::response::foilgroup{"$name.image"}."\\vskip 0 mm \n";
172: } else {
173: my $id=$Apache::inputtags::response['-1'];
174: my $token=&prep_image($image);
175: my $temp=1;
176: $result.="<input type=\"image\" name=\"HWVAL_$id:$temp\" ".
177: "src=\"/adm/randomlabel.png?token=$token\" /><br />\n";
178: }
179: }
180: $temp++;
181: }
182: return $result;
183: }
184:
185: sub gradefoils {
186: my (@whichopt) = @_;
187: my $x;
188: my $y;
189: my $result;
190: my $id=$Apache::inputtags::response['-1'];
191: my $temp=1;
192: foreach my $name (@whichopt) {
193: $x=$ENV{"form.HWVAL_$id:$temp.x"};
194: $y=$ENV{"form.HWVAL_$id:$temp.y"};
195: &Apache::lonxml::debug("Got a x of $x and a y of $y for $name");
196: if (defined($x) && defined($y) &&
197: defined(@{ $Apache::response::foilgroup{"$name.area"} })) {
198: my @areas = @{ $Apache::response::foilgroup{"$name.area"} };
199: my $grade="INCORRECT";
200: foreach my $area (@areas) {
201: &Apache::lonxml::debug("Area is $area for $name");
202: $area =~ m/([a-z]*):/;
203: &Apache::lonxml::debug("Area of type $1");
204: if ($1 eq 'rectangle') {
205: $grade=&grade_rectangle($area,$x,$y);
206: } else {
207: &Apache::lonxml::error("Unknown area style $area");
208: }
209: &Apache::lonxml::debug("Area said $grade");
210: if ($grade eq 'APPROX_ANS') { last; }
211: }
212: &Apache::lonxml::debug("Foil was $grade");
213: if ($grade eq 'INCORRECT') { $result= 'INCORRECT'; }
214: if (($grade eq 'APPROX_ANS') && ($result ne 'APPROX_ANS')) { $result=$grade; }
215: &Apache::lonxml::debug("Question is $result");
216: $temp++;
217: }
218: }
219: $Apache::lonhomework::results{"resource.$Apache::inputtags::part.$id.submission"}="$x:$y";
220: $Apache::lonhomework::results{"resource.$Apache::inputtags::part.$id.awarddetail"}=$result;
221: return '';
222: }
223:
224: sub end_foilgroup {
225: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
226: my $result='';
227: my @whichopt;
228: if ($target eq 'web' || $target eq 'grade' || $target eq 'tex' ||
229: $target eq 'analyze') {
230: my ($count,$max) = &getfoilcounts($parstack,$safeeval);
231: if ($count>$max) { $count=$max }
232: &Apache::lonxml::debug("Count is $count from $max");
233: @whichopt = &whichfoils($max);
234: if ($target eq 'web' || $target eq 'tex') {
235: $result=&displayfoils($target,@whichopt);
236: } elsif ($target eq 'grade') {
237: if ( defined $ENV{'form.submitted'}) { &gradefoils(@whichopt); }
238: } elsif ( $target eq 'analyze') {
239: &Apache::response::analyze_store_foilgroup(\@whichopt,
240: ['text','image','area']);
241: }
242: } elsif ($target eq 'edit') {
243: $result=&Apache::edit::end_table();
244: }
245: return $result;
246: }
247:
248: sub start_conceptgroup {
249: $Apache::imageresponse::conceptgroup=1;
250: %Apache::response::conceptgroup=();
251: return '';
252: }
253:
254: sub end_conceptgroup {
255: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
256: $Apache::imageresponse::conceptgroup=0;
257: my $result;
258: if ($target eq 'web' || $target eq 'grade' || $target eq 'tex' ||
259: $target eq 'analyze') {
260: &Apache::response::pick_foil_for_concept($target,
261: ['area','text','image'],
262: \%Apache::hint::image,
263: $parstack,$safeeval);
264: } elsif ($target eq 'edit') {
265: $result=&Apache::edit::end_table();
266: }
267: return $result;
268: }
269:
270: sub insert_foil {
271: return '
272: <foil>
273: <image></image>
274: <text></text>
275: <rectangle></rectangle>
276: </foil>
277: ';
278: }
279:
280: $Apache::imageresponse::curname='';
281: sub start_foil {
282: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
283: if ($target eq 'web' || $target eq 'grade' || $target eq 'tex' ||
284: $target eq 'analyze') {
285: my $name = &Apache::lonxml::get_param('name',$parstack,$safeeval);
286: if ($name eq '') { $name=$Apache::lonxml::curdepth; }
287: if ( $Apache::imageresponse::conceptgroup
288: && !&Apache::response::showallfoils()) {
289: push(@{ $Apache::response::conceptgroup{'names'} }, $name);
290: } else {
291: push(@{ $Apache::response::foilgroup{'names'} }, $name);
292: }
293: $Apache::imageresponse::curname=$name;
294: }
295: return '';
296: }
297:
298: sub end_foil {
299: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
300: my $result;
301: if ($target eq 'edit') {
302: $result=&Apache::edit::end_table();
303: }
304: return $result;
305: }
306:
307: sub start_text {
308: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
309: my $result='';
310: if ($target eq 'web' || $target eq 'tex' || $target eq 'analyze') {
311: &Apache::lonxml::startredirection;
312: } elsif ($target eq 'edit') {
313: my $descr=&Apache::lonxml::get_all_text('/text',$parser);
314: $result=&Apache::edit::tag_start($target,$token,'Task Description').
315: &Apache::edit::editfield($token->[1],$descr,'Text',60,2).
316: &Apache::edit::end_row();
317: } elsif ($target eq "modified") {
318: $result=$token->[4].&Apache::edit::modifiedfield('/text',$parser);
319: }
320: return $result;
321: }
322:
323: sub end_text {
324: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
325: my $result;
326: if ($target eq 'web' || $target eq 'tex' || $target eq 'analyze') {
327: my $name = $Apache::imageresponse::curname;
328: if ( $Apache::imageresponse::conceptgroup
329: && !&Apache::response::showallfoils() ) {
330: $Apache::response::conceptgroup{"$name.text"} = &Apache::lonxml::endredirection;
331: } else {
332: $Apache::response::foilgroup{"$name.text"} = &Apache::lonxml::endredirection;
333: }
334: } elsif ($target eq 'edit') {
335: $result=&Apache::edit::end_table();
336: }
337: return $result;
338: }
339:
340: sub start_image {
341: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
342: my $result='';
343: if ($target eq 'web' || $target eq 'tex' || $target eq 'analyze') {
344: &Apache::lonxml::startredirection;
345: } elsif ($target eq 'edit') {
346: my $bgimg=&Apache::lonxml::get_all_text('/image',$parser);
347: $Apache::edit::bgimgsrc=$bgimg;
348: $Apache::edit::bgimgsrcdepth=$Apache::lonxml::curdepth;
349:
350: $result=&Apache::edit::tag_start($target,$token,'Clickable Image').
351: &Apache::edit::editline($token->[1],$bgimg,'Image Source File',40);
352: $result.=&Apache::edit::browse(undef,'textnode').' ';
353: $result.=&Apache::edit::search(undef,'textnode').
354: &Apache::edit::end_row();
355: } elsif ($target eq "modified") {
356: $result=$token->[4].&Apache::edit::modifiedfield('/image',$parser);
357: }
358: return $result;
359: }
360:
361: sub end_image {
362: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
363: my $result;
364: my $name = $Apache::imageresponse::curname;
365: if ($target eq 'web') {
366: my $image = &Apache::lonxml::endredirection;
367: &Apache::lonxml::debug("original image is $image");
368: if ( $Apache::imageresponse::conceptgroup
369: && !&Apache::response::showallfoils()) {
370: $Apache::response::conceptgroup{"$name.image"} = $image;
371: } else {
372: $Apache::response::foilgroup{"$name.image"} = $image;
373: }
374: } elsif ($target eq 'analyze') {
375: my $image = &Apache::lonxml::endredirection;
376: if ( $Apache::imageresponse::conceptgroup
377: && !&Apache::response::showallfoils()) {
378: $Apache::response::conceptgroup{"$name.image"} = $image;
379: } else {
380: $Apache::response::foilgroup{"$name.image"} = $image;
381: }
382: } elsif ($target eq 'edit') {
383: $result=&Apache::edit::end_table();
384: } elsif ($target eq 'tex') {
385: my $src = &Apache::lonxml::endredirection;
386: $src=&Apache::lonnet::filelocation($Apache::lonxml::pwd[-1],$src);
387: my $width_param = '';
388: my $height_param = '';
389: my $scaling = .3;
390: my $image = Image::Magick->new;
391: my $current_figure = $image->Read($src);
392: $width_param = $image->Get('width') * $scaling;;
393: $height_param = $image->Get('height') * $scaling;;
394: undef $image;
395: my $epssrc = $src;
396: $epssrc =~ s/(\.gif|\.jpg)$/\.eps/i;
397: if (not -e $epssrc) {
398: my $localfile = $epssrc;
399: $localfile =~ s/.*(\/res)/$1/;
400: my $file;
401: my $path;
402: if ($localfile =~ m!(.*)/([^/]*)$!) {
403: $file = $2;
404: $path = $1.'/';
405: }
406: my $signal_eps = 0;
407: my @content_directory = &Apache::lonnet::dirlist($path);
408: for (my $iy=0;$iy<=$#content_directory;$iy++) {
409: my @tempo_array = split(/&/,$content_directory[$iy]);
410: $content_directory[$iy] = $tempo_array[0];
411: if ($file eq $tempo_array[0]) {
412: $signal_eps = 1;
413: last;
414: }
415: }
416: if ($signal_eps) {
417: my $eps_file = &Apache::lonnet::getfile($localfile);
418: } else {
419: $localfile = $src;
420: $localfile =~ s/.*(\/res)/$1/;
421: my $as = &Apache::lonnet::getfile($src);
422: }
423: }
424: my $file;
425: my $path;
426: if ($src =~ m!(.*)/([^/]*)$!) {
427: $file = $2;
428: $path = $1.'/';
429: }
430: my $newsrc = $src;
431: $newsrc =~ s/(\.gif|\.jpg|\.jpeg)$/\.eps/i;
432: $file=~s/(\.gif|\.jpg|\.jpeg)$/\.eps/i;
433: #do we have any specified size of the picture?
434: my $TeXwidth = &Apache::lonxml::get_param('TeXwidth',$parstack,$safeeval);
435: my $TeXheight = &Apache::lonxml::get_param('TeXheight',$parstack,$safeeval);
436: my $width = &Apache::lonxml::get_param('width',$parstack,$safeeval);
437: if ($TeXwidth ne '') {
438: $width_param = $TeXwidth;
439: } elsif ($TeXheight ne '') {
440: $width_param = $TeXheight/$height_param*$width_param;
441: } elsif ($width ne '') {
442: $width_param = $width*$scaling;
443: }
444: #where can we find the picture?
445: if (-e $newsrc) {
446: if ($path) {
447: $Apache::response::foilgroup{"$name.image"} ='\vskip 0 mm \noindent\graphicspath{{'.$path.'}}\includegraphics[width='.$width_param.' mm]{'.$file.'} ';
448: }
449: } else {
450: my $temp_file;
451: my $filename = "/home/httpd/prtspool/$ENV{'user.name'}_$ENV{'user.domain'}_printout.dat";
452: $temp_file = Apache::File->new('>>'.$filename);
453: print $temp_file "$src\n";
454: $Apache::response::foilgroup{"$name.image"} ='\vskip 0 mm \graphicspath{{/home/httpd/prtspool/}}\includegraphics[width='.$width_param.' mm]{'.$file.'} ';
455: }
456: }
457: return $result;
458: }
459:
460: sub start_rectangle {
461: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
462: my $result='';
463: if ($target eq 'web' || $target eq 'grade' || $target eq 'tex' ||
464: $target eq 'analyze') {
465: &Apache::lonxml::startredirection;
466: } elsif ($target eq 'edit') {
467: my $coords=&Apache::lonxml::get_all_text('/rectangle',$parser);
468: $result=&Apache::edit::tag_start($target,$token,'Rectangle').
469: &Apache::edit::editline($token->[1],$coords,'Coordinate Pairs',40).
470: &Apache::edit::entercoordpair(undef,'textnode').
471: &Apache::edit::end_row();
472: } elsif ($target eq "modified") {
473: $result=$token->[4].&Apache::edit::modifiedfield('/rectangle',$parser);
474: }
475: return $result;
476: }
477:
478: sub grade_rectangle {
479: my ($spec,$x,$y) = @_;
480: &Apache::lonxml::debug("Spec is $spec");
481: $spec=~m/rectangle:\(([0-9]+),([0-9]+)\)\-\(([0-9]+),([0-9]+)\)/;
482: my $x1=$1;
483: my $y1=$2;
484: my $x2=$3;
485: my $y2=$4;
486: &Apache::lonxml::debug("Point $x1,$y1,$x2,$y2");
487: if ($x1 > $x2) { my $temp=$x1;$x1=$x2;$x2=$temp; }
488: if ($y1 > $y2) { my $temp=$y1;$y1=$y2;$y2=$temp; }
489: if (($x >= $x1) && ($x <= $x2) && ($y >= $y1) && ($y <= $y2)) {
490: return 'APPROX_ANS';
491: }
492: return 'INCORRECT';
493: }
494:
495: sub end_rectangle {
496: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
497: my $result;
498: if ($target eq 'web' || $target eq 'grade' || $target eq 'tex' ||
499: $target eq 'analyze') {
500: my $name = $Apache::imageresponse::curname;
501: my $area = &Apache::lonxml::endredirection;
502: &Apache::lonxml::debug("out is $area for $name");
503: if ( $Apache::imageresponse::conceptgroup
504: && !&Apache::response::showallfoils()) {
505: push @{ $Apache::response::conceptgroup{"$name.area"} },"rectangle:$area";
506: } else {
507: push @{ $Apache::response::foilgroup{"$name.area"} },"rectangle:$area";
508: }
509: } elsif ($target eq 'edit') {
510: $result=&Apache::edit::end_table();
511: }
512: return $result;
513: }
514: 1;
515: __END__
516:
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