Making PNG Images

You can use the GD library to create PNG images on the fly.

Script II.1.7: circle.pl

 #!/usr/local/bin/perl -w
 
 # script: circle.pl
 use strict;
 use GD;
 use CGI qw/:standard :imagemap/;
 
 use constant RECTSIZE     => 100;
 use constant CIRCLE_RADIUS  => 40;
 my %COLORS = (
 	      'white' => [255,255,255],
 	      'red'   => [255,0,0],
 	      'green' => [0,255,0],
 	      'blue'  => [0,0,255],
 	      'black' => [0,0,0],
 	      'bisque'=> [255,228,196],
 	      'papaya whip' => [255,239,113],
 	      'sienna' => [160,82,45]
 	     );

 # if $draw is set, then emit an image/png, otherwise make the HTML page
 if (param('draw')) {
     draw_image();
 } else {
     print header(),
           start_html(-title=>'Feeling Circular',-bgcolor=>'white');
 
     make_page();
     make_imagemap();
 
     print end_html;
 }
 
 # called to draw the image         
 sub draw_image {
   my ($rx1,$ry1,$rx2,$ry2) = rect_coords();
   my ($cx,$cy,$cw,$ch)     = circle_coords();
   my $circle_color         = param('color') || 'bisque';
 
   # create a new image
   my $im = new GD::Image($rx2-$rx1+1,$ry2-$ry1+1);
     
   # allocate some colors
   my $white = $im->colorAllocate(@{$COLORS{'white'}});
   my $black = $im->colorAllocate(@{$COLORS{'black'}});       
   my $circlecolor = $im->colorAllocate(@{$COLORS{$circle_color}});
     
   # make the background transparent and interlaced
   $im->transparent($white);
   $im->interlaced('true');
     
   # Put a black frame around the picture
   $im->rectangle($rx1,$ry1,$rx2,$ry2,$black);
     
   # Draw the circle
   $im->arc($cx,$cy,$cw,$ch,0,360,$black);
     
   # And fill it with circlecolor
   $im->fill($cx,$cy,$circlecolor);
     
   # Convert the image to PNG and print it
   print header('image/png'),$im->png;
 }
 
 # print the text of the page -- inclues an <IMG> tag
 sub make_page {
   print
     h1('A Circle is as a Circle Does'),
     start_form,
     "Magnification: ", radio_group(-name=>'magnification',-values=>[1..4]),br,
     "Color: ",         popup_menu(-name=>'color',-values=>[sort keys %COLORS]),
     submit(-value=>'Change'),
     end_form;
 
   print h2(param('message')) if param('message');
 
   my $q = new CGI;
   $q->param('draw' => 1);
   my $url = $q->url(-relative=>1,-query_string=>1);
   
   print p(
 	  img({-src=>$url,
 	       -align=>'LEFT',
 	       -usemap=>'#map',
 	       -border=>0})),"\n";
 }
 
 # print the client-side imagemap for the image
 sub make_imagemap {
   my ($rx1,$ry1,$rx2,$ry2) = rect_coords();
   my ($cx,$cy,$cw,$ch)     = circle_coords();
   my $q = new CGI;
 
   $q->param('message' => 'You clicked in the circle!');
   my $circle_url  = $q->url(-relative=>1,-query_string=>1);
 
   $q->param('message' => 'You clicked in the square!');
   my $rect_url    = $q->url(-relative=>1,-query_string=>1);
   
   print Map({-name=>'map'},
 	    Area({-shape=>'CIRCLE',
 		  -href=>$circle_url,
 		  -coords=>join(',',$cx,$cy,$cw/2),
 		  -alt=>'Circle'}),"\n",
 
 	    Area({-shape=>'RECT',
 		  -href=>$rect_url,
 		  -coords=>join(',',$rx1,$ry1,$rx2,$ry2),
 		  -alt=>'Square'})
 	   );
 }
 
 # return rectangle's topleft and botright coordinates (x1,y1,x2,y2) 
 sub rect_coords {
   my $mag = param('magnification') || 1;
   return (0,0,RECTSIZE*$mag,RECTSIZE*$mag);
 }
 
 # return circle's (center, width, height)
 sub circle_coords {
   my $mag = param('magnification') || 1;
   return (RECTSIZE*$mag/2,RECTSIZE*$mag/2,CIRCLE_RADIUS*$mag*2,CIRCLE_RADIUS*$mag*2);
 }

What it Looks Like

http://localhost/cgi-bin/conference/circle.pl
<< Previous Contents >> Next >>

Lincoln D. Stein, lstein@cshl.org
Cold Spring Harbor Laboratory
Last modified: Sun Jun 4 06:16:14 AKDT 2000