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

Diff for /loncom/cgi/plot.gif between versions 1.3 and 1.9

version 1.3, 2001/12/11 13:47:36 version 1.9, 2002/03/01 14:03:50
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/
 #  #
 ###########################################################################  use strict;
 #  
 # 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  
 #  
 ###########################################################################  
 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($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);  
     }  
 }  
   
   my $tmpdir = '/home/httpd/perl/tmp/';
 # Tell the browser our mime-type  my %data;
 print <<END;  foreach (split/&/,$ENV{'QUERY_STRING'}) {
       my ($name,$value)=split/=/;
       $data{$name}=$value;
   }
   my $filename = $data{'file'};
   # unescape filename
   $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 'gif') {
       open PLOT, "gnuplot $filename |";
       print <<"END";
 Content-type: image/gif  Content-type: image/gif
   
 END  END
       while ($_=<PLOT>) {
 my $BinaryData=$image->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') {
       system ("gnuplot $filename");
   } else {
       die "output $output is not a recognized value or has no value\n";
 }  }
   
 # 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);  
 }  
   
 sub drawaxes{  
     ($x1,$y1) = &transformPoint($axis->{"xmin"},0,$image,$axis);  
     ($x2,$y2) = &transformPoint($axis->{"xmax"},0,$image,$axis);  
     $image->line($x1,$y1,$x2,$y2,$fgcolor);  
     ($x1,$y1) = &transformPoint(0,$axis->{"ymin"},$image,$axis);  
     ($x2,$y2) = &transformPoint(0,$axis->{"ymax"},$image,$axis);  
     $image->line($x1,$y1,$x2,$y2,$fgcolor);  
 }  
   
 sub drawtics{  
     my ($htic_every,$vtic_every) = @_;  
     my ($width,$height) = $image->getBounds();  
       
     $ticwidth  = ($width  > 99 ? 5 : int($width /20) + 1);  
     $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,$fgcolor);  
     }  
     # 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,$fgcolor);  
     }  
 }  
   
 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,$fgcolor);  
     }  
 }  
   
 sub drawframe{  
     # 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,$fgcolor);  
 }  
   
 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);  
     $image->string($font,$x,$y,$text,$color);  
 }  
   
   
   
   
   
   
   
   
Removed from v.1.3  
changed lines
  Added in v.1.9

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