Annotation of loncom/cgi/plot.gif, revision 1.4
1.4 ! matthew 1: #!/usr/bin/perl -w
1.1 matthew 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.4 ! matthew 58: ##
! 59: ## Data structures & file description
! 60: ##
! 61: ## The input file is taken to be comprised of "segments". Each "segment"
! 62: ## will hold data for the plot header, the coordinate axes, or (more likely)
! 63: ## the curves, circles, and polygons that are to be plotted.
! 64: ##
! 65: ## The global array @Segments holds references to hashes which contain the
! 66: ## data needed for each structure.
! 67: ##
! 68: use FileHandle;
1.1 matthew 69: use GD;
70:
1.4 ! matthew 71: my ($image,$axis);
! 72: $filename = shift;
! 73: # GET FILENAME AND OPEN THE FILE, BAIL OUT IF UNABLE TO DO SO
! 74: $fh = new FileHandle("<$filename");
! 75: my @Segments = &read_file($fh);
! 76:
! 77: foreach $segment (@Segments) {
! 78: &set_defaults($segment);
! 79: }
! 80: &init_image(&get_specific_segment(\@Segments,'plotheader'),
! 81: &get_specific_segment(\@Segments,'axis'));
! 82:
! 83: for (my $i =0; $i<=$#Segments; $i++) {
! 84: grok_segment($Segments[$i]);
1.1 matthew 85: }
1.4 ! matthew 86: &write_image();
1.1 matthew 87:
1.4 ! matthew 88: #---------------------------------------------------- convenience functions
! 89: sub write_image {
! 90: # Tell the browser our mime-type
! 91: # print <<END;
! 92: #Content-type: image/gif
! 93: #
! 94: #END
! 95: my $BinaryData=$image->png;
! 96: undef $image;
! 97: binmode(STDOUT);
! 98: open IMG,"|pngtopnm|ppmtogif 2>/dev/null"; # convert into a gif image
! 99: print IMG $BinaryData; # output image
! 100: $|=1; # be sure to flush before closing
! 101: close IMG;
! 102: }
1.1 matthew 103:
1.4 ! matthew 104: sub grok_segment {
! 105: $_ = shift;
! 106: my %Data = %$_;
! 107: $type = $Data{'type'};
! 108: if (!defined($type)) {
! 109: return undef;
! 110: } elsif ($type eq 'frame') {
! 111: draw_frame(\%Data);
! 112: } elsif ($type eq 'curve') {
! 113: draw_curve(\%Data);
! 114: } elsif ($type eq 'label') {
! 115: draw_label(\%Data);
! 116: } elsif ($type eq 'circle') {
! 117: draw_circle(\%Data);
! 118: } elsif ($type eq 'polygon') {
! 119: draw_polygon(\%Data);
! 120: } elsif ($type eq 'line') {
! 121: draw_line(\%Data);
! 122: }
! 123: }
1.1 matthew 124:
1.4 ! matthew 125: sub get_specific_segment {
! 126: $_ = shift;
! 127: my @Segments = @$_;
! 128: my $type = shift;
! 129: for ($i = 0; $i<=$#Segments; $i++) {
! 130: if ($Segments[$i]->{'type'} eq $type) {
! 131: return (splice @Segments, $i,1);
! 132: }
! 133: }
! 134: return undef;
! 135: }
1.1 matthew 136:
1.4 ! matthew 137: #---------------------------------------------------- plot description reading
! 138: sub read_file {
! 139: my @Returned_Segments;
! 140: my $fh = shift;
! 141: ($ret,$ref) = read_segment($fh);
! 142: while (defined($ret) && $ret !=0) {
! 143: push @Returned_Segments,$ref;
! 144: ($ret,$ref) = read_segment($fh);
! 145: }
! 146: return @Returned_Segments;
! 147: }
1.1 matthew 148:
1.4 ! matthew 149: sub newhash{
! 150: my %H;
! 151: return \%H;
! 152: }
1.1 matthew 153:
1.4 ! matthew 154: sub read_segment{
! 155: # Reads in a segment of a plotting file.
! 156: # Returns 1,\%Data on success (or parital success)
! 157: # Returns 0, undef on failure;
! 158: $fh = shift;
! 159: my $Data = newhash();
! 160:
! 161: $_ = <$fh>;
! 162: if (! /^NEW /) {
! 163: return undef;
! 164: }
1.1 matthew 165:
1.4 ! matthew 166: while($_=<$fh>) {
! 167: last if (/^END /);
! 168: # Lines are of the form "type::var=value", "NEW type", or "END type"
! 169: chomp;
! 170: return(0,undef) if (/^NEW /);
! 171: if (/(\w+)::(\w+)[\s]*=\s*\"([\w\s,\-\+\.]+)\"/) {
! 172: $Data->{'type'} = $1 if (!exists ($Data->{'type'}));
! 173: return(0,$Data) if ($Data->{'type'} ne $1);
! 174: $Data->{$2} = $3;
! 175: } else {
! 176: # Something went wrong - bad input - what to do?
! 177: }
1.1 matthew 178: }
1.4 ! matthew 179: return (1,$Data);
! 180: }
1.1 matthew 181:
1.4 ! matthew 182: #-------------------------------------------------------
! 183: sub init_image {
! 184: my $PlotHeader = shift;
! 185: $axis = shift;
! 186: # Take care of making the image
! 187: my ($width,$height) = ($PlotHeader->{'width'},$PlotHeader->{'height'});
! 188:
! 189: $image = new GD::Image($width,$height);
! 190: my $bgcolor = $image->colorAllocate(split/,/,$PlotHeader->{'bgcolor'});
! 191: my $fgcolor = $image->colorAllocate(split/,/,$PlotHeader->{'fgcolor'});
! 192: $image->transparent($bgcolor) if ($PlotHeader->{'transparent'} eq 'true');
! 193:
! 194: $axis->{'xlen'} = $axis->{'xmax'} - $axis->{'xmin'};
! 195: $axis->{'ylen'} = $axis->{'ymax'} - $axis->{'ymin'};
! 196: if ($axis->{'drawaxis'} eq 'true') {
! 197: &draw_axes();
! 198: }
! 199: if ($axis->{'drawtics'} eq 'true') {
! 200: &draw_tics();
! 201: }
1.1 matthew 202: }
203:
1.4 ! matthew 204: #-------------------------------------------------------- axis routines
! 205: sub draw_axes{
! 206: my $color = $image->colorResolve(split /,/,$axis->{'color'});
1.1 matthew 207: ($x1,$y1) = &transformPoint($axis->{"xmin"},0,$image,$axis);
208: ($x2,$y2) = &transformPoint($axis->{"xmax"},0,$image,$axis);
1.4 ! matthew 209: $image->line($x1,$y1,$x2,$y2,$color);
1.1 matthew 210: ($x1,$y1) = &transformPoint(0,$axis->{"ymin"},$image,$axis);
211: ($x2,$y2) = &transformPoint(0,$axis->{"ymax"},$image,$axis);
1.4 ! matthew 212: $image->line($x1,$y1,$x2,$y2,$color);
1.1 matthew 213: }
214:
1.4 ! matthew 215: sub draw_tics{
! 216: my $color = $image->colorResolve(split /,/, $axis->{'color'});
! 217: my ($htic_every,$vtic_every) = ($axis->{'htic_every'}, $axis->{'vtic_every'});
1.1 matthew 218: my ($width,$height) = $image->getBounds();
219:
1.4 ! matthew 220: my $ticwidth = ($width > 99 ? 5 : int($width /20) + 1);
! 221: my $ticheight = ($height > 99 ? 5 : int($height/20) + 1);
1.1 matthew 222:
223: # Do tics along y-axis
224: for ($ntic = 0; $ntic <=int($axis->{"ylen"}/$vtic_every); $ntic++){
225: my ($x1,$y1) = &transformPoint(0,$axis->{"ymin"}+$ntic*$vtic_every);
226: my ($x2,$y2) = &transformPoint(0,$axis->{"ymin"}+$ntic*$vtic_every);
227: $x1 -= $ticwidth;
228: $x2 += $ticwidth;
1.4 ! matthew 229: $image->line($x1,$y1,$x2,$y2,$color);
1.1 matthew 230: }
231: # Do tics along x-axis
232: for ($ntic = 0; $ntic <=int($axis->{"xlen"}/$htic_every); $ntic++){
233: my ($x1,$y1) = &transformPoint( $axis->{"xmin"}+$ntic*$htic_every,0);
234: my ($x2,$y2) = &transformPoint( $axis->{"xmin"}+$ntic*$htic_every,0);
235: $y1 -= $ticheight;
236: $y2 += $ticheight;
1.4 ! matthew 237: $image->line($x1,$y1,$x2,$y2,$color);
1.1 matthew 238: }
239: }
240:
1.4 ! matthew 241: #------------------------------------------------------- misc plotting routines
! 242: sub draw_frame {
! 243: my $Frame = shift;
! 244: my ($width,$height) = $image->getBounds();
! 245: my $color = $image->colorResolve(split /,/,$Frame->{'color'} );
! 246: # Draw a frame around the picture.
! 247: my $offset = $Frame->{'offset'};
! 248: for (my $i = 0; $i<=$Frame->{'thickness'}; $i++) {
! 249: $image->rectangle(
! 250: $offset - 1,
! 251: $offset - 1,
! 252: $width-$offset,
! 253: $height-$offset,
! 254: $color);
1.1 matthew 255: }
256: }
257:
1.4 ! matthew 258: sub draw_line{
! 259: my $Line = shift;
! 260: my $color = $image->colorResolve(split/,/, $Line->{'color'});
! 261: my ($x1,$y1) = &transformPoint($Line->{'x1'},$Line->{'y1'});
! 262: my ($x2,$y2) = &transformPoint($Line->{'x2'},$Line->{'y2'});
! 263: $image->line($x1,$y1,$x2,$y2,$color);
! 264: }
! 265:
! 266: sub draw_curve{
! 267: my $Curve = shift;
! 268: my $color = $image->colorResolve(split /,/, $Curve->{'color'});
! 269: @X = split /,/,$Curve->{'xdata'};
! 270: @Y = split /,/,$Curve->{'ydata'};
! 271: if ($#X != $#Y) {
! 272: return 0;
! 273: }
! 274: for($i=0;$i< $#X ;$i++) {
! 275: my ($x1,$y1) = &transformPoint($X[$i] ,$Y[$i]);
! 276: my ($x2,$y2) = &transformPoint($X[$i+1],$Y[$i+1]);
! 277: $image->line($x1,$y1,$x2,$y2,$color);
! 278: }
1.1 matthew 279: }
280:
1.4 ! matthew 281: sub draw_label{
! 282: my $Label = shift;
! 283: my $color = $image->colorResolve(split /,/, $Label->{'color'});
! 284: my $fontname = $Label->{'font'};
! 285: my $font = gdGiantFont if (lc($fontname) eq "giant" ||
! 286: lc($fontname) eq "huge" );
! 287: $font = gdLargeFont if (lc($fontname) eq "large" );
! 288: $font = gdMediumBoldFont if (lc($fontname) eq "medium");
! 289: $font = gdSmallFont if (lc($fontname) eq "small" );
! 290: $font = gdTinyFont if (lc($fontname) eq "tiny" );
! 291: my $text = $Label->{'text'};
1.1 matthew 292: if (! defined($font)) {
293: $font = gdGiantFont;
294: $text = "Font size error!";
295: }
1.4 ! matthew 296: my ($x,$y) = &transformPoint($Label->{'x'},$Label->{'y'});
1.1 matthew 297: $image->string($font,$x,$y,$text,$color);
298: }
299:
1.4 ! matthew 300: sub draw_circle {
! 301: my $Circle = shift;
! 302: my ($width,$height) = $image->getBounds();
! 303: my $color = $image->colorResolve(split /,/, $Circle->{'color'});
! 304: my ($x,$y) = &transformPoint(split/,/,$Circle->{'center'});
! 305: my $xradius = $Circle->{'radius'} * $width / $axis->{'xlen'};
! 306: my $yradius = $Circle->{'radius'} * $height / $axis->{'ylen'};
! 307: # draw a semicircle centered at 100,100
! 308: $image->arc($x,$y,$xradius,$yradius,0,360,$color);
! 309: $image->fill($x,$y,$color) if ($Circle->{'filled'} eq 'true');
! 310: }
1.1 matthew 311:
1.4 ! matthew 312: sub draw_polygon {
! 313: my $Poly = shift;
! 314: my $color = $image->colorResolve(split /,/, $Poly->{'color'});
! 315: @X = split /,/,$Poly->{'xdata'};
! 316: @Y = split /,/,$Poly->{'ydata'};
! 317: if ($#X != $#Y) {
! 318: return 0;
! 319: }
! 320: my $poly = new GD::Polygon;
! 321: for ($i=0;$i<=$#X;$i++) {
! 322: $poly->addPt(&transformPoint($X[$i],$Y[$i]));
! 323: }
! 324: if ($Poly->{'filled'} eq 'true') {
! 325: $image->filledPolygon($poly,$color);
! 326: } else {
! 327: $image->polygon($poly,$color);
! 328: }
! 329: }
1.1 matthew 330:
1.4 ! matthew 331: #------------------------------------------ transform point (basic routine)
! 332: #
! 333: # transformPoint(x,y) where x,y are in the coordinates of axis will return
! 334: # the coordinates transformed to the image coordinate system.
! 335: sub transformPoint{
! 336: my ($x,$y) = @_;
! 337: my ($width,$height) = $image->getBounds();
! 338: $x = ( $x - $axis->{"xmin"}) * $width / ( $axis->{"xlen"});
! 339: $y = ( ( $axis->{"ylen"} ) - ($y - $axis->{"ymin"}))
! 340: * $height / ( $axis->{"ylen"} );
! 341: return($x,$y);
! 342: }
1.1 matthew 343:
1.4 ! matthew 344: #------------------------------------------ set defaults is a beast!
1.1 matthew 345:
1.4 ! matthew 346: sub set_defaults {
! 347: my $PlotHeader = {
! 348: type => "plotheader",
! 349: name => "plot",
! 350: height => "200",
! 351: width => "300",
! 352: bgcolor => "255,255,255",
! 353: fgcolor => " 0, 0, 0",
! 354: transparent => "true"
! 355: };
! 356:
! 357: my $Axis = {
! 358: type => "axis",
! 359: name => "axis",
! 360: color => " 0, 0, 0",
! 361: drawtics => "true",
! 362: vtic_every => " 1.0",
! 363: htic_every => " 1.0",
! 364: xmin => "-10.0",
! 365: ymin => " -5.0",
! 366: xmax => " 10.0",
! 367: ymax => " 5.0",
! 368: drawaxis => "true"
! 369: };
! 370:
! 371: my $Frame = {
! 372: type => "frame",
! 373: color => " 0, 0, 0",
! 374: offset => "1.0",
! 375: thickness => "1.0",
! 376: drawframe => "true"
! 377: };
! 378:
! 379: my $Curve= {
! 380: type => "curve",
! 381: name => "curve",
! 382: color => " 0, 0, 0",
! 383: xdata => " 1.0, 2.0, 3.0, 4.0, 5.0, 6.0",
! 384: ydata => " 1.0, 2.0, 3.0, 4.0, 5.0, 6.0"
! 385: };
! 386:
! 387: my $Label = {
! 388: type => "label",
! 389: name => "label",
! 390: font => "medium",
! 391: text => "default label text",
! 392: color => " 0, 0, 0",
! 393: x => " -5.0",
! 394: y => " 5.0"
! 395: };
! 396:
! 397: my $Circle = {
! 398: type => "circle",
! 399: name => "circle",
! 400: color => " 0, 0, 0",
! 401: filled => "true",
! 402: center => "x,y",
! 403: radius => "12.0"
! 404: };
! 405:
! 406: my $Polygon = {
! 407: type => "polygon",
! 408: name => "polygon",
! 409: color => " 0, 0, 0",
! 410: filled => "true",
! 411: xdata => "1.0, 0.5, 0.0, -0,5, -1.0, -0.5, 0.0, 0.5",
! 412: ydata => "0.0,-0.5,-1.0, -0.5, 0.0, 0.5, 1.0, 0.5"
! 413: };
! 414:
! 415: my $Line = {
! 416: type => "line",
! 417: name => "line",
! 418: color => " 0, 0, 0",
! 419: x1 => "1.0",
! 420: y1 => "0.0",
! 421: x2 => "2.0",
! 422: y2 => "4.0"
! 423: };
! 424:
! 425: my $typematch = {
! 426: plotheader => $PlotHeader,
! 427: axis => $Axis,
! 428: frame => $Frame,
! 429: label => $Label,
! 430: curve => $Curve,
! 431: circle => $Circle,
! 432: polygon => $Polygon
! 433: };
! 434:
! 435: my $seg = shift;
! 436: if (exists($typematch->{$seg->{'type'}})) {
! 437: my $H = $typematch->{$seg->{'type'}};
! 438: foreach $key (keys %$H) {
! 439: if (! exists($seg->{$key})) {
! 440: $seg->{$key} = $H->{$key};
! 441: }
! 442: }
! 443: }
! 444: }
! 445:
1.1 matthew 446:
447:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](./plot.gif?sortby=author#rev1.4){kind=small}
Return to plot.gif CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / cgi