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>