SPUG: ESPUG GD Example...

Ryan Erwin ryan at erwin.org
Sat Jan 29 06:32:27 CST 2000


I've been wanting to do a little more with this but just haven't had
the time.  Here it is for now.  Get GD and check it out.
Have fun connecting the dots ;)

--Ryan Erwin [ryan at erwin.org]

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
#!/usr/bin/perl -w
# program: cgi-bin/thengone [the n gon ]
# purpose: cgi part of GD / espug demo
# creator: ryan s erwin [ryan at erwin.org]
#    date: 01.26.2000

use CGI;
use strict;

my $cgi = new CGI;

my ($connect, $bgcolor, $fgcolor, $points, $text, $imageurl);
if ($cgi->param()) {
	if ( $cgi->param('connect the dots') ) {
		$connect = 'true';
	} else {
		$connect = 'false';
	}
	$bgcolor = $cgi->param('bgcolor');
	$fgcolor = $cgi->param('fgcolor');
	if ( $cgi->param('theImage.x') && $cgi->param('theImage.y')) {
		$points = $cgi->param('points');
		$points .= $cgi->param('theImage.x') . ":";
		$points .= $cgi->param('theImage.y') . ":";
	} else {
		$points = $cgi->param('points');
	}
	$text = $cgi->param('text');
} else {
	$connect = 'false';
	$bgcolor = 'white';
	$fgcolor = 'red';
	$points = '';
	$text = '';
}
$cgi->param('points',$points);
$imageurl = "/cgi-bin/image?connect=$connect&bgcolor=$bgcolor&fgcolor=$fgcolor&points=$points&text=$text";

print $cgi->header(),
	$cgi->start_html('click here and there...'),
	$cgi->h3("click on the image for polygon fun!\n");

print "<div align='center'><table width='98%' cellspacing=0 cellpadding=3 border=1><tr><td>";
print $cgi->start_form(),
	$cgi->hidden('points',$points),
	"Foregrond Color:",
	$cgi->popup_menu(-name=>'fgcolor',
				-values=>['red','green','blue','black','white',
				'black50'],-default=>'red'), "<br>\n",
	"Background Color:",
	$cgi->popup_menu(-name=>'bgcolor',
				-values=>['red','green','blue','black','white',
				'black50'],-default=>'white'), "<br>\n",
	"Text:", $cgi->textfield('text'), "<br>\n",
	$cgi->submit('submit'), "<br>\n",
	$cgi->submit('connect the dots'), "<br>\n",
	$cgi->defaults('reset'), "<br>\n","</td><td width='50%'>",
	"<div align='center'>\n",
	$cgi->image_button("theImage",$imageurl), "</div>\n",
	$cgi->end_form(),"\n<p>\n", "</td></tr></table></div>";

foreach ($cgi->param()) {
	print "Parameter: $_ => ", $cgi->param($_), "<br>\n";
}
print "\$connect = $connect<br>\n";

print $cgi->end_html();

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
#!/usr/bin/perl
# program: cgi-bin/image
# purpose: draw with gd!
# creator: ryan s erwin [ryan at erwin.org]
#    date: 01.26.2000

#params $connect, $bgcolor, $fgcolor, $points, $text

use GD;
use CGI;

my $cgi = new CGI;
print $cgi->header('image/png');
my $connect = $cgi->param('connect');
my $bgcolor = $cgi->param('bgcolor');
my $fgcolor = $cgi->param('fgcolor');
my $points  = $cgi->param('points');
my $text    = $cgi->param('text');

my $image = new GD::Image(200,200) ||
	die "Couldn't create GD Image $!";

$white	= $image->colorAllocate(255,255,255);
$black	= $image->colorAllocate(0,0,0);
$red	= $image->colorAllocate(255,0,0);
$blue	= $image->colorAllocate(0,0,255);
$green	= $image->colorAllocate(0,255,0);
$black50= $image->colorAllocate(127,127,127);

$image->transparent($white);
$image->interlaced('true');

$image->filledRectangle(0,0,199,199,${$bgcolor});
$image->string(gdLargeFont,0,0,$text,$green) 
	if $text ne "";
my @points = split ( ":", $cgi->param('points'));
if ( $connect ne 'true' ) {
	while (@points) {
		my ($x, $y);
		$x = shift(@points);
		$y = shift(@points);
		#print "set: $x, $y\n";
		#$image->setPixel($x, $y, ${$fgcolor} );
		#print "setPixel($x, $y, ${$fgcolor} )\n";	
		$image->arc($x,$y, 7,7, 0,360, ${$fgcolor});
	}
} else {
	my $ngon = new GD::Polygon;
	while (@points) {
		my ($x, $y);
		$x = shift(@points);
		$y = shift(@points);
		$ngon->addPt($x,$y);
	}
	$image->filledPolygon($ngon, ${$fgcolor});
}
binmode STDOUT;

print $image->png;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --


 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    POST TO: spug-list at pm.org        PROBLEMS: owner-spug-list at pm.org
 Seattle Perl Users Group (SPUG) Home Page: http://www.halcyon.com/spug/
 SUBSCRIBE/UNSUBSCRIBE: Replace ACTION below by subscribe or unsubscribe
        Email to majordomo at pm.org: ACTION spug-list your_address





More information about the spug-list mailing list