Annotation of loncom/cgi/plot.gif, revision 1.3

1.1       matthew     1: #!/usr/bin/perl 
                      2: #
1.3     ! matthew     3: # $Id: plot.gif,v 1.2 2001/12/10 15:45:54 matthew Exp $
1.1       matthew     4: #
                      5: # Copyright Michigan State University Board of Trustees
                      6: #
                      7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      8: #
                      9: # LON-CAPA is free software; you can redistribute it and/or modify
                     10: # it under the terms of the GNU General Public License as published by
                     11: # the Free Software Foundation; either version 2 of the License, or
                     12: # (at your option) any later version.
                     13: #
                     14: # LON-CAPA is distributed in the hope that it will be useful,
                     15: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     16: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     17: # GNU General Public License for more details.
                     18: #
                     19: # You should have received a copy of the GNU General Public License
                     20: # along with LON-CAPA; if not, write to the Free Software
                     21: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     22: #
                     23: # /home/httpd/cgi-bin/plot.gif
                     24: #
                     25: # http://www.lon-capa.org/
                     26: #
1.2       matthew    27: ###########################################################################
                     28: #
1.1       matthew    29: # CGI-BIN interface to GD, used for making mathematical plots.
                     30: #
                     31: # User specifies the following variables (given are defaults):
                     32: #    height   = "100"
                     33: #    width    = "100"
                     34: #    xmin     = "-10.0"
                     35: #    xmax     = " 10.0"
                     36: #    ymin     = "-10.0"
                     37: #    ymax     = " 10.0"
1.2       matthew    38: #    transparent   (doesn't work with gif?)
1.1       matthew    39: #    frame    
                     40: #    drawaxes 
                     41: #    drawtics 
                     42: #    vtic_every = "1.0"
                     43: #    htic_every = "1.0"
                     44: #    xseries1  = "x1,x2,x3,x4,x5,...,xn"
                     45: #    yseries1  = "y1,y2,y3,y4,y5,...,yn"
                     46: #    xseries2  = ..
                     47: #    yseries2  = ..
                     48: #    ...
                     49: #    label1 = "x,y,size,text"
                     50: #    label2 = "x,y,size,text"
                     51: #    label3 = "x,y,size,text"
                     52: #    ...
                     53: #
                     54: #    size of a labelN is one of :
                     55: #       giant, large, medium, small, tiny
                     56: #
1.2       matthew    57: ###########################################################################
1.1       matthew    58: use GD;
                     59: 
                     60: my @inputs = split(/&/,$ENV{'QUERY_STRING'});
                     61: foreach $input (@inputs) {
                     62:     ($var,$val) = split /\=/,$input,2;
                     63:     if (! defined($val)) {
                     64: 	$val = 1;
                     65:     }
                     66:     $In{lc($var)}=$val;
                     67: }
                     68: 
                     69: $height = &grab('height',100,\%In);
                     70: $width  = &grab('width',100,\%In);
                     71: $axis->{'xmin'} = &grab('xmin',-10,\%In);
                     72: $axis->{'xmax'} = &grab('xmax', 10,\%In);
                     73: $axis->{'ymin'} = &grab('ymin',-10,\%In);
                     74: $axis->{'ymax'} = &grab('ymax', 10,\%In);
                     75: $axis->{'xlen'} = $axis->{'xmax'} - $axis->{'xmin'};
                     76: $axis->{'ylen'} = $axis->{'ymax'} - $axis->{'ymin'};
                     77: $vtic_every = &grab('vtic_every',1.0,\%In);
                     78: $htic_every = &grab('htic_every',1.0,\%In);
                     79: 
1.2       matthew    80: my $image = new GD::Image($width,$height);
1.1       matthew    81: 
                     82: # allocate standard colors
1.3     ! matthew    83: my @BGvalues = split /,/,&grab('bgcolor','255,255,255',\%In);
        !            84: my @FGvalues = split /,/,&grab('fgcolor','0,0,0',\%In);
        !            85: my $bgcolor = $image->colorAllocate(@BGvalues);
        !            86: my $fgcolor = $image->colorAllocate(@FGvalues);       
