[BACK]Return to randomlylabel.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / homework

Diff for /loncom/homework/randomlylabel.pm between versions 1.15 and 1.29

version 1.15, 2004/02/11 21:51:15 version 1.29, 2007/09/25 22:56:48
Line 1 Line 1
 #!/usr/bin/perl  
 # The LearningOnline Network with CAPA  # The LearningOnline Network with CAPA
 # randomlabel.png: composite together text and images into 1 image  # randomlabel.png: composite together text and images into 1 image
 #  #
Line 26 Line 25
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 ###  
   =pod
   
   =head1 Syntax of randomlylabel commands
   
   Required items are: (one of BGIMG or SIZE) and OBJCOUNT
   
   =over 4
   
   =item BGIMG
   
   /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<transparent> or a color hexstring
   
   Sets the background color, if SIZE is used to create a new canvas,
   I<trasparent> makes the background transparent.
   
   =item OBJCOUNT
   
   a number
   
   =item OBJTYPE
   
   a colon seperated list of types, supported types are
   
            B<LINE> B<RECTANGLE> B<POLYGON> B<ARC> B<FILL> B<IMAGE> B<LABEL>
   
   =item OBJI<num>
   
   arguments for this OBJ
   
   some common arguments are
   
   =over 4
   
   =item x y thickness
   
   are pixel values
   
   =item color
   
   a hexstring, without with out a leading # or x)
   
   =item filled
   
   boolean, (1 or 0)
   
   =back
   
   The argumants for the possible object types are
   
   =over 4
   
   =item LINE
   
   x1:y1:x2:y2:color:thickness
   
   =item RECTANGLE 
   
   x1:y1:x2:y2:color:thickness:filled
   
   =item ARC
   
   x:y:width:height:start:end:color:thickness:filled
   
   =over 4
   
   =item start, end
   
   start and ends of the arc (in degrees)
   
   =back
   
   =item FILL
   
   x:y:color
   
   =item IMAGE
   
   x:y:file:transparent:srcX:srcY:destW:destH:srcW:srcH
   
   =over 4
   
   =item srcX,srcY,srcW,srcH 
   
   the start and extant of the region in file to copy to x,y with width/height
              destW destH
   
   =back
   
   =item LABEL
   
   x:y:text:font:color:direction
   
   =over 4
   
   =item text
   
   HTTP escaped string of the text to place on the image
   
   =item font
   
   one of B<tiny>, B<small>, B<medium>, B<large>, B<giant>, or an
   installed TTF font and point size
   
   =item direction
   
   either B<horizontal> or B<vertical>
   
   =back
   
   =item  POLYGON
   
   color:width:open:filled
   
   =over 4 
   
   =item open
   
   boolean, (1 or 0)
   
   =back
   
   =back
   
   
   =item OBJEXTRAI<num>
   
   extra arguments for object I<num>
   
   The possible values for this for the different object types are
   
   =over 4
   
   =item POLYGON 
   
   a list of coords in the form
   
        (x,y)-(x,y)-(x,y)
   
   (there can be arbitrarily many of these)
   
   =back
   
   =back
   
   =head1 Example
   
    BGIMG=file
    OBJTYPE=LINE:LINE:LINE:LINE
    OBJCOUNT=4
    OBJ0=xmin:ymin:xmax:ymax:FFFFFF:3
    OBJ1=xmin:ymax:xmax:ymin:FFFFFF:3
    OBJ2=xmin:ymin:xmax:ymax:FF0000:1
    OBJ3=xmin:ymax:xmax:ymin:FF0000:1
   
   =cut
   
 package Apache::randomlylabel;  package Apache::randomlylabel;
   
