![]() ![]() | ![]() |
- breaking all image modifications routines
1: #!/usr/bin/perl 2: # The LearningOnline Network with CAPA 3: # randomlabel.png: composite together text and images into 1 image 4: # 5: # $Id: randomlylabel.pm,v 1.16 2004/02/23 22:52:30 albertel Exp $ 6: # 7: # Copyright Michigan State University Board of Trustees 8: # 9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 10: # 11: # LON-CAPA is free software; you can redistribute it and/or modify 12: # it under the terms of the GNU General Public License as published by 13: # the Free Software Foundation; either version 2 of the License, or 14: # (at your option) any later version. 15: # 16: # LON-CAPA is distributed in the hope that it will be useful, 17: # but WITHOUT ANY WARRANTY; without even the implied warranty of 18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19: # GNU General Public License for more details. 20: # 21: # You should have received a copy of the GNU General Public License 22: # along with LON-CAPA; if not, write to the Free Software 23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 24: # 25: # /home/httpd/html/adm/gpl.txt 26: # 27: # http://www.lon-capa.org/ 28: # 29: ### 30: 31: package Apache::randomlylabel; 32: 33: use strict; 34: use Image::Magick; 35: use Apache::Constants qw(:common); 36: use Apache::loncommon(); 37: use GD(); 38: use GD::Polyline(); 39: use LWP::UserAgent(); 40: 41: sub get_image { 42: my ($imgsrc,$set_trans)=@_; 43: my $image; 44: &Apache::lonnet::logthis("imagesrc1 is $imgsrc"); 45: if ($imgsrc !~ m|^(/home/)|) { 46: &Apache::lonnet::logthis("imagesrc2 is $imgsrc"); 47: if ($imgsrc !~ /^http:/) { 48: $imgsrc="http://".$ENV{'HTTP_HOST'}.$imgsrc; 49: } 50: &Apache::lonnet::logthis("imagesrc3 is $imgsrc"); 51: &Apache::lonnet::logthis("LWP fetching image $imgsrc"); 52: my $ua=new LWP::UserAgent; 53: my $request=new HTTP::Request('GET',"$imgsrc"); 54: $request->header(Cookie => $ENV{'HTTP_COOKIE'}); 55: my $file="/tmp/imagetmp".$$; 56: my $response=$ua->request($request,$file); 57: &Apache::lonnet::logthis("contetn is ".$response->content_type); 58: &Apache::lonnet::logthis($response->is_success); 59: &Apache::lonnet::logthis($response->status_line); 60: if ($response->is_success) { 61: if ($response->content_type !~ m-/(png|jpg|jpeg)$-i) { 62: my $conv_image = Image::Magick->new; 63: my $current_figure = $conv_image->Read('filename'=>$file); 64: $conv_image->Set('magick'=>'png'); 65: my @blobs=$conv_image->ImageToBlob(); 66: undef $conv_image; 67: $image = GD::Image->new($blobs[0]); 68: } else { 69: GD::Image->trueColor(1); 70: $image = GD::Image->new($file); 71: } 72: } 73: } elsif ($imgsrc !~ /\.(png|jpg|jpeg)$/i) { 74: my $conv_image = Image::Magick->new; 75: my $current_figure = $conv_image->Read('filename'=>$imgsrc); 76: $conv_image->Set('magick'=>'png'); 77: my @blobs=$conv_image->ImageToBlob(); 78: undef $conv_image; 79: $image = GD::Image->new($blobs[0]); 80: } else { 81: GD::Image->trueColor(1); 82: $image = GD::Image->new($imgsrc); 83: } 84: if ($set_trans && defined($image)) { 85: my $white=$image->colorExact(255,255,255); 86: if ($white != -1) { $image->transparent($white); } 87: } 88: return $image; 89: } 90: 91: sub get_color_from_hexstring { 92: my ($image,$color)=@_; 93: if (!$color) { $color='000000'; } 94: my (undef,$red,undef,$green,undef,$blue)=split(/(..)/,$color); 95: $red=hex($red);$green=hex($green);$blue=hex($blue); 96: my $imcolor; 97: if (!($imcolor = $image->colorResolve($red,$green,$blue))) { 98: $imcolor = $image->colorClosestHWB($red,$green,$blue); 99: } 100: return $imcolor; 101: } 102: 103: sub handler { 104: my $r = shift; 105: $r->content_type('image/png'); 106: $r->send_http_header; 107: my (undef,$id) = split(/=/,$ENV{'QUERY_STRING'}); 108: &Apache::lonnet::logthis("BGIMG is ".$ENV{"cgi.$id.BGIMG"}); 109: my $image=&get_image(&Apache::lonnet::unescape($ENV{"cgi.$id.BGIMG"}),0); 110: if (! defined($image)) { 111: &Apache::lonnet::logthis('Unable to create image object for -'.$id.'-'. 112: $ENV{"cgi.$id.BGIMG"}); 113: return OK; 114: } elsif (defined($ENV{"cgi.$id.SIZE"})) { 115: my ($width,$height)=split(':',$ENV{"cgi.$id.SIZE"}); 116: $image = new GD::Image($width,$height,1); 117: my ($bgcolor)=split(':',$ENV{"cgi.$id.BGCOLOR"}); 118: if ($bgcolor ne 'transparent') { 119: $bgcolor=&get_color_from_hexstring($image,$bgcolor); 120: # $image->rectangle(0,0,$width,$height,$bgcolor); 121: $image->fill(0,0,$bgcolor); 122: } else { 123: $bgcolor=&get_color_from_hexstring($image,'FFFFFF'); 124: $image->fill(0,0,$bgcolor); 125: $image->transparent($bgcolor); 126: } 127: } else { 128: &Apache::lonnet::logthis('Unable to create image object, no info'); 129: return OK; 130: } 131: #binmode(STDOUT); 132: my @objtypes=split(':',$ENV{"cgi.$id.OBJTYPE"}); 133: foreach(my $i=0;$i<$ENV{"cgi.$id.OBJCOUNT"};$i++) { 134: my $type=shift(@objtypes); 135: &Apache::lonnet::logthis("type is $type"); 136: if ($type eq 'LINE') { 137: my ($x1,$y1,$x2,$y2,$color,$thickness)= 138: split(':',$ENV{"cgi.$id.OBJ$i"}); 139: my $imcolor=&get_color_from_hexstring($image,$color); 140: if (!defined($thickness)) { $thickness=1; } 141: $image->setThickness($thickness); 142: $image->setAntiAliased($imcolor); 143: $image->line($x1,$y1,$x2,$y2,gdAntiAliased); 144: } elsif ($type eq 'RECTANGLE') { 145: my ($x1,$y1,$x2,$y2,$color,$thickness,$filled)= 146: split(':',$ENV{"cgi.$id.OBJ$i"}); 147: if ($x1 > $x2) { my $temp=$x1;$x1=$x2;$x2=$temp; } 148: if ($y1 > $y2) { my $temp=$y1;$y1=$y2;$y2=$temp; } 149: my $imcolor=&get_color_from_hexstring($image,$color); 150: if (!defined($thickness)) { $thickness=1; } 151: $image->setThickness($thickness); 152: # $image->setAntiAliased($imcolor); 153: if ($filled) { 154: $image->filledRectangle($x1,$y1,$x2,$y2,$imcolor); 155: } else { 156: $image->rectangle($x1,$y1,$x2,$y2,$imcolor); 157: } 158: } elsif ($type eq 'POLYGON') { 159: my ($color,$width,$open)=split(':',$ENV{"cgi.$id.OBJ$i"}); 160: my $imcolor=&get_color_from_hexstring($image,$color); 161: my $polygon = (($open) ? (new GD::Polyline) : (new GD::Polygon)); 162: foreach my $coord (split('-',$ENV{"cgi.$id.OBJEXTRA$i"})) { 163: my ($x,$y)=($coord=~m/\(([0-9]+),([0-9]+)\)/); 164: $polygon->addPt($x,$y); 165: } 166: $image->setThickness($width); 167: if ($open) { 168: $image->polydraw($polygon,$imcolor); 169: } else { 170: $image->polygon($polygon,$imcolor); 171: } 172: } elsif ($type eq 'ARC') { 173: my ($x,$y,$width,$height,$start,$end,$color,$thickness,$filled)= 174: split(':',$ENV{"cgi.$id.OBJ$i"}); 175: if (!$color) { $color='000000'; } 176: my $imcolor=&get_color_from_hexstring($image,$color); 177: if (!defined($thickness)) { $thickness=1; } 178: $image->setThickness($thickness); 179: # $image->setAntiAliased($imcolor); 180: if ($filled) { 181: $image->filledArc($x,$y,$width,$height,$start,$end, 182: $imcolor); 183: } else { 184: $image->arc($x,$y,$width,$height,$start,$end,$imcolor); 185: } 186: } elsif ($type eq 'FILL') { 187: my ($x,$y,$color)=split(':',$ENV{"cgi.$id.OBJ$i"}); 188: if (!$color) { $color='000000'; } 189: my $imcolor=&get_color_from_hexstring($image,$color); 190: $image->fill($x,$y,$imcolor); 191: } elsif ($type eq 'IMAGE') { 192: my ($x,$y,$file,$transparent)=split(':',$ENV{"cgi.$id.OBJ$i"}); 193: $file=&Apache::lonnet::unescape($file); 194: if (!defined($transparent)) { $transparent=1; } 195: my $subimage=&get_image($file,$transparent); 196: if (!defined($subimage)) { 197: &Apache::lonnet::logthis('Unable to create image object for '. 198: $file); 199: next; 200: } 201: $image->copy($subimage,$x,$y,0,0,$subimage->getBounds()); 202: } elsif ($type eq 'LABEL') { 203: my ($x,$y,$text,$font,$color)=split(':',$ENV{"cgi.$id.OBJ$i"}); 204: $text=&Apache::lonnet::unescape($text); 205: my $imcolor=&get_color_from_hexstring($image,$color); 206: my $height=GD::Font->Giant->height; 207: for(my $i=0;$i<$ENV{"cgi.$id.COUNT"};$i++) { 208: $image->string(GD::gdGiantFont,$x,$y-$height,$text,$black); 209: } 210: } 211: } 212: $image->setThickness(1); 213: $r->print($image->png); 214: return OK; 215: } 216: 217: 1;