--- loncom/homework/imageresponse.pm 2003/05/05 22:36:54 1.26
+++ loncom/homework/imageresponse.pm 2003/11/11 00:39:33 1.42
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# image click response style
#
-# $Id: imageresponse.pm,v 1.26 2003/05/05 22:36:54 albertel Exp $
+# $Id: imageresponse.pm,v 1.42 2003/11/11 00:39:33 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,209 +25,282 @@
#
# http://www.lon-capa.org/
#
-
#FIXME LATER assumes multiple possible submissions but only one is possible
#currently
package Apache::imageresponse;
use strict;
use Image::Magick;
+use Apache::randomlylabel;
+use Apache::Constants qw(:common :http);
BEGIN {
- &Apache::lonxml::register('Apache::imageresponse',('imageresponse'));
+ &Apache::lonxml::register('Apache::imageresponse',('imageresponse'));
}
sub start_imageresponse {
- my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
- my $result;
- #when in a radiobutton response use these
- &Apache::lonxml::register('Apache::imageresponse',('foilgroup','foil','text','image','rectangle','conceptgroup'));
- push (@Apache::lonxml::namespace,'imageresponse');
- my $id = &Apache::response::start_response($parstack,$safeeval);
- if ($target eq 'meta') {
- $result=&Apache::response::meta_package_write('imageresponse');
- }
- return $result;
+ my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
+ my $result;
+ #when in a radiobutton response use these
+ &Apache::lonxml::register('Apache::imageresponse',('foilgroup','foil','text','image','rectangle','conceptgroup'));
+ push (@Apache::lonxml::namespace,'imageresponse');
+ my $id = &Apache::response::start_response($parstack,$safeeval);
+ if ($target eq 'meta') {
+ $result=&Apache::response::meta_package_write('imageresponse');
+ } elsif ($target eq 'analyze') {
+ my $part_id="$Apache::inputtags::part.$id";
+ push (@{ $Apache::lonhomework::analyze{"parts"} },$part_id);
+ }
+ return $result;
}
sub end_imageresponse {
- &Apache::response::end_response;
- pop @Apache::lonxml::namespace;
- &Apache::lonxml::deregister('Apache::imageresponse',('foilgroup','foil','text','image','rectangle','conceptgroup'));
- return '';
+ my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
+ &Apache::response::end_response;
+ pop @Apache::lonxml::namespace;
+ &Apache::lonxml::deregister('Apache::imageresponse',('foilgroup','foil','text','image','rectangle','conceptgroup'));
+ my $result;
+ if ($target eq 'edit') { $result=&Apache::edit::end_table(); }
+ return $result;
}
%Apache::response::foilgroup=();
sub start_foilgroup {
- %Apache::response::foilgroup=();
- $Apache::imageresponse::conceptgroup=0;
- &Apache::response::setrandomnumber();
- return '';
+ %Apache::response::foilgroup=();
+ $Apache::imageresponse::conceptgroup=0;
+ &Apache::response::setrandomnumber();
+ return '';
}
sub getfoilcounts {
- my ($parstack,$safeeval)=@_;
+ my ($parstack,$safeeval)=@_;
- my $max = &Apache::lonxml::get_param('max',$parstack,$safeeval,'-2');
- # +1 since instructors will count from 1
- my $count = $#{ $Apache::response::foilgroup{'names'} }+1;
- if (&Apache::response::showallfoils()) { $max=$count; }
- return ($count,$max);
+ my $max = &Apache::lonxml::get_param('max',$parstack,$safeeval,'-2');
+ # +1 since instructors will count from 1
+ my $count = $#{ $Apache::response::foilgroup{'names'} }+1;
+ if (&Apache::response::showallfoils()) { $max=$count; }
+ return ($count,$max);
}
sub whichfoils {
- my ($max)=@_;
- if (!defined(@{ $Apache::response::foilgroup{'names'} })) { return; }
- my @names = @{ $Apache::response::foilgroup{'names'} };
- my @whichopt =();
- while ((($#whichopt+1) < $max) && ($#names > -1)) {
- &Apache::lonxml::debug("Have $#whichopt max is $max");
- my $aopt;
- if (&Apache::response::showallfoils()) {
- $aopt=0;
- } else {
- $aopt=int(&Math::Random::random_uniform() * ($#names+1));
- }
- &Apache::lonxml::debug("From $#names elms, picking $aopt");
- $aopt=splice(@names,$aopt,1);
- &Apache::lonxml::debug("Picked $aopt");
- push (@whichopt,$aopt);
- }
- return @whichopt;
+ my ($max)=@_;
+ if (!defined(@{ $Apache::response::foilgroup{'names'} })) { return; }
+ my @names = @{ $Apache::response::foilgroup{'names'} };
+ my @whichopt =();
+ while ((($#whichopt+1) < $max) && ($#names > -1)) {
+ &Apache::lonxml::debug("Have $#whichopt max is $max");
+ my $aopt;
+ if (&Apache::response::showallfoils()) {
+ $aopt=0;
+ } else {
+ $aopt=int(&Math::Random::random_uniform() * ($#names+1));
+ }
+ &Apache::lonxml::debug("From $#names elms, picking $aopt");
+ $aopt=splice(@names,$aopt,1);
+ &Apache::lonxml::debug("Picked $aopt");
+ push (@whichopt,$aopt);
+ }
+ return @whichopt;
+}
+
+sub prep_image {
+ my ($image,$mode,$name)=@_;
+ my $part=$Apache::inputtags::part;
+ my $respid=$Apache::inputtags::response['-1'];
+ my $id=&Apache::loncommon::get_cgi_id();
+ my %x;
+ $x{"cgi.$id.BGIMG"}=$image;
+ my ($x,$y)=split(/:/,$Apache::lonhomework::history{"resource.$part.$respid.submission"});
+ #draws 2 xs on the image at the clicked location
+ #one in white and then one in red on top of the one in white
+ if (defined($x) && defined($y)) {
+ $x{"cgi.$id.LINECOUNT"}=4;
+ my $length = 6;
+ my $width = 1;
+ my $extrawidth = 2;
+ $x{"cgi.$id.LINE0"}=
+ join(':',(($x-$length),($y-$length),($x+$length),($y+$length),
+ "FFFFFF",($width+$extrawidth)));
+ $x{"cgi.$id.LINE1"}=
+ join(':',(($x-$length),($y+$length),($x+$length),($y-$length),
+ "FFFFFF",($width+$extrawidth)));
+ $x{"cgi.$id.LINE2"}=
+ join(':',(($x-$length),($y-$length),($x+$length),($y+$length),
+ "FF0000",($width)));
+ $x{"cgi.$id.LINE3"}=
+ join(':',(($x-$length),($y+$length),($x+$length),($y-$length),
+ "FF0000",($width)));
+ }
+ if ($mode eq 'answer') {
+ my $width = 1;
+ my $extrawidth = 2;
+ my @areas = @{ $Apache::response::foilgroup{"$name.area"} };
+ foreach my $area (@areas) {
+ my ($x1,$y1,$x2,$y2)=
+ ($area=~m/rectangle:\(([0-9]+),([0-9]+)\)\-\(([0-9]+),([0-9]+)\)/);
+ my $i=$x{"cgi.$id.BOXCOUNT"}++;
+ $x{"cgi.$id.BOX$i"}=join(':',($x1,$y1,$x2,$y2,"FFFFFF",
+ ($width+$extrawidth)));
+ $i=$x{"cgi.$id.BOXCOUNT"}++;
+ $x{"cgi.$id.BOX$i"}=join(':',($x1,$y1,$x2,$y2,"00FF00",$width));
+ }
+ }
+ &Apache::lonnet::appenv(%x);
+ return $id;
}
sub displayfoils {
- my ($target,@whichopt) = @_;
- my $result ='';
- my $name;
- my $temp=1;
- foreach $name (@whichopt) {
- $result.=$Apache::response::foilgroup{"$name.text"};
- if ($target eq 'tex') {$result.="\\vskip 0 mm \n";} else {$result.="
\n";}
- my $image=$Apache::response::foilgroup{"$name.image"};
- if ($Apache::lonhomework::history{"resource.$Apache::inputtags::part.solved"} =~ /^correct/ ) {
- if ($target eq 'tex') {
- $result.=$Apache::response::foilgroup{"$name.image"}."\\vskip 0 mm \n";
- } else {
- $result.="
\n";
- }
- } else {
- if ($target eq 'tex') {
- $result.=$Apache::response::foilgroup{"$name.image"}."\\vskip 0 mm \n";
- } else {
- $result.="
\n";
- }
- }
- $temp++;
- }
- return $result;
+ my ($target,@whichopt) = @_;
+ my $result ='';
+ my $name;
+ my $temp=1;
+ foreach $name (@whichopt) {
+ $result.=$Apache::response::foilgroup{"$name.text"};
+ &Apache::lonxml::debug("Text is $result");
+ if ($target eq 'tex') {$result.="\\vskip 0 mm \n";} else {$result.="
\n";}
+ my $image=$Apache::response::foilgroup{"$name.image"};
+ &Apache::lonxml::debug("image is $image");
+ if ( $target eq 'web' && $image !~ /^http:/ ) {
+ $image=&Apache::lonnet::filelocation($Apache::lonxml::pwd[-1],$image);
+ if (&Apache::lonnet::repcopy($image) ne OK) {
+ $image='/home/httpd/html/adm/lonKaputt/lonlogo_broken.gif';
+ }
+ }
+ &Apache::lonxml::debug("image is $image");
+ if ( &Apache::response::show_answer() ) {
+ if ($target eq 'tex') {
+ $result.=$Apache::response::foilgroup{"$name.image"}."\\vskip 0 mm \n";
+ } else {
+ my $token=&prep_image($image,'answer',$name);
+ $result.="
\n";
+ }
+ } else {
+ if ($target eq 'tex') {
+ $result.=$Apache::response::foilgroup{"$name.image"}."\\vskip 0 mm \n";
+ } else {
+ my $id=$Apache::inputtags::response['-1'];
+ my $token=&prep_image($image);
+ my $temp=1;
+ $result.="
\n";
+ }
+ }
+ $temp++;
+ }
+ return $result;
}
sub gradefoils {
- my (@whichopt) = @_;
- my $x;
- my $y;
- my $result;
- my $id=$Apache::inputtags::response['-1'];
- my $temp=1;
- foreach my $name (@whichopt) {
- $x=$ENV{"form.HWVAL_$id:$temp.x"};
- $y=$ENV{"form.HWVAL_$id:$temp.y"};
- &Apache::lonxml::debug("Got a x of $x and a y of $y for $name");
- if (defined(@{ $Apache::response::foilgroup{"$name.area"} })) {
- my @areas = @{ $Apache::response::foilgroup{"$name.area"} };
- my $grade="INCORRECT";
- foreach my $area (@areas) {
- &Apache::lonxml::debug("Area is $area for $name");
- $area =~ m/([a-z]*):/;
- &Apache::lonxml::debug("Area of type $1");
- if ($1 eq 'rectangle') {
- $grade=&grade_rectangle($area,$x,$y);
- } else {
- &Apache::lonxml::error("Unknown area style $area");
+ my (@whichopt) = @_;
+ my $x;
+ my $y;
+ my $result;
+ my $id=$Apache::inputtags::response['-1'];
+ my $temp=1;
+ foreach my $name (@whichopt) {
+ $x=$ENV{"form.HWVAL_$id:$temp.x"};
+ $y=$ENV{"form.HWVAL_$id:$temp.y"};
+ &Apache::lonxml::debug("Got a x of $x and a y of $y for $name");
+ if (defined($x) && defined($y) &&
+ defined(@{ $Apache::response::foilgroup{"$name.area"} })) {
+ my @areas = @{ $Apache::response::foilgroup{"$name.area"} };
+ my $grade="INCORRECT";
+ foreach my $area (@areas) {
+ &Apache::lonxml::debug("Area is $area for $name");
+ $area =~ m/([a-z]*):/;
+ &Apache::lonxml::debug("Area of type $1");
+ if ($1 eq 'rectangle') {
+ $grade=&grade_rectangle($area,$x,$y);
+ } else {
+ &Apache::lonxml::error("Unknown area style $area");
+ }
+ &Apache::lonxml::debug("Area said $grade");
+ if ($grade eq 'APPROX_ANS') { last; }
+ }
+ &Apache::lonxml::debug("Foil was $grade");
+ if ($grade eq 'INCORRECT') { $result= 'INCORRECT'; }
+ if (($grade eq 'APPROX_ANS') && ($result ne 'APPROX_ANS')) { $result=$grade; }
+ &Apache::lonxml::debug("Question is $result");
+ $temp++;
}
- &Apache::lonxml::debug("Area said $grade");
- if ($grade eq 'APPROX_ANS') { last; }
- }
- &Apache::lonxml::debug("Foil was $grade");
- if ($grade eq 'INCORRECT') { $result= 'INCORRECT'; }
- if (($grade eq 'APPROX_ANS') && ($result ne 'APPROX_ANS')) { $result=$grade; }
- &Apache::lonxml::debug("Question is $result");
- $temp++;
- }
- }
- $Apache::lonhomework::results{"resource.$Apache::inputtags::part.$id.submission"}="$x:$y";
- $Apache::lonhomework::results{"resource.$Apache::inputtags::part.$id.awarddetail"}=$result;
- return '';
+ }
+ $Apache::lonhomework::results{"resource.$Apache::inputtags::part.$id.submission"}="$x:$y";
+ $Apache::lonhomework::results{"resource.$Apache::inputtags::part.$id.awarddetail"}=$result;
+ return '';
}
sub end_foilgroup {
- my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
- my $result='';
- my @whichopt;
- if ($target eq 'web' || $target eq 'grade' || $target eq 'tex') {
- my ($count,$max) = &getfoilcounts($parstack,$safeeval);
- if ($count>$max) { $count=$max }
- &Apache::lonxml::debug("Count is $count from $max");
- @whichopt = &whichfoils($max);
- } elsif ($target eq 'web' || $target eq 'tex') {
- $result=&displayfoils($target,@whichopt);
- } elsif ($target eq 'grade') {
- if ( defined $ENV{'form.submitted'}) {
- &gradefoils(@whichopt);
- }
- } elsif ($target eq 'edit') {
- $result=&Apache::edit::end_table();
- }
- return $result;
+ my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
+ my $result='';
+ my @whichopt;
+ if ($target eq 'web' || $target eq 'grade' || $target eq 'tex' ||
+ $target eq 'analyze') {
+ my ($count,$max) = &getfoilcounts($parstack,$safeeval);
+ if ($count>$max) { $count=$max }
+ &Apache::lonxml::debug("Count is $count from $max");
+ @whichopt = &whichfoils($max);
+ if ($target eq 'web' || $target eq 'tex') {
+ $result=&displayfoils($target,@whichopt);
+ } elsif ($target eq 'grade') {
+ if ( defined $ENV{'form.submitted'}) { &gradefoils(@whichopt); }
+ } elsif ( $target eq 'analyze') {
+ &Apache::response::analyze_store_foilgroup(\@whichopt,
+ ['text','image','area']);
+ }
+ } elsif ($target eq 'edit') {
+ $result=&Apache::edit::end_table();
+ }
+ return $result;
}
sub start_conceptgroup {
- $Apache::imageresponse::conceptgroup=1;
- %Apache::response::conceptgroup=();
- return '';
+ $Apache::imageresponse::conceptgroup=1;
+ %Apache::response::conceptgroup=();
+ return '';
}
sub end_conceptgroup {
- my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
- $Apache::imageresponse::conceptgroup=0;
- my $result;
- if ($target eq 'web' || $target eq 'grade' || $target eq 'tex') {
- if (defined(@{ $Apache::response::conceptgroup{'names'} })) {
- my @names = @{ $Apache::response::conceptgroup{'names'} };
- my $pick=int(&Math::Random::random_uniform() * ($#names+1));
- my $name=$names[$pick];
- if (defined(@{ $Apache::response::conceptgroup{"$name.area"} })) {
- push @{ $Apache::response::foilgroup{'names'} }, $name;
- $Apache::response::foilgroup{"$name.text"} = $Apache::response::conceptgroup{"$name.text"};
- $Apache::response::foilgroup{"$name.image"} = $Apache::response::conceptgroup{"$name.image"};
- push(@{ $Apache::response::foilgroup{"$name.area"} }, @{ $Apache::response::conceptgroup{"$name.area"} });
- my $concept = &Apache::lonxml::get_param('concept',$parstack,$safeeval);
- $Apache::response::foilgroup{"$name.concept"} = $concept;
- &Apache::lonxml::debug("Selecting $name in $concept");
- }
- }
- } elsif ($target eq 'edit') {
- $result=&Apache::edit::end_table();
- }
- return $result;
+ my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
+ $Apache::imageresponse::conceptgroup=0;
+ my $result;
+ if ($target eq 'web' || $target eq 'grade' || $target eq 'tex' ||
+ $target eq 'analyze') {
+ &Apache::response::pick_foil_for_concept($target,
+ ['area','text','image'],
+ \%Apache::hint::image,
+ $parstack,$safeeval);
+ } elsif ($target eq 'edit') {
+ $result=&Apache::edit::end_table();
+ }
+ return $result;
+}
+
+sub insert_foil {
+ return '
+
The server encountered an internal error or misconfiguration and was unable to complete your request.
Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.
More information about this error may be available in the server error log.