version 1.3, 2001/12/11 13:47:36
|
version 1.4, 2001/12/12 18:36:44
|
Line 1
|
Line 1
|
#!/usr/bin/perl |
#!/usr/bin/perl -w |
# |
# |
# $Id$ |
# $Id$ |
# |
# |
Line 55
|
Line 55
|
# giant, large, medium, small, tiny |
# giant, large, medium, small, tiny |
# |
# |
########################################################################### |
########################################################################### |
|
## |
|
## Data structures & file description |
|
## |
|
## The input file is taken to be comprised of "segments". Each "segment" |
|
## will hold data for the plot header, the coordinate axes, or (more likely) |
|
## the curves, circles, and polygons that are to be plotted. |
|
## |
|
## The global array @Segments holds references to hashes which contain the |
|
## data needed for each structure. |
|
## |
|
use FileHandle; |
use GD; |
use GD; |
|
|
my @inputs = split(/&/,$ENV{'QUERY_STRING'}); |
my ($image,$axis); |
foreach $input (@inputs) { |
$filename = shift; |
($var,$val) = split /\=/,$input,2; |
# GET FILENAME AND OPEN THE FILE, BAIL OUT IF UNABLE TO DO SO |
if (! defined($val)) { |
$fh = new FileHandle("<$filename"); |
$val = 1; |
my @Segments = &read_file($fh); |
} |
|
$In{lc($var)}=$val; |
foreach $segment (@Segments) { |
} |
&set_defaults($segment); |
|
|
$height = &grab('height',100,\%In); |
|
$width = &grab('width',100,\%In); |
|
$axis->{'xmin'} = &grab('xmin',-10,\%In); |
|
$axis->{'xmax'} = &grab('xmax', 10,\%In); |
|
$axis->{'ymin'} = &grab('ymin',-10,\%In); |
|
$axis->{'ymax'} = &grab('ymax', 10,\%In); |
|
$axis->{'xlen'} = $axis->{'xmax'} - $axis->{'xmin'}; |
|
$axis->{'ylen'} = $axis->{'ymax'} - $axis->{'ymin'}; |
|
$vtic_every = &grab('vtic_every',1.0,\%In); |
|
$htic_every = &grab('htic_every',1.0,\%In); |
|
|
|
my $image = new GD::Image($width,$height); |
|
|
|
# allocate standard colors |
|
my @BGvalues = split /,/,&grab('bgcolor','255,255,255',\%In); |
|
my @FGvalues = split /,/,&grab('fgcolor','0,0,0',\%In); |
|
my $bgcolor = $image->colorAllocate(@BGvalues); |
|
my $fgcolor = $image->colorAllocate(@FGvalues); |
|
|
|
# Draw a fgcolor frame around the picture |
|
&drawtics($htic_every,$vtic_every) if (exists($In{'drawtics'})); |
|
&drawaxes($axis) if (exists($In{'drawaxis'})); |
|
&drawframe(1) if (exists($In{'frame'})); |
|
# make the background transparent if needed (this doesn't work, at least |
|
# not for gif images, don't know if it works for png) |
|
$image->transparent($bgcolor) if (exists($In{'transparent'})); |
|
|
|
## Take care of labels and data series |
|
foreach (keys %In) { |
|
if (/^label/) { |
|
my ($x,$y,$size,$text) = split/,/,$In{$_}; |
|
&drawstring($text,$x,$y,$fgcolor,$size); |
|
delete ($In{$_}); |
|
next; |
|
} elsif (/^xseries/) { |
|
$xname = $_; |
|
$yname = $xname; |
|
$yname =~ s/^x/y/; |
|
(@X)=split/,/,$In{$xname}; |
|
(@Y)=split/,/,$In{$yname}; |
|
delete ($In{$xname}); |
|
delete ($In{$yname}); |
|
if ($#X != $#Y) { |
|
&drawstring("size of $xname and $yname do not match", |
|
10,10,$fgcolor,"giant"); |
|
next; |
|
} |
|
&drawcurve(\@X,\@Y); |
|
} |
|
} |
} |
|
&init_image(&get_specific_segment(\@Segments,'plotheader'), |
|
&get_specific_segment(\@Segments,'axis')); |
|
|
|
for (my $i =0; $i<=$#Segments; $i++) { |
|
grok_segment($Segments[$i]); |
|
} |
|
&write_image(); |
|
|
# Tell the browser our mime-type |
#---------------------------------------------------- convenience functions |
print <<END; |
sub write_image { |
Content-type: image/gif |
# Tell the browser our mime-type |
|
# print <<END; |
|
#Content-type: image/gif |
|
# |
|
#END |
|
my $BinaryData=$image->png; |
|
undef $image; |
|
binmode(STDOUT); |
|
open IMG,"|pngtopnm|ppmtogif 2>/dev/null"; # convert into a gif image |
|
print IMG $BinaryData; # output image |
|
$|=1; # be sure to flush before closing |
|
close IMG; |
|
} |
|
|
END |
sub grok_segment { |
|
$_ = shift; |
|
my %Data = %$_; |
|
$type = $Data{'type'}; |
|
if (!defined($type)) { |
|
return undef; |
|
} elsif ($type eq 'frame') { |
|
draw_frame(\%Data); |
|
} elsif ($type eq 'curve') { |
|
draw_curve(\%Data); |
|
} elsif ($type eq 'label') { |
|
draw_label(\%Data); |
|
} elsif ($type eq 'circle') { |
|
draw_circle(\%Data); |
|
} elsif ($type eq 'polygon') { |
|
draw_polygon(\%Data); |
|
} elsif ($type eq 'line') { |
|
draw_line(\%Data); |
|
} |
|
} |
|
|
my $BinaryData=$image->png; |
sub get_specific_segment { |
undef $image; |
$_ = shift; |
binmode(STDOUT); |
my @Segments = @$_; |
open IMG,"|pngtopnm|ppmtogif 2>/dev/null"; # convert into a gif image |
my $type = shift; |
print IMG $BinaryData; # output image |
for ($i = 0; $i<=$#Segments; $i++) { |
$|=1; # be sure to flush before closing |
if ($Segments[$i]->{'type'} eq $type) { |
close IMG; |
return (splice @Segments, $i,1); |
|
} |
|
} |
|
return undef; |
|
} |
|
|
|
#---------------------------------------------------- plot description reading |
|
sub read_file { |
|
my @Returned_Segments; |
|
my $fh = shift; |
|
($ret,$ref) = read_segment($fh); |
|
while (defined($ret) && $ret !=0) { |
|
push @Returned_Segments,$ref; |
|
($ret,$ref) = read_segment($fh); |
|
} |
|
return @Returned_Segments; |
|
} |
|
|
#-------------------------------------------------------------------- |
sub newhash{ |
|
my %H; |
|
return \%H; |
|
} |
|
|
sub grab{ |
sub read_segment{ |
my ($name,$default,$h) = @_; |
# Reads in a segment of a plotting file. |
my $value = $h->{$name}; |
# Returns 1,\%Data on success (or parital success) |
if (defined($value)) { |
# Returns 0, undef on failure; |
delete ($h->{$name}) ; |
$fh = shift; |
} else { |
my $Data = newhash(); |
$value = $default; |
|
|
$_ = <$fh>; |
|
if (! /^NEW /) { |
|
return undef; |
} |
} |
return $value; |
|
} |
|
|
|
# transformPoint(x,y) where x,y are in the coordinates of axis will return |
while($_=<$fh>) { |
# the coordinates transformed to the image coordinate system. |
last if (/^END /); |
sub transformPoint{ |
# Lines are of the form "type::var=value", "NEW type", or "END type" |
my ($x,$y) = @_; |
chomp; |
my ($width,$height) = $image->getBounds(); |
return(0,undef) if (/^NEW /); |
$x = ( $x - $axis->{"xmin"}) * $width / ( $axis->{"xlen"}); |
if (/(\w+)::(\w+)[\s]*=\s*\"([\w\s,\-\+\.]+)\"/) { |
$y = ( ( $axis->{"ylen"} ) - ($y - $axis->{"ymin"})) |
$Data->{'type'} = $1 if (!exists ($Data->{'type'})); |
* $height / ( $axis->{"ylen"} ); |
return(0,$Data) if ($Data->{'type'} ne $1); |
return($x,$y); |
$Data->{$2} = $3; |
|
} else { |
|
# Something went wrong - bad input - what to do? |
|
} |
|
} |
|
return (1,$Data); |
|
} |
|
|
|
#------------------------------------------------------- |
|
sub init_image { |
|
my $PlotHeader = shift; |
|
$axis = shift; |
|
# Take care of making the image |
|
my ($width,$height) = ($PlotHeader->{'width'},$PlotHeader->{'height'}); |
|
|
|
$image = new GD::Image($width,$height); |
|
my $bgcolor = $image->colorAllocate(split/,/,$PlotHeader->{'bgcolor'}); |
|
my $fgcolor = $image->colorAllocate(split/,/,$PlotHeader->{'fgcolor'}); |
|
$image->transparent($bgcolor) if ($PlotHeader->{'transparent'} eq 'true'); |
|
|
|
$axis->{'xlen'} = $axis->{'xmax'} - $axis->{'xmin'}; |
|
$axis->{'ylen'} = $axis->{'ymax'} - $axis->{'ymin'}; |
|
if ($axis->{'drawaxis'} eq 'true') { |
|
&draw_axes(); |
|
} |
|
if ($axis->{'drawtics'} eq 'true') { |
|
&draw_tics(); |
|
} |
} |
} |
|
|
sub drawaxes{ |
#-------------------------------------------------------- axis routines |
|
sub draw_axes{ |
|
my $color = $image->colorResolve(split /,/,$axis->{'color'}); |
($x1,$y1) = &transformPoint($axis->{"xmin"},0,$image,$axis); |
($x1,$y1) = &transformPoint($axis->{"xmin"},0,$image,$axis); |
($x2,$y2) = &transformPoint($axis->{"xmax"},0,$image,$axis); |
($x2,$y2) = &transformPoint($axis->{"xmax"},0,$image,$axis); |
$image->line($x1,$y1,$x2,$y2,$fgcolor); |
$image->line($x1,$y1,$x2,$y2,$color); |
($x1,$y1) = &transformPoint(0,$axis->{"ymin"},$image,$axis); |
($x1,$y1) = &transformPoint(0,$axis->{"ymin"},$image,$axis); |
($x2,$y2) = &transformPoint(0,$axis->{"ymax"},$image,$axis); |
($x2,$y2) = &transformPoint(0,$axis->{"ymax"},$image,$axis); |
$image->line($x1,$y1,$x2,$y2,$fgcolor); |
$image->line($x1,$y1,$x2,$y2,$color); |
} |
} |
|
|
sub drawtics{ |
sub draw_tics{ |
my ($htic_every,$vtic_every) = @_; |
my $color = $image->colorResolve(split /,/, $axis->{'color'}); |
|
my ($htic_every,$vtic_every) = ($axis->{'htic_every'}, $axis->{'vtic_every'}); |
my ($width,$height) = $image->getBounds(); |
my ($width,$height) = $image->getBounds(); |
|
|
$ticwidth = ($width > 99 ? 5 : int($width /20) + 1); |
my $ticwidth = ($width > 99 ? 5 : int($width /20) + 1); |
$ticheight = ($height > 99 ? 5 : int($height/20) + 1); |
my $ticheight = ($height > 99 ? 5 : int($height/20) + 1); |
|
|
# Do tics along y-axis |
# Do tics along y-axis |
for ($ntic = 0; $ntic <=int($axis->{"ylen"}/$vtic_every); $ntic++){ |
for ($ntic = 0; $ntic <=int($axis->{"ylen"}/$vtic_every); $ntic++){ |
Line 179 sub drawtics{
|
Line 226 sub drawtics{
|
my ($x2,$y2) = &transformPoint(0,$axis->{"ymin"}+$ntic*$vtic_every); |
my ($x2,$y2) = &transformPoint(0,$axis->{"ymin"}+$ntic*$vtic_every); |
$x1 -= $ticwidth; |
$x1 -= $ticwidth; |
$x2 += $ticwidth; |
$x2 += $ticwidth; |
$image->line($x1,$y1,$x2,$y2,$fgcolor); |
$image->line($x1,$y1,$x2,$y2,$color); |
} |
} |
# Do tics along x-axis |
# Do tics along x-axis |
for ($ntic = 0; $ntic <=int($axis->{"xlen"}/$htic_every); $ntic++){ |
for ($ntic = 0; $ntic <=int($axis->{"xlen"}/$htic_every); $ntic++){ |
Line 187 sub drawtics{
|
Line 234 sub drawtics{
|
my ($x2,$y2) = &transformPoint( $axis->{"xmin"}+$ntic*$htic_every,0); |
my ($x2,$y2) = &transformPoint( $axis->{"xmin"}+$ntic*$htic_every,0); |
$y1 -= $ticheight; |
$y1 -= $ticheight; |
$y2 += $ticheight; |
$y2 += $ticheight; |
$image->line($x1,$y1,$x2,$y2,$fgcolor); |
$image->line($x1,$y1,$x2,$y2,$color); |
} |
} |
} |
} |
|
|
sub drawcurve{ |
#------------------------------------------------------- misc plotting routines |
my ($X,$Y) = @_; |
sub draw_frame { |
for($i=0;$i< (@$X-1);$i++) { |
my $Frame = shift; |
($x1,$y1) = &transformPoint($X->[$i ],$Y->[$i ]); |
my ($width,$height) = $image->getBounds(); |
($x2,$y2) = &transformPoint($X->[$i+1],$Y->[$i+1]); |
my $color = $image->colorResolve(split /,/,$Frame->{'color'} ); |
$image->line($x1,$y1,$x2,$y2,$fgcolor); |
# Draw a frame around the picture. |
|
my $offset = $Frame->{'offset'}; |
|
for (my $i = 0; $i<=$Frame->{'thickness'}; $i++) { |
|
$image->rectangle( |
|
$offset - 1, |
|
$offset - 1, |
|
$width-$offset, |
|
$height-$offset, |
|
$color); |
} |
} |
} |
} |
|
|
sub drawframe{ |
sub draw_line{ |
# Draw a frame around the picture. |
my $Line = shift; |
my ($xoffset,$yoffset) = @_; |
my $color = $image->colorResolve(split/,/, $Line->{'color'}); |
$xoffset = $xoffset || 1; |
my ($x1,$y1) = &transformPoint($Line->{'x1'},$Line->{'y1'}); |
$yoffset = $yoffset || $xoffset; |
my ($x2,$y2) = &transformPoint($Line->{'x2'},$Line->{'y2'}); |
my ($width,$height) = $image->getBounds(); |
$image->line($x1,$y1,$x2,$y2,$color); |
$image->rectangle($xoffset-1,$yoffset-1,$width-$xoffset,$height-$yoffset,$fgcolor); |
} |
|
|
|
sub draw_curve{ |
|
my $Curve = shift; |
|
my $color = $image->colorResolve(split /,/, $Curve->{'color'}); |
|
@X = split /,/,$Curve->{'xdata'}; |
|
@Y = split /,/,$Curve->{'ydata'}; |
|
if ($#X != $#Y) { |
|
return 0; |
|
} |
|
for($i=0;$i< $#X ;$i++) { |
|
my ($x1,$y1) = &transformPoint($X[$i] ,$Y[$i]); |
|
my ($x2,$y2) = &transformPoint($X[$i+1],$Y[$i+1]); |
|
$image->line($x1,$y1,$x2,$y2,$color); |
|
} |
} |
} |
|
|
sub drawstring{ |
sub draw_label{ |
# Write some text on the image. |
my $Label = shift; |
my ($text,$x,$y,$color,$fontName) = @_; |
my $color = $image->colorResolve(split /,/, $Label->{'color'}); |
$font = gdGiantFont if (lc($fontName) eq "giant" || |
my $fontname = $Label->{'font'}; |
lc($fontName) eq "huge" ); |
my $font = gdGiantFont if (lc($fontname) eq "giant" || |
$font = gdLargeFont if (lc($fontName) eq "large"); |
lc($fontname) eq "huge" ); |
$font = gdMediumBoldFont if (lc($fontName) eq "medium"); |
$font = gdLargeFont if (lc($fontname) eq "large" ); |
$font = gdSmallFont if (lc($fontName) eq "small"); |
$font = gdMediumBoldFont if (lc($fontname) eq "medium"); |
$font = gdTinyFont if (lc($fontName) eq "tiny"); |
$font = gdSmallFont if (lc($fontname) eq "small" ); |
|
$font = gdTinyFont if (lc($fontname) eq "tiny" ); |
|
my $text = $Label->{'text'}; |
if (! defined($font)) { |
if (! defined($font)) { |
$font = gdGiantFont; |
$font = gdGiantFont; |
$text = "Font size error!"; |
$text = "Font size error!"; |
} |
} |
($x,$y) = &transformPoint($x,$y); |
my ($x,$y) = &transformPoint($Label->{'x'},$Label->{'y'}); |
$image->string($font,$x,$y,$text,$color); |
$image->string($font,$x,$y,$text,$color); |
} |
} |
|
|
|
sub draw_circle { |
|
my $Circle = shift; |
|
my ($width,$height) = $image->getBounds(); |
|
my $color = $image->colorResolve(split /,/, $Circle->{'color'}); |
|
my ($x,$y) = &transformPoint(split/,/,$Circle->{'center'}); |
|
my $xradius = $Circle->{'radius'} * $width / $axis->{'xlen'}; |
|
my $yradius = $Circle->{'radius'} * $height / $axis->{'ylen'}; |
|
# draw a semicircle centered at 100,100 |
|
$image->arc($x,$y,$xradius,$yradius,0,360,$color); |
|
$image->fill($x,$y,$color) if ($Circle->{'filled'} eq 'true'); |
|
} |
|
|
|
sub draw_polygon { |
|
my $Poly = shift; |
|
my $color = $image->colorResolve(split /,/, $Poly->{'color'}); |
|
@X = split /,/,$Poly->{'xdata'}; |
|
@Y = split /,/,$Poly->{'ydata'}; |
|
if ($#X != $#Y) { |
|
return 0; |
|
} |
|
my $poly = new GD::Polygon; |
|
for ($i=0;$i<=$#X;$i++) { |
|
$poly->addPt(&transformPoint($X[$i],$Y[$i])); |
|
} |
|
if ($Poly->{'filled'} eq 'true') { |
|
$image->filledPolygon($poly,$color); |
|
} else { |
|
$image->polygon($poly,$color); |
|
} |
|
} |
|
|
|
#------------------------------------------ transform point (basic routine) |
|
# |
|
# transformPoint(x,y) where x,y are in the coordinates of axis will return |
|
# the coordinates transformed to the image coordinate system. |
|
sub transformPoint{ |
|
my ($x,$y) = @_; |
|
my ($width,$height) = $image->getBounds(); |
|
$x = ( $x - $axis->{"xmin"}) * $width / ( $axis->{"xlen"}); |
|
$y = ( ( $axis->{"ylen"} ) - ($y - $axis->{"ymin"})) |
|
* $height / ( $axis->{"ylen"} ); |
|
return($x,$y); |
|
} |
|
|
|
#------------------------------------------ set defaults is a beast! |
|
|
|
sub set_defaults { |
|
my $PlotHeader = { |
|
type => "plotheader", |
|
name => "plot", |
|
height => "200", |
|
width => "300", |
|
bgcolor => "255,255,255", |
|
fgcolor => " 0, 0, 0", |
|
transparent => "true" |
|
}; |
|
|
|
my $Axis = { |
|
type => "axis", |
|
name => "axis", |
|
color => " 0, 0, 0", |
|
drawtics => "true", |
|
vtic_every => " 1.0", |
|
htic_every => " 1.0", |
|
xmin => "-10.0", |
|
ymin => " -5.0", |
|
xmax => " 10.0", |
|
ymax => " 5.0", |
|
drawaxis => "true" |
|
}; |
|
|
|
my $Frame = { |
|
type => "frame", |
|
color => " 0, 0, 0", |
|
offset => "1.0", |
|
thickness => "1.0", |
|
drawframe => "true" |
|
}; |
|
|
|
my $Curve= { |
|
type => "curve", |
|
name => "curve", |
|
color => " 0, 0, 0", |
|
xdata => " 1.0, 2.0, 3.0, 4.0, 5.0, 6.0", |
|
ydata => " 1.0, 2.0, 3.0, 4.0, 5.0, 6.0" |
|
}; |
|
|
|
my $Label = { |
|
type => "label", |
|
name => "label", |
|
font => "medium", |
|
text => "default label text", |
|
color => " 0, 0, 0", |
|
x => " -5.0", |
|
y => " 5.0" |
|
}; |
|
|
|
my $Circle = { |
|
type => "circle", |
|
name => "circle", |
|
color => " 0, 0, 0", |
|
filled => "true", |
|
center => "x,y", |
|
radius => "12.0" |
|
}; |
|
|
|
my $Polygon = { |
|
type => "polygon", |
|
name => "polygon", |
|
color => " 0, 0, 0", |
|
filled => "true", |
|
xdata => "1.0, 0.5, 0.0, -0,5, -1.0, -0.5, 0.0, 0.5", |
|
ydata => "0.0,-0.5,-1.0, -0.5, 0.0, 0.5, 1.0, 0.5" |
|
}; |
|
|
|
my $Line = { |
|
type => "line", |
|
name => "line", |
|
color => " 0, 0, 0", |
|
x1 => "1.0", |
|
y1 => "0.0", |
|
x2 => "2.0", |
|
y2 => "4.0" |
|
}; |
|
|
|
my $typematch = { |
|
plotheader => $PlotHeader, |
|
axis => $Axis, |
|
frame => $Frame, |
|
label => $Label, |
|
curve => $Curve, |
|
circle => $Circle, |
|
polygon => $Polygon |
|
}; |
|
|
|
my $seg = shift; |
|
if (exists($typematch->{$seg->{'type'}})) { |
|
my $H = $typematch->{$seg->{'type'}}; |
|
foreach $key (keys %$H) { |
|
if (! exists($seg->{$key})) { |
|
$seg->{$key} = $H->{$key}; |
|
} |
|
} |
|
} |
|
} |
|
|
|
|
|
|