Line 34  use strict; Line 201  use strict;
 use Image::Magick;  use Image::Magick;
 use Apache::Constants qw(:common);  use Apache::Constants qw(:common);
 use Apache::loncommon();  use Apache::loncommon();
 use GD();  use GD;
 use GD::Polyline();  use GD::Polyline();
 use LWP::UserAgent();  use LWP::UserAgent();
   use Apache::lonnet;
   use lib '/home/httpd/lib/perl/';
   use LONCAPA;
    
   
 sub get_image {  sub get_image {
     my ($imgsrc,$set_trans)=@_;      my ($imgsrc,$set_trans)=@_;
     my $image;      my $image;
     &Apache::lonnet::logthis("imagesrc1 is $imgsrc");  
     if ($imgsrc !~ m|^(/home/)|) {      if ($imgsrc !~ m|^(/home/)|) {
  &Apache::lonnet::logthis("imagesrc2 is $imgsrc");  
  if ($imgsrc !~ /^http:/) {   if ($imgsrc !~ /^http:/) {
     $imgsrc="http://".$ENV{'HTTP_HOST'}.$imgsrc;      $imgsrc="http://".$ENV{'HTTP_HOST'}.$imgsrc;
  }   }
  &Apache::lonnet::logthis("imagesrc3 is $imgsrc");  
  &Apache::lonnet::logthis("LWP fetching image $imgsrc");  
  my $ua=new LWP::UserAgent;   my $ua=new LWP::UserAgent;
  my $request=new HTTP::Request('GET',"$imgsrc");   my $request=new HTTP::Request('GET',"$imgsrc");
  $request->header(Cookie => $ENV{'HTTP_COOKIE'});   $request->header(Cookie => $ENV{'HTTP_COOKIE'});
  my $file="/tmp/imagetmp".$$;   my $file="/tmp/imagetmp".$$;
  my $response=$ua->request($request,$file);   my $response=$ua->request($request,$file);
  &Apache::lonnet::logthis("contetn is ".$response->content_type);  
  &Apache::lonnet::logthis($response->is_success);  
  &Apache::lonnet::logthis($response->status_line);  
  if ($response->is_success) {   if ($response->is_success) {
     if ($response->content_type !~ m-/(png|jpg|jpeg)$-i) {      if ($response->content_type !~ m-/(png|jpg|jpeg)$-i) {
  my $conv_image = Image::Magick->new;   my $conv_image = Image::Magick->new;
  my $current_figure = $conv_image->Read('filename'=>$file);   my $current_figure = $conv_image->Read('filename'=>$file);
    $conv_image->Set('type'=>'TrueColor');
  $conv_image->Set('magick'=>'png');   $conv_image->Set('magick'=>'png');
  my @blobs=$conv_image->ImageToBlob();   my @blobs=$conv_image->ImageToBlob();
  undef $conv_image;   undef $conv_image;
Line 73  sub get_image { Line 238  sub get_image {
     } elsif ($imgsrc !~ /\.(png|jpg|jpeg)$/i) {      } elsif ($imgsrc !~ /\.(png|jpg|jpeg)$/i) {
  my $conv_image = Image::Magick->new;   my $conv_image = Image::Magick->new;
  my $current_figure = $conv_image->Read('filename'=>$imgsrc);   my $current_figure = $conv_image->Read('filename'=>$imgsrc);
    $conv_image->Set('type'=>'TrueColor');
  $conv_image->Set('magick'=>'png');   $conv_image->Set('magick'=>'png');
  my @blobs=$conv_image->ImageToBlob();   my @blobs=$conv_image->ImageToBlob();
  undef $conv_image;   undef $conv_image;
  $image = GD::Image->new($blobs[0]);   $image = GD::Image->new($blobs[0]);
     } else {      } else {
  GD::Image->trueColor(1);   $image = GD::Image->trueColor(1);
  $image = GD::Image->new($imgsrc);   $image = GD::Image->new($imgsrc);
     }      }
     if ($set_trans && defined($image)) {      if ($set_trans && defined($image)) {
Line 88  sub get_image { Line 254  sub get_image {
     return $image;      return $image;
 }  }
   
   sub get_color_from_hexstring {
       my ($image,$color)=@_;
       if (!$color) { $color='000000'; }
       $color=~s/^[x\#]//;
       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 {  sub handler {
     my $r = shift;      my $r = shift;
     $r->content_type('image/png');      $r->content_type('image/png');
     $r->send_http_header;      $r->send_http_header;
     my (undef,$id) = split(/=/,$ENV{'QUERY_STRING'});  
     &Apache::lonnet::logthis("BGIMG is ".$ENV{"cgi.$id.BGIMG"});      &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
     my $image=&get_image(&Apache::lonnet::unescape($ENV{"cgi.$id.BGIMG"}),0);  
     if (! defined($image)) {      my $prefix;
         &Apache::lonnet::logthis('Unable to create image object for -'.$id.'-'.      if ($ENV{'QUERY_STRING'}=~/OBJCOUNT\=/) {
  $ENV{"cgi.$id.BGIMG"});   $prefix='form.';
         return OK;      } else {
     }   $prefix="cgi.$env{'form.token'}.";
     #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(GD::gdGiantFont,$ENV{"cgi.$id.X$i"},  
        $ENV{"cgi.$id.Y$i"}-$height,  
        &Apache::lonnet::unescape($ENV{"cgi.$id.LB$i"}),$black);  
     }  
     for(my $i=0;$i<$ENV{"cgi.$id.LINECOUNT"};$i++) {  
  my ($x1,$y1,$x2,$y2,$color,$width)=split(':',$ENV{"cgi.$id.LINE$i"});  
  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);  
  }  
  $image->setThickness($width);  
         $image->line($x1,$y1,$x2,$y2,$imcolor);  
     }  
     for(my $i=0;$i<$ENV{"cgi.$id.BOXCOUNT"};$i++) {  
  my ($x1,$y1,$x2,$y2,$color,$width)=split(':',$ENV{"cgi.$id.BOX$i"});  
  if ($x1 > $x2) { my $temp=$x1;$x1=$x2;$x2=$temp; }  
  if ($y1 > $y2) { my $temp=$y1;$y1=$y2;$y2=$temp; }  
  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);  
  }  
  $image->setThickness($width);  
         $image->rectangle($x1,$y1,$x2,$y2,$imcolor);  
     }      }
     for(my $i=0;$i<$ENV{"cgi.$id.POLYCOUNT"};$i++) {  
  my ($color,$width,$open)=split(':',$ENV{"cgi.$id.POLYOPT$i"});      my $image;
  my (undef,$red,undef,$green,undef,$blue)=split(/(..)/,$color);      if (defined($env{$prefix."BGIMG"})) {
  $red=hex($red);$green=hex($green);$blue=hex($blue);   my $bgimg=&unescape($env{$prefix."BGIMG"});
  my $imcolor;   #&Apache::lonnet::logthis("BGIMG is ".$bgimg);
  if (!($imcolor = $image->colorResolve($red,$green,$blue))) {   $image=&get_image($bgimg,0);
     $imcolor = $image->colorClosestHWB($red,$green,$blue);   if (! defined($image)) {
       &Apache::lonnet::logthis('Unable to create image object for -'.
        $env{'form.token'}.'-'.$bgimg);
       return OK;
  }   }
  my $polygon;      } elsif (defined($env{$prefix."SIZE"})) {
  if ($open) {   my ($width,$height)=split(':',$env{$prefix."SIZE"});
     $polygon = new GD::Polyline;   $image = new GD::Image($width,$height,1);
    my ($bgcolor)=split(':',$env{$prefix."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 {   } else {
     $polygon = new GD::Polygon;      $bgcolor=&get_color_from_hexstring($image,'FFFFFF');
  }      $image->fill(0,0,$bgcolor);
  foreach my $coord (split('-',$ENV{"cgi.$id.POLY$i"})) {      $image->transparent($bgcolor);
     my ($x,$y)=($coord=~m/\(([0-9]+),([0-9]+)\)/);  
     $polygon->addPt($x,$y);  
  }   }
  $image->setThickness($width);      } else {
  if ($open) {   &Apache::lonnet::logthis('Unable to create image object, no info '.$prefix);
     $image->polydraw($polygon,$imcolor);   return OK;
       }
       #binmode(STDOUT);
       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{$prefix."OBJ$i"});
       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,$imcolor);
    } elsif ($type eq 'RECTANGLE') {
       my ($x1,$y1,$x2,$y2,$color,$thickness,$filled)=
    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);
       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 'POLYGON') {
       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{$prefix."OBJEXTRA$i"})) {
    my ($x,$y)=($coord=~m/\(([0-9]+),([0-9]+)\)/);
    $polygon->addPt($x,$y);
    $added++;
       }
       
       $image->setThickness($width);
       if ($added) {
    if ($open && lc($open) ne 'no') {
       $image->polydraw($polygon,$imcolor);
    } elsif ($filled && lc($filled) ne 'no') {
       $image->filledPolygon($polygon,$imcolor);
    } else {
       $image->polygon($polygon,$imcolor);
    }
       }
    } elsif ($type eq 'ARC') {
       my ($x,$y,$width,$height,$start,$end,$color,$thickness,$filled)=
    split(':',$env{$prefix."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{$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{$prefix."OBJ$i"});
       $file=&unescape($file);
       if (!defined($transparent)) { $transparent=1; }
       my $subimage=&get_image($file,$transparent);
       if (!defined($subimage)) {
    &Apache::lonnet::logthis('Unable to create image object for '.
    $file);
    next;
       }
       if (!defined($srcW) or !$srcW) {$srcW=($subimage->getBounds())[0];}
       if (!defined($srcH) or !$srcH) {$srcH=($subimage->getBounds())[1];}
       if (!defined($destW) or !$destW) { $destW=$srcW; }
       if (!defined($destH) or !$destH) { $destH=$srcH; }
       $image->copyResized($subimage,$x,$y,$srcX,$srcY,$destW,$destH,
    $srcW,$srcH);
    } elsif ($type eq 'LABEL') {
       my ($x,$y,$text,$font,$color,$direction)=
    split(':',$env{$prefix."OBJ$i"});
       $text=&unescape($text);
       my $imcolor=&get_color_from_hexstring($image,$color);
       my $type='normal';
       my ($height,$fontref);
       if ($font eq 'tiny') {
    $height=GD::Font->Tiny->height;
    $fontref=GD::gdTinyFont;
       } elsif ($font eq 'small') {
    $height=GD::Font->Small->height;
    $fontref=GD::gdSmallFont;
       } elsif ($font eq 'medium') {
    $height=GD::Font->MediumBold->height;
    $fontref=GD::gdMediumBoldFont;
       } elsif ($font eq 'large') {
    $height=GD::Font->Large->height;
    $fontref=GD::gdLargeFont;
       } elsif ($font eq 'giant' || !$font) {
    $height=GD::Font->Giant->height;
    $fontref=GD::gdGiantFont;
       } else {
    $type='ttf';
       }
       if ($type eq 'normal' && $direction eq 'vertical') {
    $image->stringUp($fontref,$x,$y-$height,$text,$imcolor);
       } elsif ($type eq 'normal') {
    $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);
       }
  } else {   } else {
     $image->polygon($polygon,$imcolor);      &Apache::lonnet::logthis("randomlylabel unable to handle object of type $type");
  }   }
     }      }
     $image->setThickness(1);      $image->setThickness(1);
Removed from v.1.15  
changed lines
  Added in v.1.29

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.