--- loncom/homework/randomlylabel.pm 2005/02/23 15:51:48 1.23 +++ loncom/homework/randomlylabel.pm 2024/04/05 04:05:08 1.36 @@ -1,8 +1,7 @@ -#!/usr/bin/perl # The LearningOnline Network with CAPA # randomlabel.png: composite together text and images into 1 image # -# $Id: randomlylabel.pm,v 1.23 2005/02/23 15:51:48 albertel Exp $ +# $Id: randomlylabel.pm,v 1.36 2024/04/05 04:05:08 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -31,13 +30,30 @@ =head1 Syntax of randomlylabel commands +Required items are: (one of BGIMG or SIZE) and OBJCOUNT + =over 4 =item BGIMG -/home/... file or href (href must contain http://...) +/home/... file +/res/ ... URL +or href (href must contain http://...) Expected to be HTTP escaped +=item SIZE + +width:height + +Creates a blank canvas of size width,height. + +=item BGCOLOR + +either I or a color hexstring + +Sets the background color, if SIZE is used to create a new canvas, +I makes the background transparent. + =item OBJCOUNT a number @@ -113,7 +129,7 @@ the start and extant of the region in fi =item LABEL -x:y:text:font:color:direction +x:y:text:font:color:direction:rotation =over 4 @@ -130,6 +146,12 @@ installed TTF font and point size either B or B +=item rotation + +number of degrees to rotate the text, relative to the horizontal. +only used if font attribute is set to a freetype font (e.g., helvetica 12), +and in that case, if set to a valid value, overrides value set for direction. + =back =item POLYGON @@ -185,22 +207,36 @@ use strict; use Image::Magick; use Apache::Constants qw(:common); use Apache::loncommon(); +use Math::Trig(); use GD; use GD::Polyline(); -use LWP::UserAgent(); +use Apache::lonnet; +use lib '/home/httpd/lib/perl/'; +use LONCAPA; +use LONCAPA::LWPReq; + +# +# Note: Math::Trig is included in the standard perl package for many distros. +# +# For distros which use rpm the following command will show whether Trig.pm is +# included in the system perl: rpm -q --provides perl |grep Math::Trig +# +# For distros which use deb the following command will show whether Trig.pm is +# included in the system perl: dpkg -S perl |grep Math\/Trig\.pm +# sub get_image { my ($imgsrc,$set_trans)=@_; my $image; if ($imgsrc !~ m|^(/home/)|) { - if ($imgsrc !~ /^http:/) { - $imgsrc="http://".$ENV{'HTTP_HOST'}.$imgsrc; + if ($imgsrc !~ /^https?\:/) { + $imgsrc=&Apache::lonnet::absolute_url($ENV{'HTTP_HOST'}).$imgsrc; } - my $ua=new LWP::UserAgent; my $request=new HTTP::Request('GET',"$imgsrc"); $request->header(Cookie => $ENV{'HTTP_COOKIE'}); my $file="/tmp/imagetmp".$$; - my $response=$ua->request($request,$file); + my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; + my $response=&LONCAPA::LWPReq::makerequest($lonhost,$request,$file,'','','',1); if ($response->is_success) { if ($response->content_type !~ m-/(png|jpg|jpeg)$-i) { my $conv_image = Image::Magick->new; @@ -247,25 +283,65 @@ sub get_color_from_hexstring { return $imcolor; } +sub add_click { + my ($image) = @_; + + my $length=6; + my $bgcolor=&get_color_from_hexstring($image,'FFFFFF'); + my $fgcolor=&get_color_from_hexstring($image,'009999'); + + my ($x,$y) = split(':',$env{'form.clickdata'}); + + $image->setThickness(3); + $image->line($x-$length,$y, $x+$length,$y, $bgcolor); + $image->line($x, $y-$length,$x, $y+$length,$bgcolor); + $image->setThickness(1); + $image->line($x-$length,$y, $x+$length,$y, $fgcolor); + $image->line($x, $y-$length,$x, $y+$length,$fgcolor); +} + sub handler { my $r = shift; - $r->content_type('image/png'); - $r->send_http_header; - my (undef,$id) = split(/=/,$ENV{'QUERY_STRING'}); + + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}); + + my $prefix; + if ($ENV{'QUERY_STRING'}=~/OBJCOUNT\=/) { + $prefix='form.'; + } else { + $prefix="cgi.$env{'form.token'}."; + } + my $epsfile; + if (defined($env{$prefix."EPSFILE"})) { + my $user = $env{'user.name'}.'_'.$env{'user.domain'}; + if ($env{$prefix."EPSFILE"} =~ /^\Q$user\E_\d+_\d+_\d+_drawimage\.eps$/) { + $epsfile = $Apache::lonnet::perlvar{'lonPrtDir'}.'/'.$env{$prefix."EPSFILE"}; + } else { + &Apache::lonnet::logthis('Unable to create eps file for image object for -'. + $env{'form.token'}.'- for '.$user.' as EPSFILE has '. + 'unexpected value'); + return OK; + } + } + unless ($epsfile) { + $r->content_type('image/png'); + $r->send_http_header; + } + my $image; - if (defined($ENV{"cgi.$id.BGIMG"})) { - my $bgimg=&Apache::lonnet::unescape($ENV{"cgi.$id.BGIMG"}); + if (defined($env{$prefix."BGIMG"})) { + my $bgimg=&unescape($env{$prefix."BGIMG"}); #&Apache::lonnet::logthis("BGIMG is ".$bgimg); $image=&get_image($bgimg,0); if (! defined($image)) { &Apache::lonnet::logthis('Unable to create image object for -'. - $id.'-'.$bgimg); + $env{'form.token'}.'-'.$bgimg); return OK; } - } elsif (defined($ENV{"cgi.$id.SIZE"})) { - my ($width,$height)=split(':',$ENV{"cgi.$id.SIZE"}); + } elsif (defined($env{$prefix."SIZE"})) { + my ($width,$height)=split(':',$env{$prefix."SIZE"}); $image = new GD::Image($width,$height,1); - my ($bgcolor)=split(':',$ENV{"cgi.$id.BGCOLOR"}); + my ($bgcolor)=split(':',$env{$prefix."BGCOLOR"}); if ($bgcolor ne 'transparent') { $bgcolor=&get_color_from_hexstring($image,$bgcolor); # $image->rectangle(0,0,$width,$height,$bgcolor); @@ -276,16 +352,16 @@ sub handler { $image->transparent($bgcolor); } } else { - &Apache::lonnet::logthis('Unable to create image object, no info'); + &Apache::lonnet::logthis('Unable to create image object, no info '.$prefix); return OK; } #binmode(STDOUT); - my @objtypes=split(':',$ENV{"cgi.$id.OBJTYPE"}); - foreach(my $i=0;$i<$ENV{"cgi.$id.OBJCOUNT"};$i++) { + my @objtypes=split(':',$env{$prefix."OBJTYPE"}); + foreach(my $i=0;$i<$env{$prefix."OBJCOUNT"};$i++) { my $type=shift(@objtypes); if ($type eq 'LINE') { my ($x1,$y1,$x2,$y2,$color,$thickness)= - split(':',$ENV{"cgi.$id.OBJ$i"}); + split(':',$env{$prefix."OBJ$i"}); my $imcolor=&get_color_from_hexstring($image,$color); if (!defined($thickness)) { $thickness=1; } $image->setThickness($thickness); @@ -293,7 +369,7 @@ sub handler { $image->line($x1,$y1,$x2,$y2,$imcolor); } elsif ($type eq 'RECTANGLE') { my ($x1,$y1,$x2,$y2,$color,$thickness,$filled)= - split(':',$ENV{"cgi.$id.OBJ$i"}); + split(':',$env{$prefix."OBJ$i"}); if ($x1 > $x2) { my $temp=$x1;$x1=$x2;$x2=$temp; } if ($y1 > $y2) { my $temp=$y1;$y1=$y2;$y2=$temp; } my $imcolor=&get_color_from_hexstring($image,$color); @@ -306,12 +382,12 @@ sub handler { $image->rectangle($x1,$y1,$x2,$y2,$imcolor); } } elsif ($type eq 'POLYGON') { - my ($color,$width,$open,$filled)=split(':',$ENV{"cgi.$id.OBJ$i"}); + my ($color,$width,$open,$filled)=split(':',$env{$prefix."OBJ$i"}); my $imcolor=&get_color_from_hexstring($image,$color); my $polygon = (($open && lc ($open ne 'no')) ? (new GD::Polyline) : (new GD::Polygon)); my $added=0; - foreach my $coord (split('-',$ENV{"cgi.$id.OBJEXTRA$i"})) { + foreach my $coord (split('-',$env{$prefix."OBJEXTRA$i"})) { my ($x,$y)=($coord=~m/\(([0-9]+),([0-9]+)\)/); $polygon->addPt($x,$y); $added++; @@ -329,7 +405,7 @@ sub handler { } } elsif ($type eq 'ARC') { my ($x,$y,$width,$height,$start,$end,$color,$thickness,$filled)= - split(':',$ENV{"cgi.$id.OBJ$i"}); + split(':',$env{$prefix."OBJ$i"}); if (!$color) { $color='000000'; } my $imcolor=&get_color_from_hexstring($image,$color); if (!defined($thickness)) { $thickness=1; } @@ -342,14 +418,14 @@ sub handler { $image->arc($x,$y,$width,$height,$start,$end,$imcolor); } } elsif ($type eq 'FILL') { - my ($x,$y,$color)=split(':',$ENV{"cgi.$id.OBJ$i"}); + my ($x,$y,$color)=split(':',$env{$prefix."OBJ$i"}); if (!$color) { $color='000000'; } my $imcolor=&get_color_from_hexstring($image,$color); $image->fill($x,$y,$imcolor); } elsif ($type eq 'IMAGE') { my ($x,$y,$file,$transparent,$srcX,$srcY,$destW,$destH,$srcW, - $srcH)=split(':',$ENV{"cgi.$id.OBJ$i"}); - $file=&Apache::lonnet::unescape($file); + $srcH)=split(':',$env{$prefix."OBJ$i"}); + $file=&unescape($file); if (!defined($transparent)) { $transparent=1; } my $subimage=&get_image($file,$transparent); if (!defined($subimage)) { @@ -364,9 +440,9 @@ sub handler { $image->copyResized($subimage,$x,$y,$srcX,$srcY,$destW,$destH, $srcW,$srcH); } elsif ($type eq 'LABEL') { - my ($x,$y,$text,$font,$color,$direction)= - split(':',$ENV{"cgi.$id.OBJ$i"}); - $text=&Apache::lonnet::unescape($text); + my ($x,$y,$text,$font,$color,$direction,$rotation)= + split(':',$env{$prefix."OBJ$i"}); + $text=&unescape($text); my $imcolor=&get_color_from_hexstring($image,$color); my $type='normal'; my ($height,$fontref); @@ -385,7 +461,7 @@ sub handler { } elsif ($font eq 'giant' || !$font) { $height=GD::Font->Giant->height; $fontref=GD::gdGiantFont; - } else { + } elsif ($image->useFontConfig(1)) { $type='ttf'; } if ($type eq 'normal' && $direction eq 'vertical') { @@ -394,14 +470,32 @@ sub handler { $image->string($fontref,$x,$y-$height,$text,$imcolor); } elsif ($type eq 'ttf') { my ($fontname,$ptsize)=split(/\s+/,$font); - $image->stringFT($imcolor,$fontname,$ptsize,90,$x,$y,$text); + my $angle = 0; + if ($rotation =~ /^(\-|\+|)\d+(|\.\d*)$/) { + $angle = Math::Trig::deg2rad($rotation); + } elsif ($direction eq 'vertical') { + $angle = Math::Trig::deg2rad(90); + } elsif ($direction eq 'horizontal') { + $angle = 0; + } + $image->stringFT($imcolor,$fontname,$ptsize,$angle,$x,$y,$text); } } else { &Apache::lonnet::logthis("randomlylabel unable to handle object of type $type"); } } + if (exists($env{'form.clickdata'})) { &add_click($image); } $image->setThickness(1); - $r->print($image->png); + if ($epsfile) { + if (open(my $pipe, "| convert png:- $epsfile")) { + print $pipe $image->png; + close($pipe); + } else { + &Apache::lonnet::logthis("randomlylabel unable to open pipe to convert png to eps"); + } + } else { + $r->print($image->png); + } return OK; }