[BACK]Return to plot.gif CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / cgi

Diff for /loncom/cgi/plot.gif between versions 1.4 and 1.5

version 1.4, 2001/12/12 18:36:44 version 1.5, 2001/12/20 22:36:15
Line 1 Line 1
 #!/usr/bin/perl -w  #!/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.  
 #  
 # 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 <<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;  
 }  
   
 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);  use strict;
     my $bgcolor = $image->colorAllocate(split/,/,$PlotHeader->{'bgcolor'});  my $output;
     my $fgcolor = $image->colorAllocate(split/,/,$PlotHeader->{'fgcolor'});  my $tmpdir = '/home/httpd/perl/tmp/';
     $image->transparent($bgcolor) if ($PlotHeader->{'transparent'} eq 'true');  my $filename = $tmpdir . $ENV{'QUERY_STRING'};
       
     $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);  
     }  
 }  
   
 #------------------------------------------------------- misc plotting routines  $output =<<"END";
 sub draw_frame {  Content-type: text/html
     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);  
 }  
   
 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{  END
     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);  
 }  
   
 sub draw_circle {  if (0) {
     my $Circle = shift;  $output =<<"END";
     my ($width,$height) = $image->getBounds();  Content-type: image/gif
     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)  END
 #  $output .= `gnuplot $filename`;
 # 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);  
 }  }
   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};  
     }  
  }  
     }  
 }  
       
   
   
Removed from v.1.4  
changed lines
  Added in v.1.5

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>