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

1.1       matthew     1: #!/usr/bin/perl 
                      2: #
1.2     ! matthew     3: # $Id: plot.gif,v 1.1 2001/12/07 22:52:38 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
                     83: my $white = $image->colorAllocate(255,255,255);
                     84: my $black = $image->colorAllocate(  0,  0,  0);       
                     85: 
                     86: # Draw a black frame around the picture
1.2     ! matthew    87: &drawtics($htic_every,$vtic_every) if (exists($In{'drawtics'}));
        !            88: &drawaxes($axis)                   if (exists($In{'drawaxis'}));
        !            89: &drawframe(1)                          if (exists($In{'frame'}));
        !            90: # make the background transparent if needed (this doesn't work, at least
        !            91: # not for gif images, don't know if it works for png)
        !            92: $image->transparent($white)       if (exists($In{'transparent'}));
1.1       matthew    93: 
                     94: ## Take care of labels and data series
                     95: foreach (keys %In) {
                     96:     if (/^label/) {
                     97: 	my ($x,$y,$size,$text) = split/,/,$In{$_};
                     98: 	&drawstring($text,$x,$y,$black,$size);
                     99: 	delete ($In{$_});
                    100: 	next;
                    101:     } elsif (/^xseries/) {
                    102: 	$xname = $_;
                    103: 	$yname = $xname;
                    104: 	$yname =~ s/^x/y/;
                    105: 	(@X)=split/,/,$In{$xname};
                    106: 	(@Y)=split/,/,$In{$yname};
                    107: 	delete ($In{$xname});
                    108: 	delete ($In{$yname});	
                    109: 	if ($#X != $#Y) {
                    110: 	    &drawstring("size of $xname and $yname do not match",
                    111: 		       10,10,$black,"giant");
                    112: 	    next;
                    113: 	}
                    114: 	&drawcurve(\@X,\@Y);
                    115:     }
                    116: }
                    117: 
                    118: 
1.2     ! matthew   119: # Tell the browser our mime-type
1.1       matthew   120: print <<END;
1.2     ! matthew   121: Content-type: image/gif
1.1       matthew   122: 
                    123: END
                    124: 
