############################################################################## # The Faq-O-Matic is Copyright 1997 by Jon Howell, all rights reserved. # # # # This program is free software; you can redistribute it and/or # # modify it under the terms of the GNU General Public License # # as published by the Free Software Foundation; either version 2 # # of the License, or (at your option) any later version. # # # # This program is distributed in the hope that it will be useful, # # but WITHOUT ANY WARRANTY; without even the implied warranty of # # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # # GNU General Public License for more details. # # # # You should have received a copy of the GNU General Public License # # along with this program; if not, write to the Free Software # # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.# # # # Jon Howell can be contacted at: # # 6211 Sudikoff Lab, Dartmouth College # # Hanover, NH 03755-3510 # # jonh@cs.dartmouth.edu # # # # An electronic copy of the GPL is available at: # # http://www.gnu.org/copyleft/gpl.html # # # ############################################################################## use strict; package FAQ::OMatic::statgraph; use CGI; use GD; my $image_type; { my $image = new GD::Image (10, 10); $image_type = $image->can('gif') ? "gif" : "png"; } use FAQ::OMatic; use FAQ::OMatic::Item; use FAQ::OMatic::Log; use vars qw($width $height $minx $rangex $basex $sizex $miny $rangey $basey $sizey); # file scope, for mod_perl sub calcx { my ($arg) = shift; return int($basex+min((($arg-($minx))/$rangex)*$sizex,$sizex)); } sub calcy { my ($arg) = shift; return int($basey+$sizey-min((($arg-$miny)/$rangey)*$sizey,$sizey)); } sub max { my ($x, $y) = @_; return $x if ($x > $y); return $y; } sub min { my ($x, $y) = @_; return $x if ($x < $y); return $y; } sub emptygraph { my ($message) = shift; my $image = new GD::Image (200, 12); my $white = $image->colorAllocate(255, 255, 255); my $red = $image->colorAllocate(255, 0, 0); $image->filledRectangle(0, 0, $width, $height, $white); $image->string(gdSmallFont, 0, 0, $message, $red); print $image->$image_type(); FAQ::OMatic::myExit(0); } #given a range value, returns a nice round interval sub autorange { my ($range) = shift; my ($multiplier) = 1.0; my $interval; emptygraph("Range $range<=0.") if ($range <= 0); #that's an error while ($range < 10) { $range *= 10.0; $multiplier *= 0.1; } while ($range >= 100) { $multiplier *= 10.0; $range *= 0.1; } if ($range <= 25.0) { $interval = 2.5; } elsif ($range <= 50.0) { $interval = 5.0; } else { $interval = 10.0; } return $multiplier*$interval; } sub autoIntervalDays { my ($range) = shift; my $interval; if ($range > 450) { return (365,'Years'); } elsif ($range > 30*3) { return (30,'Months'); } else { return (7,'Weeks'); } } #given (min,max), return (min,max,range,interval), with a nice interval # and rounded min and max. sub round { my ($arg) = shift; return int($arg+0.5) if ($arg >= 0); return int($arg-0.5); } sub rerange { my ($min, $max) = @_; my $interval = autorange($max-$min); my $newmin = (round($min/$interval)-1)*$interval; my $newmax = (round($max/$interval)+1)*$interval; return ($newmin, $newmax, $newmax-$newmin, $interval); } sub main { my $cgi = FAQ::OMatic::dispatch::cgi(); $cgi->cache('NO'); # recommend that netscape not cache this image print FAQ::OMatic::header($cgi, '-type' => "image/$image_type", '-nph' => 1, '-expires' => 0.000000001); my $params = FAQ::OMatic::getParams($cgi,'nolog'); my $property = $params->{'property'}; my $duration = $params->{'duration'} || $FAQ::OMatic::Appearance::graphHistory; my $resolution = int($params->{'resolution'} || '1'); my $today = $params->{'today'} || FAQ::OMatic::Log::numericToday(); # gotta sanity-check these things, because of stupid infinite loop # in timelocal() my ($yr,$mo,$dy) = split('-',$today); if ($yr<1990 or $yr>2036 or $mo<0 or $mo>11 or $dy<0 or $dy>31) { $today = FAQ::OMatic::Log::numericToday(); } $resolution = 1 if ($resolution < 0); $resolution = 14 if ($resolution > 14); if ($duration eq 'history') { $duration = FAQ::OMatic::Log::subTwoDays($today,FAQ::OMatic::Log::earliestSmry()); } else { $duration = int($duration); } if (($duration/$resolution) > $FAQ::OMatic::Appearance::graphWidth) { # no point in gathering too many data points! $resolution = int($duration / $FAQ::OMatic::Appearance::graphWidth); } # guarantee at least two items in @mydata $duration = $resolution if ($duration <= 0); # collect the data of interest. my $day; my $earliestday = FAQ::OMatic::Log::adddays($today, -$duration); my @mydata = (); # The data point itself my @myindex = (); # The day "number" (-$duration .. 0) of that data point # (i.e. where it goes on the graph) my $i; for ($day = $today, $i=0; $day ge $earliestday; $day = FAQ::OMatic::Log::adddays($day, -$resolution), $i-=$resolution) { my $item = new FAQ::OMatic::Item($day.".smry", $FAQ::OMatic::Config::metaDir); if (defined $item->{$property}) { unshift @mydata, $item->{$property}; unshift @myindex, $i; } else { unshift @mydata, 0; unshift @myindex, $i; } } # days run from negative (history) to zero (today) $minx = $myindex[0]; my $maxx = $myindex[$#myindex]; my $maxy; ($miny, $maxy) = (+10000000, -1000000); foreach my $i (@mydata) { $miny = min($miny, $i); $maxy = max($maxy, $i); } # autorange y $miny = 0; #Want bottom of graph to be at 0 $maxy = max($maxy,1); # make sure range doesn't collapse to 0 my $intervaly; ($miny, $maxy, $rangey, $intervaly) = rerange($miny, $maxy); $miny = 0; # autoranging may have nudged miny to -1, so fix it $rangey = $maxy-$miny; # thus fix range, too. # get x interval automatically $rangex = $maxx - $minx; my ($intervalx,$unitsx) = autoIntervalDays($rangex); $width = $FAQ::OMatic::Appearance::graphWidth; $height = $FAQ::OMatic::Appearance::graphHeight; # from FAQ::OMatic::FaqConfig my $borderx = 30; my $bordery = 10; my $image = new GD::Image ($width, $height); my $transparent = $image->colorAllocate(255, 255, 255); my $framefill = $image->colorAllocate(255, 255, 255); my $grid = $image->colorAllocate(192, 192, 192); my $datafill = $image->colorAllocate(0, 0, 132); my $datacolor = $image->colorAllocate(240, 0, 0); my $frame = $image->colorAllocate(128, 0, 0); my $labels = $image->colorAllocate(10, 88, 0); # draw the graph in this order, back-to-front: # transparent (whole image background) # framefill # grid # datafill # datacolor # ticks (grid color) # frame # labels # transparent $image->filledRectangle(0, 0, $width, $height, $transparent); # framefill # note these are globals so calc[xy] can see them ($basex, $basey) = ($borderx, $bordery); ($sizex, $sizey) = ($width-2*$borderx, $height-3*$bordery); $image->filledRectangle($basex, $basey, $basex+$sizex, $basey+$sizey, $framefill); # grid for ($i=$miny; $i<=$maxy; $i+=$intervaly) { $image->line(calcx($minx), calcy($i), calcx($miny), calcy($i), $grid); } # datafill - plot data region # I use many little polys instead of one big one because GD has # a bug wherein it fails to fill polygons correctly when three points # share the same y value. for ($i=0; $iaddPt(calcx($myindex[$i]), calcy($miny)); $poly->addPt(calcx($myindex[$i]), calcy($mydata[$i])); $poly->addPt(calcx($myindex[$i+1]), calcy($mydata[$i+1])); $poly->addPt(calcx($myindex[$i+1]), calcy($miny)); #$image->filledPolygon($poly, $datafill); } # ticks - provide scale for image my $tickwidth = 5; for ($i=$maxx; $i>$minx; $i-=$intervalx) { $image->line(calcx($i), calcy($miny), calcx($i), calcy($miny)-$tickwidth, $grid); my $label = $i/$intervalx; $label = "Today" if ($label == 0); $image->string(gdTinyFont, calcx($i)-2, calcy($miny)+1, $label, $labels); } my $title=$params->{'title'} || $property; $image->string(gdSmallFont, calcx($minx+$rangex*0.5)-length($title)*6/2, calcy($maxy)-12, $title, $labels); for ($i=$miny; $i<=$maxy; $i+=$intervaly) { $image->line(calcx($minx), calcy($i), calcx($minx)+$tickwidth, calcy($i), $grid); $image->line(calcx($maxx), calcy($i), calcx($maxx)-$tickwidth, calcy($i), $grid); my $label = $i; $label =~ s/000$/k/; $image->string(gdTinyFont, $borderx-length($label)*5-2, calcy($i)-3, $label, $labels); } $image->string(gdTinyFont, calcx($minx+$rangex*0.5)-length($unitsx)*5/2, calcy($miny)+10, $unitsx, $labels); # datacolor - highlight top edge of data for ($i=0; $iline(calcx($myindex[$i]), calcy($mydata[$i]), calcx($myindex[$i+1]), calcy($mydata[$i+1]), $datacolor); } # frame - outline the plot box $image->rectangle($basex, $basey, $basex+$sizex, $basey+$sizey, $frame); # announce final value (should show up over ticks) my $value = $mydata[$#mydata]; if (not $value =~ m/\./) { # for big numbers $value =~ s/(?!^|,)(\d\d\d)$/,$1/; # add commas for readability $value =~ s/(?!^|,)(\d\d\d),/,$1,/; # of big numbers. This'll keep you $value =~ s/(?!^|,)(\d\d\d),/,$1,/; # til your trillionth hit. :v) } else { # for little numbers $value = sprintf "%.2f", $value; } my @spots = ( [-1, 0,$framefill], [-1,-1,$framefill], [ 0,-1,$framefill], [ 1,-1,$framefill], [ 1, 0,$framefill], [ 1, 1,$framefill], [ 0, 1,$framefill], [-1, 1,$framefill], [ 0, 0,$datafill] ); foreach my $spot (@spots) { $image->string(gdTinyFont, calcx($maxx)-5*length($value)+18+$spot->[0], max(calcy($mydata[$#mydata])-9+$spot->[1],$basey+2), $value, $spot->[2]); } # make image background transparent so it'll look nicer sitting # in the browser $image->transparent($transparent); # send image print $image->$image_type(); } 1;