Script 10: circle.pl

This script does three things:

  1. When called without draw parameter, creates an HTML page containing an <IMG> tag pointing back to itself.
  2. When called with draw parameter, uses GD to create a little in-line PNG image.
  3. Also creates a client side imagemap and processes user's clicks.
#!/usr/local/bin/perl
 
# script: circle.pl
use GD;
use CGI::Pretty qw/:standard Map Area/;
use strict vars;
use vars qw/$draw $circle_color $mag %COLORS/;
 
use constant RECTSIZE     => 100;
use constant CIRCLE_RADIUS  => 40;
%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]
 	   );
$draw          = param('draw');
$circle_color  = param('color') || 'bisque';
$mag           = param('magnification') || 1;

# if $draw is set, then emit an image/png, otherwise make the HTML page
if ($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 {
    # create a new image
    my $im = new GD::Image(RECTSIZE*$mag,RECTSIZE*$mag);
    
    # 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(0,0,RECTSIZE*$mag-1,RECTSIZE*$mag-1,$black);
    
    # Draw the circle
    $im->arc(RECTSIZE*$mag/2,RECTSIZE*$mag/2,CIRCLE_RADIUS*$mag*2,CIRCLE_RADIUS*$mag*2,0,360,$black);
    
    # And fill it with circlecolor
    $im->fill(RECTSIZE*$mag/2,RECTSIZE*$mag/2,$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 $url = url(-relative=>1,-query_string=>1);
  $url .= '?' unless param();
  $url .= '&draw=1';
  
  print p(
	  img({-src=>$url,
	       -align=>'LEFT',
	       -usemap=>'#map',
	       -border=>0})),"\n";
}

# print the client-side imagemap for the image
sub make_imagemap {
  print Map({-name=>'map'},
	    Area({-shape=>'CIRCLE',
		  -href=>param(-name=>'message',-value=>"You clicked in the circle") 
		         && url(-relative=>1,-query_string=>1),
		  -coords=>join(',',RECTSIZE*$mag/2,RECTSIZE*$mag/2,CIRCLE_RADIUS*$mag),
		  -alt=>'Circle'}),"\n",

	    Area({-shape=>'RECT',
		  -href=>param(-name=>'message',-value=>"You clicked in the square")
		         && url(-relative=>1,-query_string=>1),
		  -coords=>join(',',0,0,RECTSIZE*$mag,RECTSIZE*$mag),
		  -alt=>'Square'}));
}

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: Fri Dec 3 11:35:19 EST 1999