1.1       matthew    87: 
1.3     ! matthew    88: # Draw a fgcolor frame around the picture
1.2       matthew    89: &drawtics($htic_every,$vtic_every) if (exists($In{'drawtics'}));
                     90: &drawaxes($axis)                   if (exists($In{'drawaxis'}));
                     91: &drawframe(1)                          if (exists($In{'frame'}));
                     92: # make the background transparent if needed (this doesn't work, at least
                     93: # not for gif images, don't know if it works for png)
1.3     ! matthew    94: $image->transparent($bgcolor)       if (exists($In{'transparent'}));
1.1       matthew    95: 
                     96: ## Take care of labels and data series
                     97: foreach (keys %In) {
                     98:     if (/^label/) {
                     99: 	my ($x,$y,$size,$text) = split/,/,$In{$_};
1.3     ! matthew   100: 	&drawstring($text,$x,$y,$fgcolor,$size);
1.1       matthew   101: 	delete ($In{$_});
                    102: 	next;
                    103:     } elsif (/^xseries/) {
                    104: 	$xname = $_;
                    105: 	$yname = $xname;
                    106: 	$yname =~ s/^x/y/;
                    107: 	(@X)=split/,/,$In{$xname};
                    108: 	(@Y)=split/,/,$In{$yname};
                    109: 	delete ($In{$xname});
                    110: 	delete ($In{$yname});	
                    111: 	if ($#X != $#Y) {
                    112: 	    &drawstring("size of $xname and $yname do not match",
1.3     ! matthew   113: 		       10,10,$fgcolor,"giant");
1.1       matthew   114: 	    next;
                    115: 	}
                    116: 	&drawcurve(\@X,\@Y);
                    117:     }
                    118: }
                    119: 
                    120: 
1.2       matthew   121: # Tell the browser our mime-type
1.1       matthew   122: print <<END;
1.2       matthew   123: Content-type: image/gif
1.1       matthew   124: 
                    125: END
                    126: 
