[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.4

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};
       }
    }
       }
   }
       
   
   
Removed from v.1.3  
changed lines
  Added in v.1.4

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