Return to randomlylabel.pm CVS log

Up to [LON-CAPA] / loncom / homework

- polygons set the request width now
- imagechoice stores its data where it won't be thrown away before we are ready
- imageresponse tries to cleanup after itself
- lonnet::hreflocation() understands what to do with /home references
- relative image URLs work now

    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.14 2004/01/12 19:53:54 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: 
   40: sub get_image {
   41:     my ($imgsrc,$set_trans)=@_;
   42:     my $image;
   43:     if ($imgsrc !~ /\.(png|jpg|jpeg)$/i) {
   44: 	my $conv_image = Image::Magick->new;
   45: 	my $current_figure = $conv_image->Read('filename'=>$imgsrc);
   46: 	$conv_image->Set('magick'=>'png');
   47: 	my @blobs=$conv_image->ImageToBlob();
   48: 	undef $conv_image;
   49: 	$image = GD::Image->new($blobs[0]);
   50:     } else {
   51: 	GD::Image->trueColor(1);
   52: 	$image = GD::Image->new($imgsrc);
   53:     }
   54:     if ($set_trans && defined($image)) {
   55: 	my $white=$image->colorExact(255,255,255);
   56: 	if ($white != -1) { $image->transparent($white); }
   57:     }
   58:     return $image;
   59: }
   60: 
   61: sub handler {
   62:     my $r = shift;
   63:     $r->content_type('image/png');
   64:     my (undef,$id) = split(/=/,$ENV{'QUERY_STRING'});
   65:     my $image=&get_image(&Apache::lonnet::unescape($ENV{"cgi.$id.BGIMG"}),0);
   66:     if (! defined($image)) {
   67:         &Apache::lonnet::logthis('Unable to create image object for -'.$id.'-'.
   68: 				 $ENV{"cgi.$id.BGIMG"});
   69:         return OK;
   70:     }
   71:     #binmode(STDOUT);
   72:     my $black;
   73:     if (!($black=$image->colorResolve(0,0,0))) {
   74: 	$black = $image->colorClosestHWB(0,0,0);
   75:     }
   76:     for(my $i=0;$i<$ENV{"cgi.$id.ICOUNT"};$i++) {
   77: 	my $subimage=&get_image(&Apache::lonnet::unescape($ENV{"cgi.$id.IMG$i"}),1);
   78: 	if (!defined($subimage)) {
   79:             &Apache::lonnet::logthis('Unable to create image object for '.
   80:                                  $ENV{"cgi.$id.BGIMG"});
   81:             next;
   82:         }
   83: 	$image->copy($subimage,$ENV{"cgi.$id.IX$i"},$ENV{"cgi.$id.IY$i"},
   84: 		     0,0,$subimage->getBounds());
   85:     }
   86:     my $height=GD::Font->Giant->height;
   87:     for(my $i=0;$i<$ENV{"cgi.$id.COUNT"};$i++) {
   88: 	$image->string(GD::gdGiantFont,$ENV{"cgi.$id.X$i"},
   89: 		       $ENV{"cgi.$id.Y$i"}-$height,
   90: 		       &Apache::lonnet::unescape($ENV{"cgi.$id.LB$i"}),$black);
   91:     }
   92:     for(my $i=0;$i<$ENV{"cgi.$id.LINECOUNT"};$i++) {
   93: 	my ($x1,$y1,$x2,$y2,$color,$width)=split(':',$ENV{"cgi.$id.LINE$i"});
   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: 	$image->setThickness($width);
  101:        	$image->line($x1,$y1,$x2,$y2,$imcolor);
  102:     }
  103:     for(my $i=0;$i<$ENV{"cgi.$id.BOXCOUNT"};$i++) {
  104: 	my ($x1,$y1,$x2,$y2,$color,$width)=split(':',$ENV{"cgi.$id.BOX$i"});
  105: 	if ($x1 > $x2) { my $temp=$x1;$x1=$x2;$x2=$temp; }
  106: 	if ($y1 > $y2) { my $temp=$y1;$y1=$y2;$y2=$temp; }
  107: 	my (undef,$red,undef,$green,undef,$blue)=split(/(..)/,$color);
  108: 	$red=hex($red);$green=hex($green);$blue=hex($blue);
  109: 	my $imcolor;
  110: 	if (!($imcolor = $image->colorResolve($red,$green,$blue))) {
  111: 	    $imcolor = $image->colorClosestHWB($red,$green,$blue);
  112: 	}
  113: 	$image->setThickness($width);
  114:        	$image->rectangle($x1,$y1,$x2,$y2,$imcolor);
  115:     }
  116:     for(my $i=0;$i<$ENV{"cgi.$id.POLYCOUNT"};$i++) {
  117: 	my ($color,$width,$open)=split(':',$ENV{"cgi.$id.POLYOPT$i"});
  118: 	my (undef,$red,undef,$green,undef,$blue)=split(/(..)/,$color);
  119: 	$red=hex($red);$green=hex($green);$blue=hex($blue);
  120: 	my $imcolor;
  121: 	if (!($imcolor = $image->colorResolve($red,$green,$blue))) {
  122: 	    $imcolor = $image->colorClosestHWB($red,$green,$blue);
  123: 	}
  124: 	my $polygon;
  125: 	if ($open) {
  126: 	    $polygon = new GD::Polyline;
  127: 	} else {
  128: 	    $polygon = new GD::Polygon;
  129: 	}
  130: 	foreach my $coord (split('-',$ENV{"cgi.$id.POLY$i"})) {
  131: 	    my ($x,$y)=($coord=~m/\(([0-9]+),([0-9]+)\)/);
  132: 	    $polygon->addPt($x,$y);
  133: 	}
  134: 	$image->setThickness($width);
  135: 	if ($open) {
  136: 	    $image->polydraw($polygon,$imcolor);
  137: 	} else {
  138: 	    $image->polygon($polygon,$imcolor);
  139: 	}
  140:     }
  141:     $image->setThickness(1);
  142:     $r->print($image->png);
  143:     return OK;
  144: }
  145: 
  146: 1;