1.2     ! matthew   125: my $BinaryData=$image->png;
1.1       matthew   126: undef $image;
                    127: binmode(STDOUT);
                    128: open IMG,"|pngtopnm|ppmtogif 2>/dev/null"; # convert into a gif image
                    129: print IMG $BinaryData; # output image
                    130: $|=1;                  # be sure to flush before closing
                    131: close IMG;
                    132: 
                    133: 
                    134: #--------------------------------------------------------------------
                    135: 
                    136: sub grab{
                    137:     my ($name,$default,$h) = @_;
                    138:     my $value = $h->{$name};
                    139:     if (defined($value)) {
                    140: 	delete ($h->{$name}) ;
                    141:     } else {
                    142: 	$value = $default;
                    143:     }
                    144:     return $value;
                    145: }
                    146: 
                    147: # transformPoint(x,y) where x,y are in the coordinates of axis will return
                    148: # the coordinates transformed to the image coordinate system.
                    149: sub transformPoint{
                    150:     my ($x,$y) = @_;
                    151:     my ($width,$height) = $image->getBounds();
                    152:     $x = ( $x - $axis->{"xmin"}) * $width / ( $axis->{"xlen"});
                    153:     $y = ( ( $axis->{"ylen"} ) - ($y - $axis->{"ymin"})) 
                    154: 	* $height / ( $axis->{"ylen"} );
                    155:     return($x,$y);
                    156: }
                    157: 
                    158: sub drawaxes{
                    159:     ($x1,$y1) = &transformPoint($axis->{"xmin"},0,$image,$axis);
                    160:     ($x2,$y2) = &transformPoint($axis->{"xmax"},0,$image,$axis);
                    161:     $image->line($x1,$y1,$x2,$y2,$black);
                    162:     ($x1,$y1) = &transformPoint(0,$axis->{"ymin"},$image,$axis);
                    163:     ($x2,$y2) = &transformPoint(0,$axis->{"ymax"},$image,$axis);
                    164:     $image->line($x1,$y1,$x2,$y2,$black);
                    165: }
                    166: 
                    167: sub drawtics{
                    168:     my ($htic_every,$vtic_every) = @_;
                    169:     my ($width,$height) = $image->getBounds();
                    170:     
1.2     ! matthew   171:     $ticwidth  = ($width  > 99 ? 5 : int($width /20) + 1);
        !           172:     $ticheight = ($height > 99 ? 5 : int($height/20) + 1);
1.1       matthew   173: 
                    174:     # Do tics along y-axis
                    175:     for ($ntic = 0; $ntic <=int($axis->{"ylen"}/$vtic_every); $ntic++){
                    176: 	my ($x1,$y1) = &transformPoint(0,$axis->{"ymin"}+$ntic*$vtic_every);
                    177: 	my ($x2,$y2) = &transformPoint(0,$axis->{"ymin"}+$ntic*$vtic_every);
                    178: 	$x1 -= $ticwidth;
                    179: 	$x2 += $ticwidth;
                    180: 	$image->line($x1,$y1,$x2,$y2,$black);
                    181:     }
                    182:     # Do tics along x-axis
                    183:     for ($ntic = 0; $ntic <=int($axis->{"xlen"}/$htic_every); $ntic++){
                    184: 	my ($x1,$y1) = &transformPoint( $axis->{"xmin"}+$ntic*$htic_every,0);
                    185: 	my ($x2,$y2) = &transformPoint( $axis->{"xmin"}+$ntic*$htic_every,0);
                    186: 	$y1 -= $ticheight;
                    187: 	$y2 += $ticheight;
                    188: 	$image->line($x1,$y1,$x2,$y2,$black);
                    189:     }
                    190: }
                    191: 
                    192: sub drawcurve{
                    193:     my ($X,$Y) = @_;
                    194:     for($i=0;$i< (@$X-1);$i++) {
                    195: 	($x1,$y1) = &transformPoint($X->[$i  ],$Y->[$i  ]);
                    196: 	($x2,$y2) = &transformPoint($X->[$i+1],$Y->[$i+1]);
                    197: 	$image->line($x1,$y1,$x2,$y2,$black);
                    198:     }
                    199: }
                    200: 
1.2     ! matthew   201: sub drawframe{
1.1       matthew   202:     # Draw a frame around the picture.
                    203:     my ($xoffset,$yoffset) = @_;
                    204:     $xoffset = $xoffset || 1;
                    205:     $yoffset = $yoffset || $xoffset;
                    206:     my ($width,$height) = $image->getBounds();
                    207:     $image->rectangle($xoffset-1,$yoffset-1,$width-$xoffset,$height-$yoffset,$black);
                    208: }
                    209: 
                    210: sub drawstring{
                    211:     # Write some text on the image.
                    212:     my ($text,$x,$y,$color,$fontName) = @_;
                    213:     $font = gdGiantFont      if (lc($fontName) eq "giant" ||
                    214: 				 lc($fontName) eq "huge"     );
                    215:     $font = gdLargeFont      if (lc($fontName) eq "large");
                    216:     $font = gdMediumBoldFont if (lc($fontName) eq "medium");
                    217:     $font = gdSmallFont      if (lc($fontName) eq "small");
                    218:     $font = gdTinyFont       if (lc($fontName) eq "tiny");
                    219:     if (! defined($font)) {
                    220: 	$font = gdGiantFont;
                    221: 	$text = "Font size error!";
                    222:     }
                    223:     ($x,$y) = &transformPoint($x,$y);
                    224:     $image->string($font,$x,$y,$text,$color);
                    225: }
                    226: 
                    227: 
                    228: 
                    229: 
                    230: 
                    231: 
                    232: 
                    233: 

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