--- loncom/cgi/plot.gif 2001/12/12 18:36:44 1.4 +++ loncom/cgi/plot.gif 2001/12/20 22:36:15 1.5 @@ -1,6 +1,6 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # -# $Id: plot.gif,v 1.4 2001/12/12 18:36:44 matthew Exp $ +# $Id: plot.gif,v 1.5 2001/12/20 22:36:15 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -24,424 +24,27 @@ # # http://www.lon-capa.org/ # -########################################################################### -# -# CGI-BIN interface to GD, used for making mathematical plots. -# -# User specifies the following variables (given are defaults): -# height = "100" -# width = "100" -# xmin = "-10.0" -# xmax = " 10.0" -# ymin = "-10.0" -# ymax = " 10.0" -# transparent (doesn't work with gif?) -# 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 -# -########################################################################### -## -## 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; - -my ($image,$axis); -$filename = shift; -# GET FILENAME AND OPEN THE FILE, BAIL OUT IF UNABLE TO DO SO -$fh = new FileHandle("<$filename"); -my @Segments = &read_file($fh); - -foreach $segment (@Segments) { - &set_defaults($segment); -} -&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(); - -#---------------------------------------------------- convenience functions -sub write_image { - # Tell the browser our mime-type -# print <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; -} - -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); - } -} - -sub get_specific_segment { - $_ = shift; - my @Segments = @$_; - my $type = shift; - for ($i = 0; $i<=$#Segments; $i++) { - if ($Segments[$i]->{'type'} eq $type) { - 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 read_segment{ - # Reads in a segment of a plotting file. - # Returns 1,\%Data on success (or parital success) - # Returns 0, undef on failure; - $fh = shift; - my $Data = newhash(); - - $_ = <$fh>; - if (! /^NEW /) { - return undef; - } - - while($_=<$fh>) { - last if (/^END /); - # Lines are of the form "type::var=value", "NEW type", or "END type" - chomp; - return(0,undef) if (/^NEW /); - if (/(\w+)::(\w+)[\s]*=\s*\"([\w\s,\-\+\.]+)\"/) { - $Data->{'type'} = $1 if (!exists ($Data->{'type'})); - return(0,$Data) if ($Data->{'type'} ne $1); - $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(); - } -} - -#-------------------------------------------------------- axis routines -sub draw_axes{ - my $color = $image->colorResolve(split /,/,$axis->{'color'}); - ($x1,$y1) = &transformPoint($axis->{"xmin"},0,$image,$axis); - ($x2,$y2) = &transformPoint($axis->{"xmax"},0,$image,$axis); - $image->line($x1,$y1,$x2,$y2,$color); - ($x1,$y1) = &transformPoint(0,$axis->{"ymin"},$image,$axis); - ($x2,$y2) = &transformPoint(0,$axis->{"ymax"},$image,$axis); - $image->line($x1,$y1,$x2,$y2,$color); -} - -sub draw_tics{ - my $color = $image->colorResolve(split /,/, $axis->{'color'}); - my ($htic_every,$vtic_every) = ($axis->{'htic_every'}, $axis->{'vtic_every'}); - my ($width,$height) = $image->getBounds(); - - my $ticwidth = ($width > 99 ? 5 : int($width /20) + 1); - my $ticheight = ($height > 99 ? 5 : int($height/20) + 1); - - # 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,$color); - } - # 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,$color); - } -} +use strict; +my $output; +my $tmpdir = '/home/httpd/perl/tmp/'; +my $filename = $tmpdir . $ENV{'QUERY_STRING'}; -#------------------------------------------------------- misc plotting routines -sub draw_frame { - my $Frame = shift; - my ($width,$height) = $image->getBounds(); - my $color = $image->colorResolve(split /,/,$Frame->{'color'} ); - # 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 draw_line{ - my $Line = shift; - my $color = $image->colorResolve(split/,/, $Line->{'color'}); - my ($x1,$y1) = &transformPoint($Line->{'x1'},$Line->{'y1'}); - my ($x2,$y2) = &transformPoint($Line->{'x2'},$Line->{'y2'}); - $image->line($x1,$y1,$x2,$y2,$color); -} +$output =<<"END"; +Content-type: text/html -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 draw_label{ - my $Label = shift; - my $color = $image->colorResolve(split /,/, $Label->{'color'}); - my $fontname = $Label->{'font'}; - my $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" ); - my $text = $Label->{'text'}; - if (! defined($font)) { - $font = gdGiantFont; - $text = "Font size error!"; - } - my ($x,$y) = &transformPoint($Label->{'x'},$Label->{'y'}); - $image->string($font,$x,$y,$text,$color); -} +END -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'); -} +if (0) { +$output =<<"END"; +Content-type: image/gif -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); +END +$output .= `gnuplot $filename`; } +print $output; -#------------------------------------------ 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}; - } - } - } -} -