--- loncom/homework/imageresponse.pm 2003/06/09 22:31:56 1.30 +++ loncom/homework/imageresponse.pm 2003/08/01 14:22:07 1.33 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # image click response style # -# $Id: imageresponse.pm,v 1.30 2003/06/09 22:31:56 albertel Exp $ +# $Id: imageresponse.pm,v 1.33 2003/08/01 14:22:07 ng Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,13 +25,15 @@ # # http://www.lon-capa.org/ # - +# July,August 2003 H. K. Ng +# #FIXME LATER assumes multiple possible submissions but only one is possible #currently package Apache::imageresponse; use strict; use Image::Magick; +use GD; BEGIN { &Apache::lonxml::register('Apache::imageresponse',('imageresponse')); @@ -218,6 +220,16 @@ sub end_conceptgroup { return $result; } +sub insert_foil { + return ' + + + + + +'; +} + $Apache::imageresponse::curname=''; sub start_foil { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; @@ -302,13 +314,64 @@ sub start_image { return $result; } +sub get_image { + my ($imgsrc,$set_trans)=@_; + my $image; + if ($imgsrc !~ /\.(png|jpg|jpeg)$/i) { + my $conv_image = Image::Magick->new; + my $current_figure = $conv_image->Read('filename'=>$imgsrc); + $conv_image->Set('magick'=>'png'); + my @blobs=$conv_image->ImageToBlob(); + undef $conv_image; + $image = GD::Image->new($blobs[0]); + } else { + GD::Image->trueColor(1); + $image = GD::Image->new($imgsrc); + } + if ($set_trans && defined($image)) { + my $white=$image->colorExact(255,255,255); + if ($white != -1) { $image->transparent($white); } + } + return $image; +} + sub end_image { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result; my $name = $Apache::imageresponse::curname; if ($target eq 'web') { my $image = &Apache::lonxml::endredirection; - &Apache::lonxml::debug("out is $image"); + &Apache::lonxml::debug("original image is $image"); + my $id=$Apache::inputtags::response['-1']; + my $temp=1; + my $x=$ENV{"form.HWVAL_$id:$temp.x"}; + my $y=$ENV{"form.HWVAL_$id:$temp.y"}; + if (defined ($x) && defined ($y)) { + &Apache::lonxml::debug("x and y defined as $x,$y"); + my $currentImage = &get_image('/home/httpd/html'.$image,1); + if (! defined($currentImage)) { + &Apache::lonnet::logthis('Unable to create image object for '.$image); + return ''; + } + my $red; + if (!($red = $currentImage->colorResolve(255,0,0))) { + $red = $currentImage->colorClosestHWB(255,0,0); + } + my $length = 6; + $currentImage->line($x-$length,$y-$length,$x+$length,$y+$length,$red); + $currentImage->line($x-$length,$y+$length,$x+$length,$y-$length,$red); + + my ($nameWOext) = ($image =~ /^.*\/(.*)\..*$/); + &Apache::lonxml::debug("graph name $nameWOext"); + my $webImageName = "/prtspool/$ENV{'user.name'}_$ENV{'user.domain'}_". + $nameWOext.'.png'; #needs to be more random or specific + my $newImageName = '/home/httpd'.$webImageName; + + my $imgfh = Apache::File->new('>'.$newImageName); + print $imgfh $currentImage->png; + $image = $webImageName; + } + &Apache::lonxml::debug("out image is $image"); if ( $Apache::imageresponse::conceptgroup && !&Apache::response::showallfoils()) { $Apache::response::conceptgroup{"$name.image"} = $image;