version 1.1, 2001/12/07 22:52:38
|
version 1.12, 2006/09/06 19:26:07
|
Line 1
|
Line 1
|
#!/usr/bin/perl |
#!/usr/bin/perl |
# |
# |
# $Id$ |
# $Id$ |
# |
# |
Line 24
|
Line 24
|
# |
# |
# http://www.lon-capa.org/ |
# http://www.lon-capa.org/ |
# |
# |
# CGI-BIN interface to GD, used for making mathematical plots. |
use strict; |
# |
|
# User specifies the following variables (given are defaults): |
|
# height = "100" |
|
# width = "100" |
|
# xmin = "-10.0" |
|
# xmax = " 10.0" |
|
# ymin = "-10.0" |
|
# ymax = " 10.0" |
|
# frame |
|
# drawaxes |
|
# drawtics |
|
# vtic_every = "1.0" |
|
# htic_every = "1.0" |
|
# xseries1 = "x1,x2,x3,x4,x5,...,xn" |
|
# yseries1 = "y1,y2,y3,y4,y5,...,yn" |
|
# xseries2 = .. |
|
# yseries2 = .. |
|
# ... |
|
# label1 = "x,y,size,text" |
|
# label2 = "x,y,size,text" |
|
# label3 = "x,y,size,text" |
|
# ... |
|
# |
|
# size of a labelN is one of : |
|
# giant, large, medium, small, tiny |
|
# |
|
use GD; |
|
|
|
my @inputs = split(/&/,$ENV{'QUERY_STRING'}); |
|
foreach $input (@inputs) { |
|
($var,$val) = split /\=/,$input,2; |
|
if (! defined($val)) { |
|
$val = 1; |
|
} |
|
$In{lc($var)}=$val; |
|
} |
|
|
|
$height = &grab('height',100,\%In); |
$|=1; |
$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($height,$width); |
|
|
|
# allocate standard colors |
|
my $white = $image->colorAllocate(255,255,255); |
|
my $black = $image->colorAllocate( 0, 0, 0); |
|
|
|
# Draw a black frame around the picture |
|
&drawtics($htic_every,$vtic_every) if (exists($In{"drawtics"})); |
|
&drawaxes($axis) if (exists($In{"drawaxis"})); |
|
&frame(1) if (exists($In{'frame'})); |
|
|
|
## Take care of labels and data series |
|
foreach (keys %In) { |
|
if (/^label/) { |
|
my ($x,$y,$size,$text) = split/,/,$In{$_}; |
|
&drawstring($text,$x,$y,$black,$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,$black,"giant"); |
|
next; |
|
} |
|
&drawcurve(\@X,\@Y); |
|
} |
|
} |
|
|
|
# make the background transparent and interlaced |
my $tmpdir = '/home/httpd/perl/tmp/'; |
$image->transparent($white); |
my %data; |
|
foreach (split/&/,$ENV{'QUERY_STRING'}) { |
# make sure we are writing to a binary stream |
my ($name,$value)=split/=/; |
binmode STDOUT; |
$data{$name}=$value; |
|
} |
# Convert the image to PNG and print it on standard output |
my $filename = $data{'file'}; |
print <<END; |
# unescape filename |
Content-type: image/png |
$filename =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; |
|
die if ($filename =~ /\// || $filename !~ /_plot.data$/); |
|
$filename = $tmpdir . $filename; |
|
die "$data{'file'} does not exist\n" if (! -e $filename); |
|
|
|
my $output = $data{'output'}; |
|
if ($output eq '') { |
|
$output = (split('\.',$0))[-1]; |
|
} |
|
|
|
if ($output eq 'gif' || $output eq 'png') { |
|
open PLOT, "gnuplot $filename |"; |
|
print <<"END"; |
|
Content-type: image/$output |
|
|
END |
END |
|
while ($_=<PLOT>) { |
my $BinaryData=$image->plot(\@data)->png; |
print; |
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; |
|
|
|
|
|
#-------------------------------------------------------------------- |
|
|
|
sub grab{ |
|
my ($name,$default,$h) = @_; |
|
my $value = $h->{$name}; |
|
if (defined($value)) { |
|
delete ($h->{$name}) ; |
|
} else { |
|
$value = $default; |
|
} |
} |
return $value; |
} elsif ($output eq 'eps') { |
} |
print <<"END"; |
|
Content-type: text/html |
# transformPoint(x,y) where x,y are in the coordinates of axis will return |
|
# the coordinates transformed to the image coordinate system. |
<html><head><title>eps plot creation</title></head> |
sub transformPoint{ |
<body> |
my ($x,$y) = @_; |
<h2>Creating eps plot</h2> |
my ($width,$height) = $image->getBounds(); |
|
$x = ( $x - $axis->{"xmin"}) * $width / ( $axis->{"xlen"}); |
|
$y = ( ( $axis->{"ylen"} ) - ($y - $axis->{"ymin"})) |
|
* $height / ( $axis->{"ylen"} ); |
|
return($x,$y); |
|
} |
|
|
|
sub drawaxes{ |
|
($x1,$y1) = &transformPoint($axis->{"xmin"},0,$image,$axis); |
|
($x2,$y2) = &transformPoint($axis->{"xmax"},0,$image,$axis); |
|
$image->line($x1,$y1,$x2,$y2,$black); |
|
($x1,$y1) = &transformPoint(0,$axis->{"ymin"},$image,$axis); |
|
($x2,$y2) = &transformPoint(0,$axis->{"ymax"},$image,$axis); |
|
$image->line($x1,$y1,$x2,$y2,$black); |
|
} |
|
|
|
sub drawtics{ |
END |
my ($htic_every,$vtic_every) = @_; |
if (! system ("gnuplot $filename")) { |
my ($width,$height) = $image->getBounds(); |
print "<h2>An error occured.</h2>\n". |
|
"I am not going to tell you about it as I have not bothered ". |
$ticwidth = ($width > 99 ? 10 : int($width /10) + 1); |
"to figure out how to get you the error text.\n"; |
$ticheight = ($height > 99 ? 10 : int($height/10)); |
} else { |
|
print "<h2>EPS file generated successfully.</h2>\n"; |
# Do tics along y-axis |
|
for ($ntic = 0; $ntic <=int($axis->{"ylen"}/$vtic_every); $ntic++){ |
|
my ($x1,$y1) = &transformPoint(0,$axis->{"ymin"}+$ntic*$vtic_every); |
|
my ($x2,$y2) = &transformPoint(0,$axis->{"ymin"}+$ntic*$vtic_every); |
|
$x1 -= $ticwidth; |
|
$x2 += $ticwidth; |
|
$image->line($x1,$y1,$x2,$y2,$black); |
|
} |
|
# Do tics along x-axis |
|
for ($ntic = 0; $ntic <=int($axis->{"xlen"}/$htic_every); $ntic++){ |
|
my ($x1,$y1) = &transformPoint( $axis->{"xmin"}+$ntic*$htic_every,0); |
|
my ($x2,$y2) = &transformPoint( $axis->{"xmin"}+$ntic*$htic_every,0); |
|
$y1 -= $ticheight; |
|
$y2 += $ticheight; |
|
$image->line($x1,$y1,$x2,$y2,$black); |
|
} |
|
} |
|
|
|
sub drawcurve{ |
|
my ($X,$Y) = @_; |
|
for($i=0;$i< (@$X-1);$i++) { |
|
($x1,$y1) = &transformPoint($X->[$i ],$Y->[$i ]); |
|
($x2,$y2) = &transformPoint($X->[$i+1],$Y->[$i+1]); |
|
$image->line($x1,$y1,$x2,$y2,$black); |
|
} |
|
} |
|
|
|
sub frame{ |
|
# Draw a frame around the picture. |
|
my ($xoffset,$yoffset) = @_; |
|
$xoffset = $xoffset || 1; |
|
$yoffset = $yoffset || $xoffset; |
|
my ($width,$height) = $image->getBounds(); |
|
$image->rectangle($xoffset-1,$yoffset-1,$width-$xoffset,$height-$yoffset,$black); |
|
} |
|
|
|
sub drawstring{ |
|
# Write some text on the image. |
|
my ($text,$x,$y,$color,$fontName) = @_; |
|
$font = gdGiantFont if (lc($fontName) eq "giant" || |
|
lc($fontName) eq "huge" ); |
|
$font = gdLargeFont if (lc($fontName) eq "large"); |
|
$font = gdMediumBoldFont if (lc($fontName) eq "medium"); |
|
$font = gdSmallFont if (lc($fontName) eq "small"); |
|
$font = gdTinyFont if (lc($fontName) eq "tiny"); |
|
if (! defined($font)) { |
|
$font = gdGiantFont; |
|
$text = "Font size error!"; |
|
} |
} |
($x,$y) = &transformPoint($x,$y); |
print "</body></html>\n"; |
$image->string($font,$x,$y,$text,$color); |
} else { |
|
die "output $output is not a recognized value or has no value\n"; |
} |
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|