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>