[LON-CAPA-cvs] cvs: modules /albertel randomlylabel.pm
albertel
lon-capa-cvs@mail.lon-capa.org
Sat, 15 Nov 2003 06:35:15 -0000
albertel Sat Nov 15 01:35:15 2003 EDT
Added files:
/modules/albertel randomlylabel.pm
Log:
- new version of randomlylabel.pm (destined for 1.2) need to modify imageresponse.pm and randomlable.pm to make use of the facilities it provides
Index: modules/albertel/randomlylabel.pm
+++ modules/albertel/randomlylabel.pm
#!/usr/bin/perl
# The LearningOnline Network with CAPA
# randomlabel.png: composite together text and images into 1 image
#
# $Id: randomlylabel.pm,v 1.1 2003/11/15 06:35:15 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
###
package Apache::randomlylabel;
use strict;
use Image::Magick;
use Apache::Constants qw(:common);
use Apache::loncommon();
use GD;
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 get_color_from_hexstring {
my ($image,$color)=@_;
my (undef,$red,undef,$green,undef,$blue)=split(/(..)/,$color);
$red=hex($red);$green=hex($green);$blue=hex($blue);
my $imcolor;
if (!($imcolor = $image->colorResolve($red,$green,$blue))) {
$imcolor = $image->colorClosestHWB($red,$green,$blue);
}
return $imcolor;
}
sub handler {
my $r = shift;
$r->content_type('image/png');
my (undef,$id) = split(/=/,$ENV{'QUERY_STRING'});
my $image=&get_image(&Apache::lonnet::unescape($ENV{"cgi.$id.BGIMG"}),0);
if (!defined($image) && !defined($ENV{"cgi.$id.BGIMG"}) &&
!defined($ENV{"cgi.$id.SIZE"}) ) {
&Apache::lonnet::logthis('Unable to create image object for -'.$id.'-'.
$ENV{"cgi.$id.BGIMG"});
return OK;
} elsif (defined($ENV{"cgi.$id.SIZE"})) {
my ($width,$height)=split(':',$ENV{"cgi.$id.SIZE"});
$image = new GD::Image($width,$height,1);
my ($bgcolor)=split(':',$ENV{"cgi.$id.BGCOLOR"});
if ($bgcolor ne 'transparent') {
$bgcolor=&get_color_from_hexstring($image,$bgcolor);
# $image->rectangle(0,0,$width,$height,$bgcolor);
$image->fill(0,0,$bgcolor);
} else {
$bgcolor=&get_color_from_hexstring($image,'FFFFFF');
$image->fill(0,0,$bgcolor);
$image->transparent($bgcolor);
}
} else {
&Apache::lonnet::logthis('Unable to create image object, no info');
return OK;
}
#binmode(STDOUT);
my $black;
if (!($black=$image->colorResolve(0,0,0))) {
$black = $image->colorClosestHWB(0,0,0);
}
for(my $i=0;$i<$ENV{"cgi.$id.ICOUNT"};$i++) {
my $subimage=&get_image(&Apache::lonnet::unescape($ENV{"cgi.$id.IMG$i"}),1);
if (!defined($subimage)) {
&Apache::lonnet::logthis('Unable to create image object for '.
$ENV{"cgi.$id.BGIMG"});
next;
}
$image->copy($subimage,$ENV{"cgi.$id.IX$i"},$ENV{"cgi.$id.IY$i"},
0,0,$subimage->getBounds());
}
my $height=GD::Font->Giant->height;
for(my $i=0;$i<$ENV{"cgi.$id.COUNT"};$i++) {
$image->string(gdGiantFont,$ENV{"cgi.$id.X$i"},
$ENV{"cgi.$id.Y$i"}-$height,
&Apache::lonnet::unescape($ENV{"cgi.$id.LB$i"}),$black);
}
my @objtypes=split(':',$ENV{"cgi.$id.OBJTYPE"});
foreach(my $i=0;$i<$ENV{"cgi.$id.OBJCOUNT"};$i++) {
my $type=shift(@objtypes);
&Apache::lonnet::logthis("type is $type");
if ($type eq 'LINE') {
my ($x1,$y1,$x2,$y2,$color,$thickness)=
split(':',$ENV{"cgi.$id.OBJ$i"});
my (undef,$red,undef,$green,undef,$blue)=split(/(..)/,$color);
if (!$color) { $color='000000'; }
my $imcolor=&get_color_from_hexstring($image,$color);
if (!defined($thickness)) { $thickness=1; }
$image->setThickness($thickness);
$image->setAntiAliased($imcolor);
$image->line($x1,$y1,$x2,$y2,gdAntiAliased);
} elsif ($type eq 'RECTANGLE') {
my ($x1,$y1,$x2,$y2,$color,$thickness,$filled)=
split(':',$ENV{"cgi.$id.OBJ$i"});
if ($x1 > $x2) { my $temp=$x1;$x1=$x2;$x2=$temp; }
if ($y1 > $y2) { my $temp=$y1;$y1=$y2;$y2=$temp; }
if (!$color) { $color='000000'; }
my $imcolor=&get_color_from_hexstring($image,$color);
if (!defined($thickness)) { $thickness=1; }
$image->setThickness($thickness);
# $image->setAntiAliased($imcolor);
if ($filled) {
$image->filledRectangle($x1,$y1,$x2,$y2,$imcolor);
} else {
$image->rectangle($x1,$y1,$x2,$y2,$imcolor);
}
} elsif ($type eq 'ARC') {
my ($x,$y,$width,$height,$start,$end,$color,$thickness,$filled)=
split(':',$ENV{"cgi.$id.OBJ$i"});
if (!$color) { $color='000000'; }
my $imcolor=&get_color_from_hexstring($image,$color);
if (!defined($thickness)) { $thickness=1; }
$image->setThickness($thickness);
# $image->setAntiAliased($imcolor);
if ($filled) {
$image->filledArc($x,$y,$width,$height,$start,$end,
$imcolor);
} else {
$image->arc($x,$y,$width,$height,$start,$end,$imcolor);
}
} elsif ($type eq 'FILL') {
my ($x,$y,$color)=split(':',$ENV{"cgi.$id.OBJ$i"});
if (!$color) { $color='000000'; }
my $imcolor=&get_color_from_hexstring($image,$color);
$image->fill($x,$y,$imcolor);
}
}
$r->print($image->png);
return OK;
}
1;