use GD;
use URI::Escape;
#NOTE: yInc should normally be a multiple of ygrid, if not specifying low
# and high values for y.
#NOTE: (FIX ME) NEGATIVE NUMBERS APPEAR TO BE BROKEN :( !!!!!!!!!!!!!!!!!
#
# This version of GDstackchart has been modified to handle multibar sets.
# This is achieved by providing multiline x-values by including "\n" in them
# and using the -xbreak and -barpct options. Coloration will now cycle on
# as desired. Another option added to provide padding before the leftmost
# bar preventing undesirable appearance when setting -barpct close to 100 is
# the new "lmgn2" option, which provides this desired padding (between the
# left (y) axis and the left side of the 1st bar in pixels.
=head1 EXAMPLE
@codes = ('D5','','P5','','D13','','N7','','N19','','N19','','N23','','DC17','');
@yvals = (1, 3, 5, 7, 2, 4, 6, ' ', 10, 9, 8, 7, 4, 3, 2, ' ', 3, 6, 2, 4, 5, 1, 7, ' ', 8, 6, 4, 2, 4,3,2,' ', 3, 5, 7, 2, 4, 6, 8, ' ', 10, 9, 8, 7, 4, 3, 2, ' ', 3, 6, 2, 4, 5, 1, 7, ' ', 8, 6, 4, 2, 4,3,2,' '),
($g,undef) = &StackChart(
-xvals => \@codes,
-yvals => \@yvals,
-xtitle => 'x-title',
-ytitle => 'y-title',
-xlegend => ["50G\n<90 Days", "USAF\n90 Days", "Blk 60\n120 Days", 'PE'],
-title => 'Harnesses', ^
-maxysiz => 300, |
-showvalues => 'bottom,total,top', |
-xbreak => 2, <-------------------
-barxsiz => 20,
-barpct => 100, <-------------------
-border => 1,
-lmgn2 => 10, <-------------------
);
#THIS CREATES A CHART WITH 2 SETS OF X-VALUES FOR A TOTAL OF 7. NOTE THAT
#EVERY 8TH Y-VALUE IS ' ', SINCE WE ONLY WANT 3 VALUES IN EVERY 2ND BAR.
#EACH 1ST BAR HAS 4 VALUES. BY SETTING XBREAK TO 2 AND BARPCT TO 100, EACH
#"PAIR" OF BARS ABUTS EACH OTHER, BUT IS SEPARATED FROM OTHER PAIRS!
=cut
sub StackChart
{
my %parm;
my (@barcolrs);
my ($g, $v);
my ($ycnt, $h, $i, $j, $legendx, $legendy, $mapstr);
#print "
entering GDbarchart!\n";
while (@_)
{
$v = shift;
$v =~ s/^\-//;
$parm{$v} = shift;
#print "
111 parm name=$v= set to =$parm{$v}=\n";
}
#print "
????? *START* ????? barysiz=$parm{barysiz}=\n";
#print "
HELLO WORLD: xcnt=$#{$parm{xvals}}= ycnt=$#{$parm{yvals}}=\n";
for ($i=0;$i<$#{$parm{xvals}};$i++)
{
#print "
xxxx=${$parm{xvals}}[$i]=\n";
}
for ($i=0;$i<$#{$parm{yvals}};$i++)
{
#print "
yyyy=${$parm{yvals}}[$i]=\n";
}
my (@l);
my ($sfw,$sfh) = (gdSmallFont->width,gdSmallFont->height);
my ($lfw,$lfh) = (gdLargeFont->width,gdSmallFont->height);
my ($sfh_1) = $sfh - 1;
my ($sfh2) = $sfh + 2;
#SET UP PARAMETER DEFAULTS.
#$parm{lmgn} = 60 unless($parm{lmgn});
$parm{rmgn} = 20 unless($parm{rmgn});
#$parm{bmgn} = 80 unless($parm{bmgn});
my @titles;
#NEXT LINE ADDED 20030430 TO SUPPORT MULTILINE TITLES!
@titles = split(/\n|\
/i, $parm{title}) if (defined($parm{title}));
unless($tmgn)
{
$parm{tmgn} = 20;
#$parm{tmgn} += $lfh + $sfh if (defined($parm{title})); #CHGD. TO NEXT 20030430 TO SUPPORT MULTILINE TITLES!
$parm{tmgn} += ($lfh+2)*scalar(@titles) + $sfh if ($#titles >= 0);
}
#$parm{border} = 3 unless (defined($parm{border})); #FOR DEBUG ONLY.
#$parm{barcolor} = 'blue' unless ($parm{barcolor});
#$parm{bgcolor} = 'white' unless ($parm{bgcolor});
$parm{valcolor} = 'white' unless ($parm{valcolor});
$parm{axiscolor} = 'black' unless ($parm{axiscolor});
$parm{titlecolor} = $parm{axiscolor} unless ($parm{titlecolor});
$parm{valxcolor} = $parm{axiscolor} unless ($parm{valxcolor});
#$parm{barcolors} = [qw(Steelblue4 DarkGreen brown4 Yellow3 darkorchid skyblue darkorange gray khaki salmon bisque4 olivedrab)] unless(defined($parm{barcolors}));
#$parm{barcolors} = [qw(SteelBlue gray brown4 skyblue salmon DarkGreen brown4 purple darkorange olivedrab khaki darkcyan bisque4)] unless(defined($parm{barcolors}));
$parm{barcolors} = [qw(SteelBlue gray brown4 khaki3 DarkGreen salmon skyblue bisque3 purple darkorange olivedrab yellow3)] unless(defined($parm{barcolors}));
#ADDED 20030415 TO ALLOW MULTIPLE LINES OF XLEGEND VALUES SPLIT ON \n!
$legendx = $parm{lmgn} / 2;
$ix = 0;
my $colormax = $#{$parm{xlegend}} + 1;
my $xlegendycnt = 1;
#NEXT 12 ADDED 20030417 TO CALCULATE MAX WIDTH NEEDED FOR MULTIPLE LEGEND LINES.
my @legendlens;
for (my $i=0;$i<=$#{$parm{xlegend}};$i++)
{
@l = split(/\n/, $parm{xlegend}->[$i]);
$xlegendycnt = scalar(@l) unless ($xlegendycnt > scalar(@l));
for (my $j=0;$j<=$#l;$j++)
{
$legendlens[$j] += length($l[$j]);
#print "
ix=$ix= l($l[$j])=".length($l[$j])."= ll0=$legendlens[0]= ll1=$legendlens[1]=\n";
$ix = $legendlens[$j] unless ($ix > $legendlens[$j]);
}
}
$legendx = (scalar(@{$parm{xlegend}})*($sfh2+5) + $sfw*$ix + $parm{lmgn} + $parm{rmgn})- 2*$sfh;
#print "
xl=".scalar(@{$parm{xlegend}})."= sfw=$sfw= sfh2=$sfh2 sfh=$sfh= lx=$legendx= ix=$ix=\n";
#print "
xlegendycnt=$xlegendycnt=\n";
$colormax *= $xlegendycnt if ($xlegendycnt);
for ($j=0;$j<$parm{shiftcolors};$j++)
{
$ix = shift(@{$parm{barcolors}});
@barcolrs = (@{$parm{barcolrs}},$ix);
}
if (defined($parm{barcolor}))
{
$parm{barcolors} = [$parm{barcolor}];
}
elsif (defined($parm{xlegend}) && $#{$parm{barcolors}} > 0 && $#{$parm{xlegend}} > 0)
{
# $#{$parm{barcolors}} = $#{$parm{xlegend}} if ($#{$parm{barcolors}} > $#{$parm{xlegend}});
$#{$parm{barcolors}} = $colormax if ($#{$parm{barcolors}} > $colormax);
$parm{barcolor} = ${$parm{barcolors}}[0];
}
else
{
$parm{barcolor} = ${$parm{barcolors}}[0];
}
my ($shadowcolor) = 'black';
if (defined($parm{shadowcolor}))
{
$shadowcolor = $parm{shadowcolor};
}
else
{
if (defined($parm{bgcolor}))
{
$shadowcolor = 'gray' if ($parm{bgcolor} =~ /black/i);
}
}
$parm{gridcolor} = $parm{barcolor} unless ($parm{gridcolor});
$parm{headercolor} = $parm{barcolor} unless ($parm{headercolor});
$parm{bordercolor} = 'black' unless ($parm{bordercolor});
$parm{shadowcolor} = $shadowcolor;
$ycnt = $#{$parm{xlegend}} + 1 if (defined($parm{xlegend}));
$ycnt = 1 unless ($ycnt > 1);
my ($yvalcnt) = $ycnt * ($#{$parm{xvals}}+1); #NO. OF YVALS THERE "SHOULD" BE.
for ($i=0;$i<$yvalcnt;$i++) #MAKE SURE ALL Y-VALUES HAVE A VALUE!
{
${$parm{yvals}}[$i] = '0' unless (${$parm{yvals}}[$i]);
#print "
yyyy=${$parm{yvals}}[$i]= cnt=$#{$parm{yvals}}=\n";
}
if ($parm{debug})
{
$ix = 0;
for ($j=0;$j<=$#{$parm{yvals}};$j+=$ycnt)
{
for ($i=0;$i<$ycnt;$i++) #DRAW ALL MULTIBARS FOR EACH X-VALUE.
{
$g .= "
$parm{xvals}[$i]: $parm{yvals}[$ix]\n";
}
}
return ($g);
}
if (defined($parm{yloval}))
{
#print "
----yloval defined as $parm{yloval}.\n";
$parm{ymin} = $parm{yloval};
$ymin = $parm{ymin};
}
else
{
$parm{ymin} = 99999;
$parm{ymin} = 0 if (defined($parm{yhival}));
}
if (defined($parm{yhival}))
{
#print "
----yhival defined as $parm{yhival}.\n";
$parm{ymax} = $parm{yhival};
$ymax = $parm{ymax};
}
else
{
$parm{ymax} = -99999;
}
#$parm{ymax} = $parm{yhival};
unless (defined($parm{yhival}) && defined($parm{yloval})) #CALCULATE HIGH AND LO Y-VALUES.
{
#print"
????? either yloval or yhival not defined! ycnt=$ycnt\n";
my ($ysum);
for ($j=0;$j<=$#{$parm{yvals}};$j+=$ycnt) #FIND LOWEST & HIGHEST Y.
{
$ysum = 0;
for ($i=0;$i<$ycnt;$i++)
{
$_ = $i + $j;
$ysum += ${$parm{yvals}}[$_];
#print "
???? ymin=$parm{ymin}= val=${$parm{yvals}}[$_]=\n";
}
if ($ysum < 0)
{
$parm{ymin} = $ysum unless ($parm{ymin} <= $ysum);
}
else
{
$parm{ymax} = $ysum unless ($parm{ymax} >= $ysum);
}
}
$parm{ymin} = 0 unless ($parm{ymin} < 0);
$parm{ymax} = 0 unless ($parm{ymax} > 0);
$parm{ymax} = 1 unless ($parm{ymax} || $parm{ymin}); #ADDED 20001205 TO HANDLE ALL ZEROS.
$ymin = $parm{ymin};
$ymax = $parm{ymax};
if ($parm{yInc} && defined($parm{ybase})) #FIND NEXT EVEN GRIDPOINTS.
{
unless ($parm{yloval})
{
$y = $parm{ybase};
$y -= $parm{yInc} while ($y > $parm{ymin});
$parm{ymin} = $y;
}
unless ($parm{yhival})
{
$y = $parm{ybase};
$y += $parm{yInc} while ($y < $parm{ymax});
$parm{ymax} = $y;
}
$parm{yInc} = ($parm{ymax} - $parm{ymin}) / $parm{ygrid}
if ($parm{ygrid} > 0);
}
else
{
my ($ygrid);
if (defined($parm{ygrid}))
{
$ygrid = $parm{ygrid};
}
else
{
$parm{ygrid} = 4;
}
if (defined($parm{ybase}))
{
$parm{ymin} = $parm{ybase} if ($parm{ymin} > $parm{ybase});
$parm{ymax} = $parm{ybase} if ($parm{ymax} < $parm{ybase});
my ($yrange) = $parm{ymax} - $parm{ymin};
if ($parm{ymin} < $parm{ybase} && $parm{ymax} > $parm{ybase})
{
for ($j=$parm{ygrid};$j>=$parm{ygrid}-1;$j--)
{
$parm{yInc} = &fincx($yrange,$j);
$ymin = $parm{ybase};
while ($ymin > $parm{ymin})
{
$ymin -= $parm{yInc};
}
$ymax = $ymin + $parm{yInc} * $parm{ygrid};
#print "
???2 Inc=$parm{yInc}= grid=$j= ymin=$ymin= ymax=$ymax= parm(ymax)=$parm{ymax}=\n";
last if ($ymax >= $parm{ymax});
}
$parm{ymin} = $ymin;
unless ($ygrid)
{
while ($parm{ygrid} && $ymax > $parm{ymax})
{
--$parm{ygrid};
$ymax -= $parm{yInc};
}
$parm{ygrid} = 1 unless ($parm{ygrid});
#print "
???3 Inc=$parm{yInc}= grid=$j= ymax=$ymax= parm(ymax)=$parm{ymax}=\n";
unless ($ymax >= $parm{ymax})
{
++$parm{ygrid};
$ymax += $parm{yInc};
}
}
$parm{ymax} = $ymax;
#print "
???4 Inc=$parm{yInc}= grid=$j= ymax=$ymax= parm(ymax)=$parm{ymax}=\n";
}
else
{
$parm{yInc} = &fincx($yrange,$parm{ygrid});
$parm{ymax} = $parm{yInc} * $parm{ygrid};
}
}
else
{
unless ($parm{yInc})
{
$parm{yInc} = &fincx(($parm{ymax} - $parm{ymin}),
$parm{ygrid});
$parm{ymax} = $parm{ymin} + $parm{yInc} * $parm{ygrid};
#print "
??? Inc=$parm{yInc}= grid=$parm{ygrid}= ymax=$ymax= parm(ymax)=$parm{ymax}=\n";
}
}
}
}
#print "
ymin=$parm{ymin}; ymax=$parm{ymax}; yInc=$parm{yInc}; \n";
unless ($parm{lmgn}) #CALCULATE LEFT MARGIN, IF NOT SPECIFIED.
{
if (length($parm{ymin}) > length($parm{ymax}))
{
$x = length(&commatize($parm{ymin}, $parm{commatize}));
}
else
{
$x = length(&commatize($parm{ymax}, $parm{commatize}));
}
$parm{lmgn} = ($x*$sfw) + 8;
$parm{lmgn} += $sfh + 2 if (defined($parm{ytitle}));
#print "
??? ymin=$parm{ymin}= ymax=$parm{ymax}= lmgn=$parm{lmgn}= x=$x=\n";
}
my ($xvallines) = 0;
foreach (@{@parm{xvals}})
{
(@l) = split(/\n/);
$xvallines = $#l if ($#l > $xvallines);
}
unless ($bmgn) #CALCULATE BOTTOM MARGIN, IF NOT SPECIFIED.
{
if ($parm{showvalues} =~ /bottom/i)
{
$parm{bmgn} = (($xvallines+1)*$sfh) + ((2+$#{$parm{xlegend}})*$sfh) + $sfh2 unless ($parm{bmgn}); #CALCULATE BOTTOM MARGIN, IF NOT SPECIFIED.
$parm{bmgn} += $sfh + 4 if ($parm{showvalues} =~ /total/i);
}
else
{
$parm{bmgn} = (($xvallines+1)*$sfh) + $sfh2 unless ($parm{bmgn}); #CALCULATE BOTTOM MARGIN, IF NOT SPECIFIED.
}
$parm{bmgn} += 8;
$parm{bmgn} += $sfh + 4 if (defined($parm{xtitle}));
$parm{bmgn} += ($xlegendycnt * $sfh2) + 2 if (defined($parm{xlegend}));
$parm{bmgn} += $sfh if ($parm{ymin} < $parm{ybase}); #ALLOW ROOM FOR VALUES BELOW DOWNWARD BARS.
$parm{bmgn} += $sfh2 if (defined($parm{barseplegend}));
#print "
vallines=$xvallines= sfh=$sfh= xleg=$#{$parm{xlegend}}=\n";
}
unless ($parm{maxxsiz})
{
#$parm{barxsiz} = 60 unless ($parm{barxsiz});
my $xvalcnt = $#{$parm{xvals}} + 1;
unless ($parm{barxsiz})
{
$x = 0;
foreach my $j (@{$parm{xvals}}) #FIND WIDEST X HEADER TO COMPUTE LINE SIZE.
{
#$i = $sfw * length($_); #CHGD. TO NEXT 20041006 TO ALLOW MULTI-LINE STRINGS.
@l = split(/\n/, $j);
while (@l)
{
$_ = shift(@l);
$i = $sfw * length($_);
$x = $i unless ($x > $i);
#print "-??????- i=$i= x=$x= cash=$_= ycnt=$ycnt=\n";
}
}
$parm{barxsiz} = $x + 4;
#$parm{barxsiz} = ($x + 4) * $ycnt;
#print "--- barxsiz :=$parm{barxsiz}=\n";
}
if ($parm{xbreak} > 0) #XBREAK STUFF ADDED 20001204 TO ALLOW GROUPING. (ADD HORIZONTAL SPACE AFTER EVERY NTH BAR).
{
if ($parm{xbreakpct}) #ADDED 20041005 TO SUPPORT BREAK GAPS < 1 FULL BAR WIDE.
{
$_ = $xvalcnt + ((($xvalcnt/($parm{xbreak}||1))-0.5)*$parm{xbreakpct})/100;
}
else
{
$_ = $xvalcnt + ($xvalcnt/($parm{xbreak}||1))-0.5;
}
$_ ||= 1;
$parm{maxxsiz} = ($parm{barxsiz} * $_)
+ $parm{lmgn} + $parm{rmgn} + $parm{lmgn2};
}
else
{
$parm{maxxsiz} = ($parm{barxsiz} * $xvalcnt)
+ $parm{lmgn} + $parm{rmgn} + $parm{lmgn2};
}
#print "-mxs=$parm{maxxsiz}= cash=$_= l=$parm{lmgn}, r=$parm{rmgn}, l2=$parm{lmgn2}\n";
if (defined($parm{xlegend})) #IF LEGENDS WIDER THAN CHART, WIDEN CHART!
{
# NEXT 9 REPLACED BY 12 LINES AT ~ 109L 20030417.
# $legendx = $parm{lmgn} / 2;
# $ix = 0;
# $i = $sfh + 7;
# foreach (@{$parm{xlegend}})
# {
# $legendx += $i + ($sfw * length(${$parm{xlegend}}[$ix]));
# #last if ($ix >= $ycnt);
# ++$ix;
# }
$parm{maxxsiz} = $legendx if ($parm{maxxsiz} < $legendx);
}
}
else
{
my $xvalcnt = $#{$parm{xvals}} + 1;
if ($parm{xbreak} > 0)
{
unless ($parm{barxsiz})
{
#NOTE - WE WANT A 1/2 GAP LEFT AFTER LAST BAR!
if ($parm{xbreakpct}) #ADDED 20041005 TO SUPPORT BREAK GAPS < 1 FULL BAR WIDE.
{
$_ = $xvalcnt + ((($xvalcnt/($parm{xbreak}||1))-0.5)*$parm{xbreakpct})/100;
}
else
{
$_ = $xvalcnt + ($xvalcnt/($parm{xbreak}||1))-0.5;
}
$_ ||= 1;
#print "
cash=$_= xvcnt=".$#{$parm{xvals}}."= xbreak=$parm{xbreak}= line=".__LINE__."=\n";
$parm{barxsiz} = ($parm{maxxsiz} - ($parm{lmgn2} + $parm{lmgn} + $parm{rmgn})) / $_;
#print "
-bxs=$parm{barxsiz}= mx=$parm{maxxsiz}= cash=$_= xvalcnt=$xvalcnt= xb=$parm{xbreak}= xbpct=$parm{xbreakpct}= l=$parm{lmgn}, r=$parm{rmgn}, l2=$parm{lmgn2}\n";
}
}
elsif ($#{$parm{xvals}} < 0) #ADDED 20030501 TO PREVENT DIVID-BY-ZERO.
{
$parm{barxsiz} = 10;
#$parm{barxsiz} = ($parm{maxxsiz} - ($parm{lmgn2} + $parm{lmgn} + $parm{rmgn})) / $xvalcnt unless ($parm{barxsiz});
}
else
{
$parm{barxsiz} = ($parm{maxxsiz} - ($parm{lmgn2} + $parm{lmgn} + $parm{rmgn})) / $xvalcnt unless ($parm{barxsiz});
#print "
-bxs=$parm{barxsiz}= mx=$parm{maxxsiz}= xvalcnt=$xvalcnt= xb=$parm{xbreak}= xbpct=$parm{xbreakpct}= l=$parm{lmgn}, r=$parm{rmgn}, l2=$parm{lmgn2}\n";
}
}
unless ($parm{maxysiz})
{
$parm{barysiz} = 1 unless ($parm{barysiz});
#print "
????? 1 ????? barysiz=$parm{barysiz}=\n";
$parm{maxysiz} = ($parm{barysiz} * ($parm{ymax} - $parm{ymin})) + $parm{bmgn} + $parm{tmgn};
}
else
{
#print "
??? maxy=$parm{maxysiz}, t=$parm{tmgn}; b=$parm{bmgn}; ymax=$parm{ymax}; ymin=$parm{ymin}; barysiz=$parm{barysiz}.\n";
$parm{barysiz} = ($parm{maxysiz} - ($parm{tmgn} + $parm{bmgn})) / ($parm{ymax} - $parm{ymin}) unless ($parm{barysiz});
}
#print "
barxsiz=$parm{barxsiz}; barysiz=$parm{barysiz};\n";
unless ($parm{barpct})
{
$parm{barpct} = 80;
$parm{barpct} = 100 if ($parm{barxsiz} < 10);
}
# if ($parm{xbreak} > 0) #CHGD. TO NEXT STMT. 20041006.
# {
# $chartxsiz = $parm{barxsiz} * ($#{$parm{xvals}}+1+int($#{$parm{xvals}}/$parm{xbreak})); #(PIXELS)
# }
# else
# {
# $chartxsiz = $parm{barxsiz} * ($#{$parm{xvals}}+1); #(PIXELS)
# }
# $chartxsiz += $parm{lmgn2};
$chartxsiz = $parm{maxxsiz} - ($parm{lmgn} + $parm{rmgn});
$chartysiz = $parm{barysiz} * ($parm{ymax} - $parm{ymin});
unless ($parm{ygrid}) #CALCULATE YGRID (# OF GRID LINES), IF NECESSARY.
{
##IF Y IS AN LOV, SET YGRID TO # OF ELEMENTS IN LOV!
if ($parm{yInc}) #IF YINC SET, USE YINC.
{
$parm{ygrid} = ($parm{ymax} - $parm{ymin}) / $parm{yInc} if ($parm{yInc});
}
else
{
$parm{ygrid} = 4;
}
}
unless ($parm{yInc})
{
$parm{yInc} = ($parm{ymax} - $parm{ymin}) / $parm{ygrid};
}
if ($parm{ybreak})
{
while ( (($ymax == 0) || (($ymax * $parm{ybreak}) < $parm{ymax}))
&& (($ymin == 0) || (($ymin * $parm{ybreak}) > $parm{ymin})))
{
$parm{ymax} /= 2;
$parm{ymin} /= 2;
$parm{yInc} /= 2;
$parm{yinc} /= 2;
$parm{barysiz} *= 2;
}
}
$parm{ybase} = $parm{ymin} unless (defined($parm{ybase}));
#print "
----final values: maxxsiz=$parm{maxxsiz}; maxysiz=$parm{maxysiz}; ybase=$parm{ybase}; yInc=$parm{yInc}; ygrid=$parm{ygrid}= ymax=$parm{ymax}.\n";
$g = new GD::Image($parm{maxxsiz},$parm{maxysiz});
#CONVERT COLOR NAMES TO RGB VALUES.
#print "
colors =".join('|',@{$parm{barcolors}})."=\n";
if (open(RGB,")
{
chomp;
($rr,$gg,$bb,$color) = split(' ');
$color = "\L$color\E";
foreach (qw(bar bg val axis grid title valx header border shadow barsep))
{
$x = $parm{$_."color"};
${$_."colr"} = $g->colorAllocate($rr,$gg,$bb) if ($color eq "\L$x\E");
}
for($j=0;$j<=$#{$parm{barcolors}};$j++)
{
if ($color eq "\L${$parm{barcolors}}[$j]\E")
{
$i = $g->colorAllocate($rr,$gg,$bb);
$barcolrs[$j] = $i;
}
}
if (defined($parm{barsepcolors}))
{
for($j=0;$j<=$#{$parm{barsepcolors}};$j++)
{
if ($color eq "\L${$parm{barsepcolors}}[$j]\E")
{
$i = $g->colorAllocate($rr,$gg,$bb);
$barsepcolrs[$j] = $i;
}
}
}
}
close (RGB);
my (@colorindex) = (0..$#{$parm{barcolors}});
# for ($j=0;$j<$parm{shiftcolors};$j++)
# {
# $ix = shift(@barcolrs);
# @barcolrs = (@barcolrs,$ix);
# }
}
#SET UP DEFAULTS FOR ANY MISSING COLORS.
$barcolr = $g->colorAllocate(0,0,0) unless ($barcolr);
$valcolr = $g->colorAllocate(0,0,0) unless ($valcolr);
$axiscolr = $g->colorAllocate(0,0,0) unless ($axiscolr);
$gridcolr = $g->colorAllocate(0,0,0) unless ($gridcolr);
$shadowcolr = $g->colorAllocate(0,0,0) unless ($shadowcolr);
#$bgcolr = $g->colorAllocate(127,127,127) unless ($bgcolr);
#print "
bc=$#barcolrs= cm=$colormax=\n";
if ($#barcolrs <= 0) #FILL OUT COLOR ARRAY WITH BAR-COLOR IF NOT SPECIFIED.
{
for ($j=0;$j<=$colormax;$j++)
{
$barcolrs[$j] = $barcolr;
}
}
elsif ($#barcolrs < $colormax) #FILL OUT COLOR ARRAY TO MATCH Y-ARRAY.
{
my $colorcnt = $#barcolrs;
for ($j=$colorcnt+1;$j<$colormax;$j++)
{
#print "
-will set barcolor($j) :=$barcolrs[($j % $colorcnt)]= ($j % $colorcnt)\n";
$barcolrs[$j] = $barcolrs[($j % $colorcnt)];
}
}
#print "
colors =".join('|',@barcolrs)."= cm=$colormax= bccnt=$#barcolrs=\n";
if (defined($parm{bgcolor}))
{
#print "
??? bgcolor=$parm{bgcolor}= bgcolr=$bgcolr=\n";
#$g->transparent($bgcolr); #MAKE THE BACKGROUND COLOR TRANSPARENT.
$g->fill(1,1,$bgcolr);
}
for (0..($parm{border}-1))
{
$g->rectangle($_,$_,($parm{maxxsiz}-($_+1)),($parm{maxysiz}-($_+1)),$bordercolr);
}
my $barylo = $parm{tmgn} + ($chartysiz * (($parm{ymax}-$parm{ybase}) / ($parm{ymax}-$parm{ymin})));
#goto SKIPIT1;
#DRAW THE X AND Y AXES.
$g->line($parm{lmgn},$barylo,($parm{lmgn}+$chartxsiz),$barylo,$axiscolr);
$g->line($parm{lmgn},$parm{tmgn},$parm{lmgn},($parm{tmgn}+$chartysiz),$axiscolr);
if (defined $parm{barseps}) #ADDED 20030903 TO SUPPORT VERTICAL SEPARATORS BETWEEN BARS.
{
my $s;
my $justify = '|';
my $x;
if (ref($parm{barseps}) =~ /ARRAY/i)
{
for (my $i=0;$i<=$#{$parm{barseps}};$i++)
{
$g->line($parm{lmgn}+($parm{barseps}->[$i]*$parm{barxsiz}),$parm{tmgn}-4,
$parm{lmgn}+($parm{barseps}->[$i]*$parm{barxsiz}),($parm{tmgn}+$chartysiz+4),
(defined $barsepcolrs[$i]) ? $barsepcolrs[$i]
: ($barsepcolr||$axiscolr));
#ADDED 20030903 TO SUPPORT LEGEND TEXT ABOVE VERTICAL LINES.
if (defined $parm{barseptoplegend} && ref($parm{barseptoplegend}) =~ /ARRAY/i)
{
$s = $parm{barseptoplegend}->[$x];
$justify = $1 if ($s =~ s/^([\<\|\>])//);
$x = $parm{lmgn}+($parm{barseps}->[$i]*$parm{barxsiz})+2;
if ($justify eq '<')
{
$x -= (length($s)*$sfw) + 2;
}
elsif ($justify eq '|')
{
$x -= (length($s)*$sfw) / 2;
}
$g->string(gdSmallFont, $x, $parm{tmgn}-(2+$sfh), $s,
$headercolr);
}
}
}
else
{
$g->line($parm{lmgn}+($parm{barseps}*$parm{barxsiz}),$parm{tmgn}-4,
$parm{lmgn}+($parm{barseps}*$parm{barxsiz}),($parm{tmgn}+$chartysiz+4),
($barsepcolr||$axiscolr));
#ADDED 20030903 TO SUPPORT LEGEND TEXT ABOVE VERTICAL LINES.
if (defined $parm{barseptoplegend})
{
$s = $parm{barseptoplegend};
$justify = $1 if ($s =~ s/^([\<\|\>])//);
$x = $parm{lmgn}+($parm{barseps}*$parm{barxsiz})+2;
if ($justify eq '<')
{
$x -= (length($s)*$sfw) + 2;
}
elsif ($justify eq '|')
{
$x -= (length($s)*$sfw) / 2;
}
$g->string(gdSmallFont, $x, $parm{tmgn}-(2+$sfh), $s,
$headercolr);
}
}
}
#NOW DRAW THE HORIZ. GRID LINES
my $ydelta = $parm{barysiz} * $parm{yInc};
#print "
??? ydelta=$ydelta= barysiz=$parm{barysiz}= Inc=$parm{yInc}.\n";
my $yhead = $yparm{base};
my $yheadxmax = length("$yhead") if(defined($parm{ytitle}));
$g->string(gdSmallFont,$parm{lmgn}-((length("$yhead")*$sfw)+3),$barylo-($sfh/2),
"$yhead",$headercolr);
## $yhead = $parm{ybase} + $parm{yInc};
$yhead = $parm{ybase};
## $y = $barylo - $ydelta;
$y = $barylo;
while ($y >= $parm{tmgn}-1)
{
$myyval = &commatize($yhead,$parm{commatize});
$g->line($parm{lmgn}-4,$y,($parm{lmgn}+$chartxsiz),$y,$gridcolr);
#print "
???-LINE($parm{lmgn}-4,$y,($parm{lmgn}+$chartxsiz),$y,$gridcolr)";
$g->string(gdSmallFont,$parm{lmgn}-((length($myyval)*$sfw)+3),$y-($sfh/2),
$myyval,$headercolr);
$y -= $ydelta;
$yheadxmax = length($myyval) if (defined($parm{ytitle}) && (length($myyval) > $yheadxmax));
$yhead += $parm{yInc};
}
$yhead = $parm{ybase} - $parm{yInc};
$y = $barylo + $ydelta;
while ($y <= ($parm{tmgn} + $chartysiz)+1)
{
$myyval = &commatize($yhead,$parm{commatize});
$g->line($parm{lmgn}-4,$y,($parm{lmgn}+$chartxsiz),$y,$gridcolr);
$g->string(gdSmallFont,$parm{lmgn}-((length($myyval)*$sfw)+3),$y-($sfh/2),
$myyval,$headercolr);
$y += $ydelta;
$yhead -= $parm{yInc};
}
if ($parm{yinc} > 1) #DRAW THE HORIZ. TICKMARKS, IF NEEDED.
{
$ydelta = ($parm{barysiz} * $parm{yInc}) / $parm{yinc};
$y = $barylo;
while ($y > $parm{tmgn})
{
$g->line($parm{lmgn}-2,$y,$parm{lmgn},$y,$gridcolr);
$y -= $ydelta;
}
$y = $barylo;
while ($y < ($parm{tmgn} + $chartysiz))
{
$g->line($parm{lmgn}-2,$y,$parm{lmgn},$y,$gridcolr);
$y += $ydelta;
}
}
#SET UP IMAGE MAPPING, IF APPLICABLE.
if (defined($parm{links}) || defined($parm{mouseovers})
|| defined($parm{link}) || defined($parm{mouseover}
|| defined($parm{legendlinks})))
{
$parm{mapname} = "BarChart.$$" unless (defined($parm{mapname}));
$mapstr = '