File Coverage

blib/lib/GD/3DBarGrapher.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

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[\n];
	my $maptag = qq[\n%shapes%];
	my $areatag = qq[\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
# -----------------------------------------------------------------------------

=head1 NAME

GD::3DBarGrapher - Create 3D bar graphs using GD

=head1 SYNOPSIS

  use GD::3DBarGrapher qw(creategraph);

  my @data = (
      ['Apples', 28],
      ['Pears',  43],
      ...etc
  );

  my %options = (
      'file' => '/webroot/images/mygraph.jpg',
  );

  my $imagemap = creategraph(\@data, \%options);

=head1 DESCRIPTION

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.

=head1 Options

  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:

=over 5

=item 1.
Options commented with "COLOUR NAME" expect the name of one of the default
colours above, or you can define your own colours by adding new lines in the
same format

=item 2.
Overall graph width and height can exceed the preferred values, depending on
number of items to graph and the values specified for various settings like
bwidth, bminspace, etc

=item 3.
For better text quality it is recommended to specify true type fonts for
options tfont, lfont & vfont. the full path and font file name must be
included, eg: 'c:/windows/fonts/verdana.ttf'

=item 4.
Only options that default to empty can be defined as empty

=head1 Image Map

The creategraph function returns XHTML code for the image and an associated
image map, something like this:





  ...etc


=head1 Bugs

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

=head1 AUTHOR

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

=head1 SEE ALSO

L

=cut