--- loncom/homework/imageresponse.pm 2004/01/14 22:59:18 1.44 +++ loncom/homework/imageresponse.pm 2005/06/22 12:03:23 1.72 @@ -2,7 +2,7 @@ # The LearningOnline Network with CAPA # image click response style # -# $Id: imageresponse.pm,v 1.44 2004/01/14 22:59:18 albertel Exp $ +# $Id: imageresponse.pm,v 1.72 2005/06/22 12:03:23 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -31,9 +31,12 @@ package Apache::imageresponse; use strict; -use Image::Magick; -use Apache::randomlylabel; +use Image::Magick(); +use Apache::randomlylabel(); +use Apache::londefdef(); use Apache::Constants qw(:common :http); +use Apache::lonlocal; +use Apache::lonnet; BEGIN { &Apache::lonxml::register('Apache::imageresponse',('imageresponse')); @@ -48,6 +51,7 @@ sub start_imageresponse { 'polygon','conceptgroup')); push (@Apache::lonxml::namespace,'imageresponse'); my $id = &Apache::response::start_response($parstack,$safeeval); + undef(%Apache::response::foilnames); if ($target eq 'meta') { $result=&Apache::response::meta_package_write('imageresponse'); } elsif ($target eq 'analyze') { @@ -64,6 +68,7 @@ sub end_imageresponse { &Apache::lonxml::deregister('Apache::imageresponse',('foilgroup','foil','text','image','rectangle','conceptgroup')); my $result; if ($target eq 'edit') { $result=&Apache::edit::end_table(); } + undef(%Apache::response::foilnames); return $result; } @@ -71,7 +76,7 @@ sub end_imageresponse { sub start_foilgroup { %Apache::response::foilgroup=(); $Apache::imageresponse::conceptgroup=0; - &Apache::response::setrandomnumber(); + &Apache::response::pushrandomnumber(); return ''; } @@ -81,7 +86,7 @@ sub getfoilcounts { 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; } + #if (&Apache::response::showallfoils()) { $max=$count; } return ($count,$max); } @@ -93,11 +98,11 @@ sub whichfoils { while ((($#whichopt+1) < $max) && ($#names > -1)) { &Apache::lonxml::debug("Have $#whichopt max is $max"); my $aopt; - if (&Apache::response::showallfoils()) { - $aopt=0; - } else { +# 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"); @@ -111,28 +116,36 @@ sub prep_image { 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,$i); + $x{"cgi.$id.BGIMG"}=&Apache::lonnet::escape($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; + if (defined($x) && $x=~/\S/ && defined($y) && $y =~/\S/ && !&Apache::response::show_answer()) { 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))); + my $xmin=($x-$length); + my $xmax=($x+$length); + my $ymin=($y-$length); + my $ymax=($y+$length); + + $x{"cgi.$id.OBJTYPE"}.='LINE:'; + $i=$x{"cgi.$id.OBJCOUNT"}++; + $x{"cgi.$id.OBJ$i"}=join(':',(($xmin),($ymin),($xmax),($ymax), + "FFFFFF",($width+$extrawidth))); + $x{"cgi.$id.OBJTYPE"}.='LINE:'; + $i=$x{"cgi.$id.OBJCOUNT"}++; + $x{"cgi.$id.OBJ$i"}=join(':',(($xmin),($ymax),($xmax),($ymin), + "FFFFFF",($width+$extrawidth))); + $x{"cgi.$id.OBJTYPE"}.='LINE:'; + $i=$x{"cgi.$id.OBJCOUNT"}++; + $x{"cgi.$id.OBJ$i"}=join(':',(($xmin),($ymin),($xmax),($ymax), + "FF0000",($width))); + $x{"cgi.$id.OBJTYPE"}.='LINE:'; + $i=$x{"cgi.$id.OBJCOUNT"}++; + $x{"cgi.$id.OBJ$i"}=join(':',(($xmin),($ymax),($xmax),($ymin), + "FF0000",($width))); } if ($mode eq 'answer') { my $width = 1; @@ -140,20 +153,24 @@ sub prep_image { my @areas = @{ $Apache::response::foilgroup{"$name.area"} }; foreach my $area (@areas) { if ($area=~/^rectangle:/) { + $x{"cgi.$id.OBJTYPE"}.='RECTANGLE:'; + $i=$x{"cgi.$id.OBJCOUNT"}++; 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", + $x{"cgi.$id.OBJ$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)); + $x{"cgi.$id.OBJTYPE"}.='RECTANGLE:'; + $i=$x{"cgi.$id.OBJCOUNT"}++; + $x{"cgi.$id.OBJ$i"}=join(':',($x1,$y1,$x2,$y2,"00FF00",$width)); } elsif ($area=~/^polygon:(.*)/) { - my $i=$x{"cgi.$id.POLYCOUNT"}++; - $x{"cgi.$id.POLYOPT$i"}=join(':',("FFFFFF",($width+$extrawidth))); - $x{"cgi.$id.POLY$i"}=$1; - $i=$x{"cgi.$id.POLYCOUNT"}++; - $x{"cgi.$id.POLYOPT$i"}=join(':',("00FF00",$width)); - $x{"cgi.$id.POLY$i"}=$1; + $x{"cgi.$id.OBJTYPE"}.='POLYGON:'; + $i=$x{"cgi.$id.OBJCOUNT"}++; + $x{"cgi.$id.OBJ$i"}=join(':',("FFFFFF",($width+$extrawidth))); + $x{"cgi.$id.OBJEXTRA$i"}=$1; + $x{"cgi.$id.OBJTYPE"}.='POLYGON:'; + $i=$x{"cgi.$id.OBJCOUNT"}++; + $x{"cgi.$id.OBJ$i"}=join(':',("00FF00",$width)); + $x{"cgi.$id.OBJEXTRA$i"}=$1; } } } @@ -173,11 +190,8 @@ sub displayfoils { 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'; - } - } + $image=&clean_up_image($image); + } &Apache::lonxml::debug("image is $image"); if ( &Apache::response::show_answer() ) { if ($target eq 'tex') { @@ -202,6 +216,26 @@ sub displayfoils { return $result; } +sub clean_up_image { + my ($image)=@_; + if ($image =~ /\s*[_1] appears more than once. Foil names need to be unique.",$name)); + } + $Apache::response::foilnames{$name}++; if ( $Apache::imageresponse::conceptgroup - && !&Apache::response::showallfoils()) { + #&& !&Apache::response::showallfoils() + ) { push(@{ $Apache::response::conceptgroup{'names'} }, $name); } else { push(@{ $Apache::response::foilgroup{'names'} }, $name); } $Apache::imageresponse::curname=$name; - } - return ''; + } elsif ($target eq 'edit') { + $result = &Apache::edit::tag_start($target,$token); + $result .= &Apache::edit::text_arg('Name:','name',$token); + $result .= &Apache::edit::end_row(). + &Apache::edit::start_spanning_row(); + } elsif ($target eq 'modified') { + my $constructtag=&Apache::edit::get_new_args($token,$parstack, + $safeeval,'name'); + if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); } + } + return $result;; } sub end_foil { @@ -348,7 +407,8 @@ sub end_text { if ($target eq 'web' || $target eq 'tex' || $target eq 'analyze') { my $name = $Apache::imageresponse::curname; if ( $Apache::imageresponse::conceptgroup - && !&Apache::response::showallfoils() ) { + #&& !&Apache::response::showallfoils() + ) { $Apache::response::conceptgroup{"$name.text"} = &Apache::lonxml::endredirection; } else { $Apache::response::foilgroup{"$name.text"} = &Apache::lonxml::endredirection; @@ -385,18 +445,20 @@ sub end_image { my $result; my $name = $Apache::imageresponse::curname; if ($target eq 'web') { - my $image = &Apache::lonxml::endredirection; + my $image = &Apache::lonxml::endredirection(); &Apache::lonxml::debug("original image is $image"); if ( $Apache::imageresponse::conceptgroup - && !&Apache::response::showallfoils()) { + #&& !&Apache::response::showallfoils() + ) { $Apache::response::conceptgroup{"$name.image"} = $image; } else { $Apache::response::foilgroup{"$name.image"} = $image; } } elsif ($target eq 'analyze') { - my $image = &Apache::lonxml::endredirection; + my $image = &Apache::lonxml::endredirection(); if ( $Apache::imageresponse::conceptgroup - && !&Apache::response::showallfoils()) { + #&& !&Apache::response::showallfoils() + ) { $Apache::response::conceptgroup{"$name.image"} = $image; } else { $Apache::response::foilgroup{"$name.image"} = $image; @@ -404,77 +466,31 @@ sub end_image { } elsif ($target eq 'edit') { $result=&Apache::edit::end_table(); } elsif ($target eq 'tex') { - my $src = &Apache::lonxml::endredirection; - $src=&Apache::lonnet::filelocation($Apache::lonxml::pwd[-1],$src); - my $width_param = ''; - my $height_param = ''; - my $scaling = .3; - my $image = Image::Magick->new; - my $current_figure = $image->Read($src); - $width_param = $image->Get('width') * $scaling;; - $height_param = $image->Get('height') * $scaling;; - undef $image; - my $epssrc = $src; - $epssrc =~ s/(\.gif|\.jpg)$/\.eps/i; - if (not -e $epssrc) { - my $localfile = $epssrc; - $localfile =~ s/.*(\/res)/$1/; - my $file; - my $path; - if ($localfile =~ m!(.*)/([^/]*)$!) { - $file = $2; - $path = $1.'/'; - } - my $signal_eps = 0; - my @content_directory = &Apache::lonnet::dirlist($path); - for (my $iy=0;$iy<=$#content_directory;$iy++) { - my @tempo_array = split(/&/,$content_directory[$iy]); - $content_directory[$iy] = $tempo_array[0]; - if ($file eq $tempo_array[0]) { - $signal_eps = 1; - last; - } - } - if ($signal_eps) { - my $eps_file = &Apache::lonnet::getfile($localfile); - } else { - $localfile = $src; - $localfile =~ s/.*(\/res)/$1/; - my $as = &Apache::lonnet::getfile($src); - } - } - my $file; - my $path; - if ($src =~ m!(.*)/([^/]*)$!) { - $file = $2; - $path = $1.'/'; - } - my $newsrc = $src; - $newsrc =~ s/(\.gif|\.jpg|\.jpeg)$/\.eps/i; - $file=~s/(\.gif|\.jpg|\.jpeg)$/\.eps/i; - #do we have any specified size of the picture? - my $TeXwidth = &Apache::lonxml::get_param('TeXwidth',$parstack,$safeeval); - my $TeXheight = &Apache::lonxml::get_param('TeXheight',$parstack,$safeeval); - my $width = &Apache::lonxml::get_param('width',$parstack,$safeeval); - if ($TeXwidth ne '') { - $width_param = $TeXwidth; - } elsif ($TeXheight ne '') { - $width_param = $TeXheight/$height_param*$width_param; - } elsif ($width ne '') { - $width_param = $width*$scaling; - } - #where can we find the picture? - if (-e $newsrc) { - if ($path) { - $Apache::response::foilgroup{"$name.image"} ='\vskip 0 mm \noindent\graphicspath{{'.$path.'}}\includegraphics[width='.$width_param.' mm]{'.$file.'} '; - } + my $src = &Apache::lonxml::endredirection(); + + # There may be all sorts of whitespace on fore and aft: + + $src =~ s/\s+$//s; + $src =~ s/^\s+//s; + + # + # Gnuplot e.g. just generates the latex to put inplace. + # + my $graphinclude; + if ($src =~ /^%DYNAMICIMAGE/) { + # This is needed because the newline is not always passed -> tex. + # At present we don't care about the sizing info. + + my ($commentline, $restofstuff) = split(/\n/, $src); + $graphinclude = $src; + $graphinclude =~ s/^$commentline//; } else { - my $temp_file; - my $filename = "/home/httpd/prtspool/$ENV{'user.name'}_$ENV{'user.domain'}_printout.dat"; - $temp_file = Apache::File->new('>>'.$filename); - print $temp_file "$src\n"; - $Apache::response::foilgroup{"$name.image"} ='\vskip 0 mm \graphicspath{{/home/httpd/prtspool/}}\includegraphics[width='.$width_param.' mm]{'.$file.'} '; + my ($path,$file) = &Apache::londefdef::get_eps_image($src); + my ($height_param,$width_param)= + &Apache::londefdef::image_size($src,0.3,$parstack,$safeeval); + $graphinclude = '\graphicspath{{'.$path.'}}\includegraphics[width='.$width_param.' mm]{'.$file.'}'; } + $Apache::response::foilgroup{"$name.image"} ='\vskip 0 mm \noindent '.$graphinclude; } return $result; } @@ -518,9 +534,11 @@ sub end_rectangle { $target eq 'analyze') { my $name = $Apache::imageresponse::curname; my $area = &Apache::lonxml::endredirection; + $area=~s/\s//g; &Apache::lonxml::debug("out is $area for $name"); if ( $Apache::imageresponse::conceptgroup - && !&Apache::response::showallfoils()) { + #&& !&Apache::response::showallfoils() + ) { push @{ $Apache::response::conceptgroup{"$name.area"} },"rectangle:$area"; } else { push @{ $Apache::response::foilgroup{"$name.area"} },"rectangle:$area"; @@ -597,9 +615,11 @@ sub end_polygon { $target eq 'analyze') { my $name = $Apache::imageresponse::curname; my $area = &Apache::lonxml::endredirection; + $area=~s/\s*//g; &Apache::lonxml::debug("out is $area for $name"); if ( $Apache::imageresponse::conceptgroup - && !&Apache::response::showallfoils()) { + #&& !&Apache::response::showallfoils() + ) { push @{ $Apache::response::conceptgroup{"$name.area"} },"polygon:$area"; } else { push @{ $Apache::response::foilgroup{"$name.area"} },"polygon:$area";