1.2       matthew   127: my $BinaryData=$image->png;
1.1       matthew   128: undef $image;
                    129: binmode(STDOUT);
                    130: open IMG,"|pngtopnm|ppmtogif 2>/dev/null"; # convert into a gif image
                    131: print IMG $BinaryData; # output image
                    132: $|=1;                  # be sure to flush before closing
                    133: close IMG;
                    134: 
                    135: 
                    136: #--------------------------------------------------------------------
                    137: 
                    138: sub grab{
                    139:     my ($name,$default,$h) = @_;
                    140:     my $value = $h->{$name};
                    141:     if (defined($value)) {
                    142: 	delete ($h->{$name}) ;
                    143:     } else {
                    144: 	$value = $default;
                    145:     }
                    146:     return $value;
                    147: }
                    148: 
                    149: # transformPoint(x,y) where x,y are in the coordinates of axis will return
                    150: # the coordinates transformed to the image coordinate system.
                    151: sub transformPoint{
                    152:     my ($x,$y) = @_;
                    153:     my ($width,$height) = $image->getBounds();
                    154:     $x = ( $x - $axis->{"xmin"}) * $width / ( $axis->{"xlen"});
                    155:     $y = ( ( $axis->{"ylen"} ) - ($y - $axis->{"ymin"})) 
                    156: 	* $height / ( $axis->{"ylen"} );
                    157:     return($x,$y);
                    158: }
                    159: 
                    160: sub drawaxes{
                    161:     ($x1,$y1) = &transformPoint($axis->{"xmin"},0,$image,$axis);
                    162:     ($x2,$y2) = &transformPoint($axis->{"xmax"},0,$image,$axis);
1.3     ! matthew   163:     $image->line($x1,$y1,$x2,$y2,$fgcolor);
1.1       matthew   164:     ($x1,$y1) = &transformPoint(0,$axis->{"ymin"},$image,$axis);
                    165:     ($x2,$y2) = &transformPoint(0,$axis->{"ymax"},$image,$axis);
1.3     ! matthew   166:     $image->line($x1,$y1,$x2,$y2,$fgcolor);
1.1       matthew   167: }
                    168: 
                    169: sub drawtics{
                    170:     my ($htic_every,$vtic_every) = @_;
                    171:     my ($width,$height) = $image->getBounds();
                    172:     
1.2       matthew   173:     $ticwidth  = ($width  > 99 ? 5 : int($width /20) + 1);
                    174:     $ticheight = ($height > 99 ? 5 : int($height/20) + 1);
1.1       matthew   175: 
                    176:     # Do tics along y-axis
                    177:     for ($ntic = 0; $ntic <=int($axis->{"ylen"}/$vtic_every); $ntic++){
                    178: 	my ($x1,$y1) = &transformPoint(0,$axis->{"ymin"}+$ntic*$vtic_every);
                    179: 	my ($x2,$y2) = &transformPoint(0,$axis->{"ymin"}+$ntic*$vtic_every);
                    180: 	$x1 -= $ticwidth;
                    181: 	$x2 += $ticwidth;
1.3     ! matthew   182: 	$image->line($x1,$y1,$x2,$y2,$fgcolor);
1.1       matthew   183:     }
                    184:     # Do tics along x-axis
                    185:     for ($ntic = 0; $ntic <=int($axis->{"xlen"}/$htic_every); $ntic++){
                    186: 	my ($x1,$y1) = &transformPoint( $axis->{"xmin"}+$ntic*$htic_every,0);
                    187: 	my ($x2,$y2) = &transformPoint( $axis->{"xmin"}+$ntic*$htic_every,0);
                    188: 	$y1 -= $ticheight;
                    189: 	$y2 += $ticheight;
1.3     ! matthew   190: 	$image->line($x1,$y1,$x2,$y2,$fgcolor);
1.1       matthew   191:     }
                    192: }
                    193: 
                    194: sub drawcurve{
                    195:     my ($X,$Y) = @_;
                    196:     for($i=0;$i< (@$X-1);$i++) {
                    197: 	($x1,$y1) = &transformPoint($X->[$i  ],$Y->[$i  ]);
                    198: 	($x2,$y2) = &transformPoint($X->[$i+1],$Y->[$i+1]);
1.3     ! matthew   199: 	$image->line($x1,$y1,$x2,$y2,$fgcolor);
1.1       matthew   200:     }
                    201: }
                    202: 
1.2       matthew   203: sub drawframe{
1.1       matthew   204:     # Draw a frame around the picture.
                    205:     my ($xoffset,$yoffset) = @_;
                    206:     $xoffset = $xoffset || 1;
                    207:     $yoffset = $yoffset || $xoffset;
                    208:     my ($width,$height) = $image->getBounds();
1.3     ! matthew   209:     $image->rectangle($xoffset-1,$yoffset-1,$width-$xoffset,$height-$yoffset,$fgcolor);
1.1       matthew   210: }
                    211: 
                    212: sub drawstring{
                    213:     # Write some text on the image.
                    214:     my ($text,$x,$y,$color,$fontName) = @_;
                    215:     $font = gdGiantFont      if (lc($fontName) eq "giant" ||
                    216: 				 lc($fontName) eq "huge"     );
                    217:     $font = gdLargeFont      if (lc($fontName) eq "large");
                    218:     $font = gdMediumBoldFont if (lc($fontName) eq "medium");
                    219:     $font = gdSmallFont      if (lc($fontName) eq "small");
                    220:     $font = gdTinyFont       if (lc($fontName) eq "tiny");
                    221:     if (! defined($font)) {
                    222: 	$font = gdGiantFont;
                    223: 	$text = "Font size error!";
                    224:     }
                    225:     ($x,$y) = &transformPoint($x,$y);
                    226:     $image->string($font,$x,$y,$text,$color);
                    227: }
                    228: 
                    229: 
                    230: 
                    231: 
                    232: 
                    233: 
                    234: 
                    235: 

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