version 1.32, 2003/07/31 20:38:12
|
version 1.33, 2003/08/01 14:22:07
|
Line 25
|
Line 25
|
# |
# |
# http://www.lon-capa.org/ |
# http://www.lon-capa.org/ |
# |
# |
|
# July,August 2003 H. K. Ng |
|
# |
#FIXME LATER assumes multiple possible submissions but only one is possible |
#FIXME LATER assumes multiple possible submissions but only one is possible |
#currently |
#currently |
|
|
package Apache::imageresponse; |
package Apache::imageresponse; |
use strict; |
use strict; |
use Image::Magick; |
use Image::Magick; |
|
use GD; |
|
|
BEGIN { |
BEGIN { |
&Apache::lonxml::register('Apache::imageresponse',('imageresponse')); |
&Apache::lonxml::register('Apache::imageresponse',('imageresponse')); |
Line 312 sub start_image {
|
Line 314 sub start_image {
|
return $result; |
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 { |
sub end_image { |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; |
my $result; |
my $result; |
Line 325 sub end_image {
|
Line 348 sub end_image {
|
my $y=$ENV{"form.HWVAL_$id:$temp.y"}; |
my $y=$ENV{"form.HWVAL_$id:$temp.y"}; |
if (defined ($x) && defined ($y)) { |
if (defined ($x) && defined ($y)) { |
&Apache::lonxml::debug("x and y defined as $x,$y"); |
&Apache::lonxml::debug("x and y defined as $x,$y"); |
my $magickImage = Image::Magick->new; |
my $currentImage = &get_image('/home/httpd/html'.$image,1); |
my $currentImage = $magickImage->Read('/home/httpd/html'.$image); |
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; |
my $length = 6; |
$currentImage = $magickImage->Draw(primitive=>'line', |
$currentImage->line($x-$length,$y-$length,$x+$length,$y+$length,$red); |
stroke=>'red', |
$currentImage->line($x-$length,$y+$length,$x+$length,$y-$length,$red); |
points=>($x-$length).','.($y-$length).' '. |
|
($x+$length).','.($y+$length)); |
my ($nameWOext) = ($image =~ /^.*\/(.*)\..*$/); |
$currentImage = $magickImage->Draw(primitive=>'line', |
&Apache::lonxml::debug("graph name $nameWOext"); |
stroke=>'red', |
my $webImageName = "/prtspool/$ENV{'user.name'}_$ENV{'user.domain'}_". |
points=>($x-$length).','.($y+$length).' '. |
$nameWOext.'.png'; #needs to be more random or specific |
($x+$length).','.($y-$length)); |
|
binmode STDOUT; |
|
my ($graphExt) = ($image =~ /.*\.(.*)$/); |
|
&Apache::lonxml::debug("graph mime type $graphExt"); |
|
my $webImageName = "/prtspool/$ENV{'user.name'}_$ENV{'user.domain'}_".(time).'.'.$graphExt; #needs to be more random |
|
my $newImageName = '/home/httpd'.$webImageName; |
my $newImageName = '/home/httpd'.$webImageName; |
|
|
$currentImage = $magickImage->Write($graphExt.':'.$newImageName); |
my $imgfh = Apache::File->new('>'.$newImageName); |
undef $magickImage; |
print $imgfh $currentImage->png; |
$image = $webImageName; |
$image = $webImageName; |
} |
} |
&Apache::lonxml::debug("out image is $image"); |
&Apache::lonxml::debug("out image is $image"); |