| GD-3DBarGrapher documentation | Contained in the GD-3DBarGrapher distribution. |
GD::3DBarGrapher - Create 3D bar graphs using GD
use GD::3DBarGrapher qw(creategraph);
my @data = (
['Apples', 28],
['Pears', 43],
...etc
);
my %options = (
'file' => '/webroot/images/mygraph.jpg',
);
my $imagemap = creategraph(\@data, \%options);
There is only one function in the 3dBarGrapher module and that is creategraph which will return image map XHTML for use in a web page displaying the graph.
The data to graph must be passed in a multidimensional array where column 0 is the x-axis name of the item to graph and column 1 is it's associated numerical value.
Graph options are passed in a hash and override the defaults listed below. At minimum the 'file' option must be included and specify the full path and filename of the graph to create.
my %options = (
# colours
black => { R => 0, G => 0, B => 0 },
white => { R => 255, G => 255, B => 255 },
vltgrey => { R => 245, G => 245, B => 245 },
ltgrey => { R => 230, G => 230, B => 230 },
midgrey => { R => 180, G => 180, B => 180 },
midblue => { R => 54, G => 100, B => 170 },
# file output details
file => '', # file path and name; file extension
# can be .jpg|gif|png
quality => 9, # image quality: 1 (worst) - 10 (best)
# Only applies to jpg and png
# main image properties
imgw => 400, # preferred width in pixels
imgh => 320, # preferred height in pixels
iplotpad => 8, # padding between axis vals & plot area
ipadding => 14, # padding between other items
ibgcol => 'white', # COLOUR NAME; background colour
iborder => '', # COLOUR NAME; border, if any
# plot area properties
plinecol => 'midgrey', # COLOUR NAME; line colour
pflcol => 'vltgrey', # COLOUR NAME; floor colour
pbgcol => 'ltgrey', # COLOUR NAME; back/side colour
pbgfill => 'gradient', # 'gradient' or 'solid'; back/side fill
plnspace => 25, # minimum pixel spacing between divisions
pnumdivs => 6, # maximum number of y-axis divisions
# bar properties
bstyle => 'bar', # 'bar' or 'column' style
bcolumnfill => 'gradient', # 'gradient' or 'solid' for columns
bminspace => 18, # minimum spacing between bars
bwidth => 18, # width of bar
bfacecol => 'midblue', # COLOUR NAME or 'random'; bar face,
# 'random' for random bar face colour
# graph title
ttext => '', # title text
tfont => '', # uses gdGiantFont unless a true type
# font is specified
tsize => 11, # font point size
tfontcol => 'black', # COLOUR NAME; font colour
# axis labels
xltext => '', # x-axis label text
yltext => '', # y-axis label text
lfont => '', # uses gdLargeFont unless a true type
# font is specified
lsize => 10, # font point size
lfontcol => 'midblue', # COLOUR NAME; font colour
# axis values
vfont => '', # uses gdSmallFont unless a true type
# font is specified
vsize => 8, # font point size
vfontcol => 'black', # COLOUR NAME; font colour
);
Notes on options:
The creategraph function returns XHTML code for the image and an associated image map, something like this:
<img src="mygraph.jpg" width="400" height="320" border="0" usemap="#mygraphjpg1179003059" /> <map name="mygraphjpg1179003059" id="mygraphjpg1179003059"> <area shape="rect" coords="67,123,112,245" href="#" title="Apples: 28" /> <area shape="rect" coords="112,75,158,245" href="#" title="Pears: 43" /> ...etc </map>
There aren't any known ones but feel free to report any you find and I may (or may not) fix them! Contact swarhurst _at_ cpan.org
3DBarGrapher is copyright (c) 2009 S.I.Warhurst and is distributed under the same terms and conditions as Perl itself. See the Perl Artistic license:
http://www.perl.com/language/misc/Artistic.html
GD
| GD-3DBarGrapher documentation | Contained in the GD-3DBarGrapher distribution. |
package GD::3DBarGrapher; # ----------------------------------------------------------------------------- # # "3DBarGrapher" # # http://www.creationfactor.net/software.htm # # Copyright (c) 2009 S.I.Warhurst # # See DOCUMENTATION at end of file # # ----------------------------------------------------------------------------- # INITIALISATION # ----------------------------------------------------------------------------- use strict; use GD; require Exporter; @GD::3DBarGrapher::ISA = qw(Exporter); @GD::3DBarGrapher::EXPORT_OK = qw(creategraph); $GD::3DBarGrapher::VERSION = '0.9.6'; our $image; # ----------------------------------------------------------------------------- # MAIN FUNCTION # ----------------------------------------------------------------------------- sub creategraph { my($arrayref,$options) = @_; # --- get default config & update with customisations --- # my(%conf) = config(); foreach my $k (keys %{$options}){ $conf{lc($k)} = $$options{$k}; } # --- get data --- # my(@data) = @$arrayref; # --- get dimensions of objects --- # my(%dims) = getdimensions(\@data,\%conf); # --- create graph --- # # adjust overall image dimensions if necessary $conf{imgw} = $dims{minwidth} if $dims{minwidth} > $conf{imgw}; $conf{imgh} = $dims{minheight} if $dims{minheight} > $conf{imgh}; $image = GD::Image->newTrueColor($conf{imgw},$conf{imgh}); # fill image background colour my $col = $image->colorAllocate($conf{$conf{ibgcol}}{R},$conf{$conf{ibgcol}}{G},$conf{$conf{ibgcol}}{B}); $image->fill(10,10,$col); # draw graph border if necessary if($conf{iborder} ne ""){ my $col = $image->colorAllocate($conf{$conf{iborder}}{R},$conf{$conf{iborder}}{G},$conf{$conf{iborder}}{B}); $image->rectangle(0,0,$conf{imgw}-1,$conf{imgh}-1,$col); } # draw title if($conf{ttext} ne ''){ my $col = $image->colorAllocate($conf{$conf{tfontcol}}{R},$conf{$conf{tfontcol}}{G},$conf{$conf{tfontcol}}{B}); if($conf{tfont} eq ''){ my $x = ($conf{imgw}/2)-($dims{titlew}/2); my $y = $conf{ipadding}; $image->string(gdGiantFont,$x,$y,$conf{ttext},$col); } else{ my $x = ($conf{imgw}/2)-($dims{titlew}/2); my $y = $conf{ipadding} + $dims{titleh}; $image->stringFT($col,$conf{tfont},$conf{tsize},0,$x,$y,$conf{ttext}); } } # draw y label text if($conf{yltext} ne ''){ my $col = $image->colorAllocate($conf{$conf{lfontcol}}{R},$conf{$conf{lfontcol}}{G},$conf{$conf{lfontcol}}{B}); if($conf{lfont} eq ''){ my $x = $conf{ipadding}; my $temp = 0; $temp = ($conf{ipadding} + $dims{titleh}) if $dims{titleh} > 0; my $y = ((($dims{floor} + $dims{plotheight})/2) + ($dims{ylabelheight}/2)) + $temp + $conf{ipadding}; $image->stringUp(gdLargeFont,$x,$y,$conf{yltext},$col); } else{ my $x = $conf{ipadding} + $dims{ylabelwidth}; my $temp = 0; $temp = ($conf{ipadding} + $dims{titleh}) if $dims{titleh} > 0; my $y = ((($dims{floor} + $dims{plotheight})/2) + ($dims{ylabelheight}/2)) + $temp + $conf{ipadding}; $image->stringFT($col,$conf{lfont},$conf{lsize},90/57.2958,$x,$y,$conf{yltext}); } } # draw x label text if($conf{xltext} ne ''){ my $col = $image->colorAllocate($conf{$conf{lfontcol}}{R},$conf{$conf{lfontcol}}{G},$conf{$conf{lfontcol}}{B}); if($conf{lfont} eq ''){ my $x = $conf{imgw} - ($conf{ipadding} + (($dims{floor} + $dims{plotwidth})/2) + ($dims{xlabelwidth}/2)); my $y = $conf{imgh} - $conf{ipadding} - $dims{xlabelheight}; $image->string(gdLargeFont,$x,$y,$conf{xltext},$col); } else{ my $x = $conf{imgw} - ($conf{ipadding} + (($dims{floor} + $dims{plotwidth})/2) + ($dims{xlabelwidth}/2)); my $y = $conf{imgh} - $conf{ipadding}; $image->stringFT($col,$conf{lfont},$conf{lsize},0,$x,$y,$conf{xltext}); } } # draw main plot box my $col = $image->colorAllocate($conf{$conf{plinecol}}{R},$conf{$conf{plinecol}}{G},$conf{$conf{plinecol}}{B}); my $ypos = $conf{ipadding}; $ypos += $conf{ipadding} + $dims{titleh} if $conf{ttext} ne ''; my $plotleftedge = $conf{imgw}-$conf{ipadding}-$dims{plotwidth}; $image->rectangle($conf{imgw}-$conf{ipadding},$ypos,$plotleftedge,$ypos+$dims{plotheight},$col); # draw side & floor $image->line($plotleftedge,$ypos,$plotleftedge-$dims{floor},$ypos+$dims{floor},$col); $image->line($plotleftedge-$dims{floor},$ypos+$dims{floor},$plotleftedge-$dims{floor},$ypos+$dims{plotheight}+$dims{floor},$col); $image->line($plotleftedge-$dims{floor},$ypos+$dims{plotheight}+$dims{floor},$plotleftedge,$ypos+$dims{plotheight},$col); $image->line($plotleftedge-$dims{floor},$ypos+$dims{plotheight}+$dims{floor},$conf{imgw}-$conf{ipadding}-$dims{floor},$ypos+$dims{plotheight}+$dims{floor},$col); $image->line($conf{imgw}-$conf{ipadding}-$dims{floor},$ypos+$dims{plotheight}+$dims{floor},$conf{imgw}-$conf{ipadding},$ypos+$dims{plotheight},$col); # fill plot box, side and floor my $flr = $image->colorAllocate($conf{$conf{pflcol}}{R},$conf{$conf{pflcol}}{G},$conf{$conf{pflcol}}{B}); my $bg = $image->colorAllocate($conf{$conf{pbgcol}}{R},$conf{$conf{pbgcol}}{G},$conf{$conf{pbgcol}}{B}); $image->fill($plotleftedge,$ypos+$dims{plotheight}+2,$flr); if($conf{pbgfill} eq "gradient"){ gradientfill($bg,$plotleftedge+1,$ypos+1,$plotleftedge+$dims{plotwidth}-1,$ypos+1,$dims{plotheight}-1,'',$conf{imgh}); gradientfill($bg,($plotleftedge-$dims{floor})+1,($ypos+$dims{floor}),$plotleftedge-1,$ypos+2,$dims{plotheight}-1,'',$conf{imgh}); } else{ $image->fill($conf{imgw}-$conf{ipadding}-2,$ypos+2,$bg); $image->fill($plotleftedge-2,$ypos+$dims{floor}+2,$bg); } # draw div lines and y vals my ($x1,$x2,$x3) = ($conf{imgw}-$conf{ipadding}-$dims{plotwidth}-$dims{floor},$conf{imgw}-$conf{ipadding}-$dims{plotwidth},$conf{imgw}-$conf{ipadding}); my ($y1,$y2) = ($ypos+$dims{plotheight}+$dims{floor},$ypos+$dims{plotheight}); my $divspacing = $dims{plotheight}/$dims{numdivs}; my $txtcol = $image->colorAllocate($conf{$conf{vfontcol}}{R},$conf{$conf{vfontcol}}{G},$conf{$conf{vfontcol}}{B}); if($conf{vfont} ne ''){ my($w,$h) = getstringsize($conf{vfont},"0",$conf{vsize},0); $image->stringFT($txtcol,$conf{vfont},$conf{vsize},0,$x1-$conf{iplotpad}-$w,$y1+($h/2),"0"); } else{ my($w,$h) = getstringsize("gdSmallFont","0"); $image->string(gdSmallFont,$x1-$conf{iplotpad}-$w,$y1-($h/2),"0",$txtcol); } for(my $d = 1; $d <= $dims{numdivs}; $d++){ $image->line($x1,$y1-($d*$divspacing),$x2,$y2-($d*$divspacing),$col); $image->line($x2,$y2-($d*$divspacing),$x3,$y2-($d*$divspacing),$col); if($conf{vfont} ne ''){ my($w,$h) = getstringsize($conf{vfont},($dims{range}/$dims{numdivs})*$d,$conf{vsize},0); $image->stringFT($txtcol,$conf{vfont},$conf{vsize},0,$x1-$conf{iplotpad}-$w,($y1-($d*$divspacing))+($h/2),($dims{range}/$dims{numdivs})*$d); } else{ my($w,$h) = getstringsize("gdSmallFont",($dims{range}/$dims{numdivs})*$d); $image->string(gdSmallFont,$x1-$conf{iplotpad}-$w,($y1-($d*$divspacing))-($h/2),($dims{range}/$dims{numdivs})*$d,$txtcol); } } # get imagemap html ready my($imgtag, $maptag, $areatag) = imagemaphtml(); my ($imagemap,$shapes); $imagemap = $imgtag . $maptag; my ($filename) = $conf{file} =~ /([^\/]+)$/; $imagemap =~ s/%imagename%/$filename/; $imagemap =~ s/%width%/$conf{imgw}/; $imagemap =~ s/%height%/$conf{imgh}/; $filename =~ s/(\W+|_|\-)//g; # attempt to give map $filename .= time; # unique name! $imagemap =~ s/%mapname%/$filename/g; # draw columns or bars my ($colbar,%shades); if($conf{bfacecol} ne "random"){ $colbar = $image->colorAllocate($conf{$conf{bfacecol}}{R},$conf{$conf{bfacecol}}{G},$conf{$conf{bfacecol}}{B}); (%shades) = getshades($conf{$conf{bfacecol}}{R},$conf{$conf{bfacecol}}{G},$conf{$conf{bfacecol}}{B},\%conf); } else { my @rgb = ($conf{$conf{pflcol}}{R},$conf{$conf{pflcol}}{G},$conf{$conf{pflcol}}{B}); my (%colour) = randomcolour(); $colbar = $image->colorAllocate($colour{R},$colour{G},$colour{B}); (%shades) = getshades($colour{R},$colour{G},$colour{B},\%conf); } my $shadetop = $image->colorAllocate($shades{top}{R},$shades{top}{G},$shades{top}{B}); my $shadeside = $image->colorAllocate($shades{side}{R},$shades{side}{G},$shades{side}{B}); my $xtxt = $image->colorAllocate($conf{$conf{vfontcol}}{R},$conf{$conf{vfontcol}}{G},$conf{$conf{vfontcol}}{B}); my $keyn = scalar @data; my $spacing = ($dims{plotwidth} - $conf{iplotpad} - $conf{iplotpad} - $dims{floor} - ($keyn * $conf{bwidth})) / ($keyn-1); my $barpos = $plotleftedge + $conf{iplotpad}; my ($bwidby2,$bwidby3,$bwidby4) = ( int($conf{bwidth}/2), int($conf{bwidth}/3), int($conf{bwidth}/4) ); my $floordepth = sprintf("%.0f",sqrt(($bwidby2*$bwidby2)/2)); foreach my $d(@data){ # draw x axis text if($conf{vfont} ne ''){ my($w,$h,$x) = getstringsize($conf{vfont},$d->[0],$conf{vsize},45); $image->stringFT($xtxt,$conf{vfont},$conf{vsize},45/57.2958,($barpos-$w)+$x+$bwidby3,$ypos+$dims{plotheight}+$dims{floor}+$conf{iplotpad}+$h,$d->[0]); } else{ my($h,$w) = getstringsize("gdSmallFont",$d->[0]); $image->stringUp(gdSmallFont,$barpos+($bwidby2-($w/2)),$ypos+$dims{plotheight}+$dims{floor}+$conf{iplotpad}+$h,$d->[0],$xtxt); } my $coords; # draw columns if($conf{bstyle} eq "column"){ # draw bottom arc $image->filledArc($barpos+$bwidby2,$ypos+$dims{plotheight}+$bwidby4,$conf{bwidth},$bwidby2,0,180,$colbar); # draw bar my $centretopy = $ypos + ($dims{plotheight} - (($dims{plotheight}/$dims{range})*$d->[1])) + $bwidby4; $image->filledRectangle($barpos,$centretopy,$barpos+$conf{bwidth}-1,$ypos+$dims{plotheight}+$bwidby4,$colbar); if($conf{bcolumnfill} eq "gradient"){ gradientfill($colbar,$centretopy,$barpos+$conf{bwidth}-1,$ypos+$dims{plotheight}+$bwidby4,$barpos+$conf{bwidth}-1,$conf{bwidth},'column',$conf{imgh}); } # draw top ellipse $image->filledEllipse($barpos+$bwidby2,$centretopy,$conf{bwidth},$bwidby2,$shadetop); $coords = int($barpos) . "," . int($centretopy-$bwidby4) . "," . int($barpos+$conf{bwidth}) . "," . int($ypos+$dims{plotheight}+$bwidby4); } # draw bars else { # draw main bar face my $centretopy = $ypos + ($dims{plotheight} - (($dims{plotheight}/$dims{range})*$d->[1])) + $floordepth; $image->filledRectangle($barpos,$centretopy,$barpos+$conf{bwidth},$ypos+$dims{plotheight}+$floordepth,$colbar); # draw top and side sections my $poly = new GD::Polygon; $poly->addPt($barpos,$centretopy); $poly->addPt($barpos+$floordepth,$centretopy-$floordepth); $poly->addPt($barpos+$floordepth+$conf{bwidth},$centretopy-$floordepth); $poly->addPt($barpos+$conf{bwidth},$centretopy); $image->filledPolygon($poly,$shadetop); my $poly = new GD::Polygon; $poly->addPt($barpos+$floordepth+$conf{bwidth},$centretopy-$floordepth); $poly->addPt($barpos+$floordepth+$conf{bwidth},($ypos+$dims{plotheight})); $poly->addPt($barpos+$conf{bwidth},$ypos+$dims{plotheight}+$floordepth); $poly->addPt($barpos+$conf{bwidth},$centretopy); $image->filledPolygon($poly,$shadeside); $coords = int($barpos) . "," . int($centretopy-$floordepth) . "," . int($barpos+$conf{bwidth}+$spacing) . "," . int($ypos+$dims{plotheight}+$floordepth); } # create imagemap shape $shapes .= $areatag; $shapes =~ s/%coords%/$coords/; $shapes =~ s/%title%/$d->[0]: $d->[1]/; # increment xpos for next bar $barpos += ($conf{bwidth} + $spacing); } # finish imagemap html $imagemap =~ s/%shapes%/$shapes/g; # --- create image file --- # my $writedata; if($conf{file} =~ /\.gif$/i){ $writedata = $image->gif(); } elsif($conf{file} =~ /\.png$/i){ my $q = 10-$conf{quality}; $writedata = $image->png($q); } else{ my $q = $conf{quality}*10; $writedata = $image->jpeg($q); } open IMG,">$conf{file}"; binmode IMG; print IMG $writedata; close IMG; return $imagemap; } # ----------------------------------------------------------------------------- # SUBROUTINES # ----------------------------------------------------------------------------- sub config { my %conf = ( # colours black => { R => 0, G => 0, B => 0 }, white => { R => 255, G => 255, B => 255 }, vltgrey => { R => 245, G => 245, B => 245 }, ltgrey => { R => 230, G => 230, B => 230 }, midgrey => { R => 180, G => 180, B => 180 }, midblue => { R => 54, G => 100, B => 170 }, # file output details file => '', # file path and name; file extension can be .jpg|gif|png quality => '9', # image file quality: 1 (worst) - 10 (best) # main image properties imgw => 400, # preferred width - maybe more depending on bar properties and number of x-axis values specified imgh => 320, # preferred height - maybe more depending on bar properties and number of y-axis values specified ipadding => 14, # padding between items, eg: between top of image and title iplotpad => 8, # padding between axis vals and plot area ibgcol => 'white', # background colour iborder => '', # defaults to no border # plot area properties plinecol => 'midgrey', # line colour pflcol => 'vltgrey', # floor colour pbgcol => 'ltgrey', # background colour pbgfill => 'gradient', # 'gradient' or 'solid' for fill type plnspace => 25, # minimum spacing between divisions pnumdivs => 6, # maximum number of divisions # bar properties bstyle => 'bar', # can be 'column' or 'bar' bcolumnfill => 'gradient', # 'gradient' or 'solid' for columns bminspace => 18, # minimum spacing between bars bwidth => 18, # width bfacecol => 'midblue', # colour of column/bar face, or 'random' for random colour # graph title ttext => '', # title text tfont => '', # specify path/truetype font otherwise defaults to gdGiantFont tsize => 11, # font size tfontcol => 'black', # font colour # axis labels xltext => '', # x label text yltext => '', # y label text lfont => '', # specify path/truetype font otherwise defaults to gdLargeFont lsize => 10, # font size lfontcol => 'midblue', # font colour # axis values vfont => '', # specify path/truetype font otherwise defaults to gdSmallFont vsize => 8, # font size vfontcol => 'black', # font colour ); return %conf; } sub imagemaphtml { my $imgtag = qq[<img src="%imagename%" width="%width%" height="%height%" border="0" usemap="#%mapname%" />\n]; my $maptag = qq[<map name="%mapname%" id="%mapname%">\n%shapes%</map>]; my $areatag = qq[<area shape="rect" coords="%coords%" href="#" title="%title%" />\n]; return ($imgtag, $maptag, $areatag); } sub getstringsize { my ($font,$string,$size,$angle) = @_; if($font =~ /^gd\w+Font$/){ my %gdfonts = ( 'gdTinyFont' => { 'w' => 5, 'h' => 8 }, 'gdSmallFont' => { 'w' => 6, 'h' => 12 }, 'gdMediumBoldFont' => { 'w' => 7, 'h' => 13 }, 'gdLargeFont' => { 'w' => 8, 'h' => 16 }, 'gdGiantFont' => { 'w' => 9, 'h' => 15 } ); return ($gdfonts{$font}{w}*length($string),$gdfonts{$font}{h}); } else { my ($wid,$hgt,$x); my $tst = new GD::Image(1000,1000,1); my $tmp = $tst->colorAllocate(0,0,0); my $radangle = $angle / 57.2958; my @bounds = GD::Image->stringFT($tmp,$font,$size,$radangle,50,950,$string); if ($angle == 0) { $wid = $bounds[4]-$bounds[6]; $hgt = $bounds[1]-$bounds[7]; } elsif ($angle == 45) { $wid = $bounds[2]-$bounds[6]; $hgt = $bounds[1]-$bounds[5]; $x = $bounds[0]-$bounds[6]; } else { $wid = $bounds[0]-$bounds[6]; $hgt = $bounds[1]-$bounds[3]; } #print "LL=$bounds[0],$bounds[1] LR=$bounds[2],$bounds[3] UR=$bounds[4],$bounds[5] UL=$bounds[6],$bounds[7]" if $string eq "Number sold"; return ($wid,$hgt,$x); } } sub getdimensions { my @data = @{$_[0]}; my %conf = %{$_[1]}; my %dims = ( minwidth => 0, # min overall graph width minheight => 0, # min overall graph height titlew => 0, # title width titleh => 0, # title text height ylabelwidth => 0, # y axis label width ylabelheight => 0, # y axis label height xlabelwidth => 0, # x axis label width xlabelheight => 0, # x axis label height xvalheight => 0, # largest x axis value height xhorheight => 0, # largest x axis value height yvalwidth => 0, # largest y axis value width floor => 0, # width/height of 3D floor/sides plotwidth => 0, # overall plot area width plotheight => 0, # overall plot area height numdivs => 6, # number of divisions in plot area range => 6000000 # upper range value ); # --- calculate y axis ranges --- # # find highest number my $high = 0; foreach my $d(@data){ $high = $d->[1] if $d->[1] > $high; } # find best number of divs and upper range number my @divs = (1,2,5,10,20,50,100,200,500,1000,2000,5000,10000,20000,50000,100000,200000,500000,1000000); foreach my $n(6,5,4){ foreach my $d(@divs){ if(($n*$d) > $high and (($n*$d)-$high) < ($dims{range}-$high)){ $dims{numdivs} = $n; $dims{range} = $n*$d; last; } } } # --- calculate heights --- # # top padding $dims{minheight} += $conf{ipadding}; # title height if($conf{ttext} ne ''){ if($conf{tfont} eq ''){ ($dims{titlew},$dims{titleh}) = getstringsize("gdGiantFont",$conf{ttext}); } else{ ($dims{titlew},$dims{titleh}) = getstringsize($conf{tfont},$conf{ttext},$conf{tsize},0); } $dims{minheight} += ($dims{titleh} + $conf{ipadding}); # add title height & padding below to minheight } # padding between x vals and plot area $dims{minheight} += $conf{iplotpad}; # largest x val height - angled and horizontal foreach my $d(@data){ if($conf{vfont} eq ''){ my($h,$w) = getstringsize("gdSmallFont",$d->[0]); $dims{xvalheight} = $h if $h > $dims{xvalheight}; my($w2,$h2) = getstringsize("gdSmallFont",$d->[0]); $dims{xhorheight} = $h2 if $h2 > $dims{xhorheight}; } else{ my($w,$h) = getstringsize($conf{vfont},$d->[0],$conf{vsize},45); $dims{xvalheight} = $h if $h > $dims{xvalheight}; my($w2,$h2) = getstringsize($conf{vfont},$d->[0],$conf{vsize},0); $dims{xhorheight} = $h2 if $h2 > $dims{xhorheight}; } } $dims{minheight} += $dims{xvalheight}; # bottom padding $dims{minheight} += $conf{ipadding}; # x axis label height & extra padding if($conf{xltext} ne ''){ if($conf{lfont} eq ''){ ($dims{xlabelwidth},$dims{xlabelheight}) = getstringsize("gdMediumBoldFont",$conf{xltext}); } else{ ($dims{xlabelwidth},$dims{xlabelheight}) = getstringsize($conf{lfont},$conf{xltext},$conf{lsize},0); } $dims{minheight} += ($dims{xlabelheight} + $conf{ipadding}); } # --- calculate widths --- # # left padding $dims{minwidth} += $conf{ipadding}; # y label width if($conf{yltext} ne ''){ if($conf{lfont} eq ''){ ($dims{ylabelheight},$dims{ylabelwidth}) = getstringsize("gdMediumBoldFont",$conf{yltext}); } else{ ($dims{ylabelwidth},$dims{ylabelheight}) = getstringsize($conf{lfont},$conf{yltext},$conf{lsize},90); } $dims{minwidth} += ($dims{ylabelwidth} + $conf{ipadding}); } # largest y val width (ie: of upper range) if($conf{vfont} eq ''){ ($dims{yvalwidth},$dims{yvalheight}) = getstringsize("gdSmallFont",$dims{range}); } else{ ($dims{yvalwidth},$dims{yvalheight}) = getstringsize($conf{vfont},$dims{range},$conf{vsize},0); } $dims{minwidth} += $dims{yvalwidth}; # padding between y vals and plot area $dims{minwidth} += $conf{iplotpad}; # right padding $dims{minwidth} += $conf{ipadding}; # --- calculate plot area and make final adjustments to min width/height --- # # force practical minimum bar/column widths $conf{bwidth} = 10 if $conf{bwidth} < 10; $conf{bwidth} += 1 if $conf{bwidth} =~ /[02468]$/ and $conf{bstyle} eq "column"; # floor/side sizes my $floorwidth = $conf{bwidth}*1.25; $dims{floor} = sprintf("%.0f",sqrt(($floorwidth*$floorwidth)/2)); $dims{minheight} += $dims{floor}; $dims{minwidth} += $dims{floor}; # plot width $conf{bminspace} = $dims{xhorheight} if $conf{bminspace} < $dims{xhorheight}; # ensure min bar spacing !<= x val height my $keyn = scalar @data; $dims{plotwidth} = $conf{iplotpad} + ($keyn * $conf{bwidth}) + (($keyn-1) * $conf{bminspace}) + $conf{iplotpad} + $dims{floor}; $dims{plotwidth} = $conf{imgw} - $dims{minwidth} if $dims{plotwidth} < $conf{imgw} - $dims{minwidth}; $dims{minwidth} += $dims{plotwidth}; # plot height $conf{plnspace} = $dims{yvalheight} if $conf{plnspace} < $dims{yvalheight}; # ensure min line spacing !<= y val height $dims{plotheight} = $dims{numdivs}*$conf{plnspace}; $dims{plotheight} = $conf{imgh} - $dims{minheight} if $dims{plotheight} < $conf{imgh} - $dims{minheight}; $dims{minheight} += $dims{plotheight}; return %dims; } sub getshades { my @rgb = ($_[0],$_[1],$_[2]); my %conf = %{$_[3]}; # make sure 2 or more colour values can accommodate darkening by 70 my ($ctr,$darker) = (0,0); foreach my $c(@rgb){ $ctr++ if $c >= 70; } $darker = 1 if $ctr >= 2; # create shades my %shades; my $ctr = 0; foreach my $s(qw/R G B/){ # shades darker than face colour if($darker == 1){ $conf{bcolumnfill} eq "gradient" and $conf{bstyle} eq "column" ? ($shades{top}{$s} = $rgb[$ctr] - 50) : ($shades{top}{$s} = $rgb[$ctr] - 70); $shades{side}{$s} = $rgb[$ctr] - 40; $shades{top}{$s} = 0 if $shades{top}{$s} < 0; $shades{side}{$s} = 0 if $shades{side}{$s} < 0; } # shades lighter than face colour else{ $conf{bcolumnfill} eq "gradient" and $conf{bstyle} eq "column" ? ($shades{top}{$s} = $rgb[$ctr] + 40) : ($shades{top}{$s} = $rgb[$ctr] + 70); $shades{side}{$s} = $rgb[$ctr] + 50; $shades{top}{$s} = 255 if $shades{top}{$s} > 255; $shades{side}{$s} = 255 if $shades{side}{$s} > 255; } $ctr++; } return %shades; } sub randomcolour { my %colour; # generate random colour numbers but make sure not too close to floor colour for my $c(qw/R G B/){ $colour{$c} = int(rand(256)); } return %colour; } sub gradientfill { # get params my ($clr,$fromx,$fromy,$tox,$toy,$height,$column,$conf_imgheight) = @_; # colour hash for passed colour my @n = $image->rgb($clr); my %c2 = ( R => $n[0], G => $n[1], B => $n[2] ); # work out darkness of colour and set offset accordingly my ($offset,$ctr) = (50,0); foreach my $i(qw/R G B/){ $ctr++ if $c2{$i} > 150; } $offset += 35 if $ctr < 2 and $column eq ''; # set up colour hash for lighter shade my %c1; foreach my $i(qw/R G B/){ $c1{$i} = $c2{$i} + $offset; $c1{$i} = 255 if $c1{$i} > 255; } # initiate dynamic vars my $pixposf = $fromy; # current from x position my $pixpost = $toy; # current to x position my %clrs; my $rgb = 0; foreach ( keys %c1 ) { $clrs{$_}{clr} = $c1{$_}; } # add {adj} & {pix} & {pxctr} subhashes to %clrs foreach $rgb (qw/R G B/) { if ($c1{$rgb} > $c2{$rgb} and $height > ($c1{$rgb}-$c2{$rgb})) { $clrs{$rgb}{adj} = -1; $clrs{$rgb}{pix} = ($height-1)/($c1{$rgb}-$c2{$rgb}); } elsif ($c1{$rgb} > $c2{$rgb} and $height < ($c1{$rgb}-$c2{$rgb})) { $clrs{$rgb}{adj} = -(($c1{$rgb}-$c2{$rgb})/($height-1)); $clrs{$rgb}{pix} = 1; } elsif ($c2{$rgb} > $c1{$rgb} and $height > ($c2{$rgb}-$c1{$rgb})) { $clrs{$rgb}{adj} = 1; $clrs{$rgb}{pix} = ($height-1)/($c2{$rgb}-$c1{$rgb}); } elsif ($c2{$rgb} > $c1{$rgb} and $height < ($c2{$rgb}-$c1{$rgb})) { $clrs{$rgb}{adj} = ($c2{$rgb}-$c1{$rgb})/($height-1); $clrs{$rgb}{pix} = 1; } $clrs{$rgb}{pxctr} = $clrs{$rgb}{pix}; } # do gradient fill while ($column ne '' ? ($pixposf > $fromy-$height) : ($pixposf < $fromy+$height)) { # round to nearest integer and make sure within 0-255 range my %colour; foreach $rgb (qw/R G B/) { $colour{$rgb} = sprintf("%.0f",$clrs{$rgb}{clr}); if ($colour{$rgb} > 255) { $colour{$rgb} = 255; } elsif ($colour{$rgb} < 0) { $colour{$rgb} = 0; } } # set line colour my $temp = $image->colorAllocate($colour{R},$colour{G},$colour{B}); # draw line if($column ne ''){ my $ind = $image->getPixel($pixposf,$tox); my $toytemp = $tox; while ($ind eq $clr and $toytemp < $conf_imgheight){ $toytemp++; $ind = $image->getPixel($pixposf,$toytemp); } $image->line($pixposf,$fromx,$pixposf,$toytemp,$temp); $pixposf--; } else{ $image->line($fromx,$pixposf,$tox,$pixpost,$temp); $pixposf++; $pixpost++; } # adjust RGB values foreach $rgb (qw/R G B/) { if($column ne ''){ if ($pixposf == ($fromy-$height)) { $clrs{$rgb}{clr} = $c2{$rgb}; } elsif ( $fromy-$pixposf >= $clrs{$rgb}{pxctr} ) { $clrs{$rgb}{pxctr} += $clrs{$rgb}{pix}; $clrs{$rgb}{clr} += $clrs{$rgb}{adj}; } } else{ if ($pixposf == ($fromy+$height)-1) { $clrs{$rgb}{clr} = $c2{$rgb}; } elsif ( $pixposf-$fromy >= $clrs{$rgb}{pxctr} ) { $clrs{$rgb}{pxctr} += $clrs{$rgb}{pix}; $clrs{$rgb}{clr} += $clrs{$rgb}{adj}; } } } } } 1; # ----------------------------------------------------------------------------- # DOCUMENTATION # -----------------------------------------------------------------------------