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 = '' . "\n"; #print "
??? MAP NAME=$parm{mapname}= mapstr=$mapstr=\n"; } #DRAW THE BARS. SKIPIT: my $barxpix = ($parm{barxsiz} * $parm{barpct}) / 100; #my $barxbase = $parm{lmgn} + (((100-$parm{barpct})*$parm{barxsiz})/200) + $parm{lmgn2}; my $barxbase; if ($parm{lmgn2}) { $barxbase = $parm{lmgn} + $parm{lmgn2}; } else #THROUGH IN A FUDGEFACTOR OF 1/2 THE GAP SO 1ST BAR WON'T ABUT LEFT EDGE OF CHART. { #NOTE - THIS MAY CAUSE LAST BAR TO HANG OVER INTO RIGHT-MARGIN. $barxbase = $parm{lmgn} + (((100-$parm{barpct})*$parm{barxsiz})/200) + $parm{lmgn2}; } #print "-barxbase=$barxbase= bpct=$parm{barpct}=\n"; my $barxlo = $barxbase; $ix = 0; #$barcolr = $barcolrs[$ix]; my $rightedge = $parm{lmgn} + $chartxsiz; my $colorcnt = $#barcolrs + 1; my $barxpix1 = $barxpix + 1; #$colorcnt = $ycnt if ($ycnt > 1 && $colorcnt > $ycnt); $colorcnt = $colormax; $colorcnt = 1 if ($colorcnt <= 0); #print "
pccnt=$#barcolrs= ycnt=$ycnt= colorcnt=$colorcnt= \n"; #SOME VARIABLES TO SAVE ARITHMETIC IN LOOPS. my ($linkbottom) = $parm{tmgn} + $chartysiz + $sfh + 4; my ($chartbottom2) = $parm{tmgn} + $chartysiz + 2; $chartbottom2 += $sfh if ($parm{ymin} < $parm{ybase}); #ALLOW ROOM FOR VALUES BELOW DOWNWARD BARS. #my ($chartbottom3) = $parm{tmgn} + $chartysiz + $sfh*$xvallines + 2; my ($chartbottom3) = $chartbottom2 + $sfh*$xvallines + $sfh2 + 2; $legendy = $chartbottom3; $legendy += $sfh + 4 if (defined($parm{xtitle})); if ($parm{showvalues} =~ /bottom/i) { $legendy += $#{$parm{xlegend}}*$sfh + 2*$sfh; $legendy += $sfh + 4 if ($parm{showvalues} =~ /total/i); } #print "
??? bm=$parm{bmgn}= cys=$chartysiz= cb3=$chartbottom3 ly=$legendy=\n"; my ($ycnt_1) = $ycnt - 1; my ($ylast); my @legendx; for (my $k=0;$k<$xlegendycnt;$k++) { $legendx[$k] = $parm{lmgn} / 2; } my ($llegendx) = $parm{lmgn} - $sfh; $llegendx = 0 unless ($llegendx > 0); if ($parm{showvalues} =~ /bottom/i) { $g->line($parm{lmgn}, $chartbottom3-2, ($parm{lmgn}+$chartxsiz), $chartbottom3-2, $headercolr); $g->line($parm{lmgn}, $chartbottom3+($ycnt*$sfh2), ($parm{lmgn}+$chartxsiz), $chartbottom3+($ycnt*$sfh2), $headercolr) if ($parm{showvalues} =~ /total/i); } #print "
**************** xvalcnt=".$#{$parm{xvals}}."= xbreak=$parm{xbreak}= cnt=".($#{$parm{xvals}}+1+int($#{$parm{xvals}}/$parm{xbreak}))."=\n"; my $xbreakpct = $parm{xbreakpct} || 100; #ADDED 20041005 TO SUPPORT BREAK GAPS < 1 FULL BAR WIDE. for ($j=0;$j<=$#{$parm{yvals}};$j+=$ycnt) { $barxbase += ($parm{barxsiz}*$xbreakpct)/100 if ($ix && $parm{xbreak} && !($ix % $parm{xbreak})); $barxlo = $barxbase; #print "-?????- barxlo=$barxlo= cxsz=$chartxsiz=\n"; #$barylo = $parm{tmgn} + $chartysiz; $barylo = $parm{tmgn} + ($chartysiz * (($parm{ymax}-$parm{ybase}) / ($parm{ymax}-$parm{ymin}))); $baryhi = $barylo; $ylast = $parm{ybase}; next if ($barxlo > $rightedge); #AVOID PRINTING BARS OFF CHART! if (defined($parm{links}[$ix]) || defined($parm{mouseovers}) #ADD HYPERLINK, IF ANY, TO BAR. || defined($parm{link}) || defined($parm{mouseover})) { $l = 'HREF="//'; if (defined($parm{links}[$ix]) || defined($parm{link})) { $parm{links}[$ix] = $parm{link} unless($parm{links}[$ix]); $l = ' HREF="' . $parm{links}[$ix]; unless ($l =~ m#\"\s*(http\:|\/)#) { $l = 'HREF="' . $parm{linkpath}; #$l .= uri_escape($parm{links}[$ix]) unless ($l =~ s#\*#uri_escape($parm{links}[$ix])#e); #CHGD. TO NEXT 20050204 TO GET ALL OF 'EM! $l .= uri_escape($parm{links}[$ix]) unless ($l =~ s#\*#uri_escape($parm{links}[$ix])#e); } } $l .= '"'; $mapstr .= 'string(gdSmallFont, ($barxlo+($parm{barxsiz}*($parm{barpct}/100)-(length(${$parm{yvals}}[$_])*$sfw))), #print "
1:myyval=$myyval= x=".($barxlo+($parm{barxsiz}*($parm{barpct}/100)-(length($myyval)*$sfw)))."=\n"; #WRITE OUT BOTTOM VALUES. $g->string(gdSmallFont, ($barxlo+($parm{barxsiz}*($parm{barpct}/100)-(length($myyval)*$sfw))), ($chartbottom3+(($ycnt-($i+1))*$sfh2)),$myyval,$headercolr) if ($parm{showvalues} =~ /bottom/i); unless ($barylo == $baryhi) { #print "
yval($_)=${$parm{yvals}}[$_]= YBASE=$parm{ybase}= ylo=$barylo=\n"; if (${$parm{yvals}}[$_] < $parm{ybase}) #DRAWING BAR BELOW AXIS (NEGATIVE VALUES). { $g->filledRectangle($barxlo,$barylo,($barxlo+$barxpix),$baryhi,$barcolrs[($_ % $colorcnt)]); if ($parm{shadow}) { $g->filledRectangle($barxlo+$barxpix+1, $barylo, ($barxlo+$barxpix+$parm{shadow}+1), ($baryhi+1-$parm{shadow}), $shadowcolr); } } else #DRAWING BAR ABOVE AXIS (POSITIVE VALUES). { $g->filledRectangle($barxlo,$baryhi,($barxlo+$barxpix),$barylo,$barcolrs[($_ % $colorcnt)]); if ($parm{shadow}) { $g->filledRectangle(($barxlo+$parm{shadow}), ($baryhi-$parm{shadow}), ($barxlo+$barxpix+$parm{shadow}), ($baryhi-1), $shadowcolr); $g->filledRectangle($barxlo+$barxpix+1, $baryhi-$parm{shadow}, ($barxlo+$barxpix+$parm{shadow}+1), ($barylo-$parm{shadow}), $shadowcolr); } } } #$barylo = $baryhi; unless ($i < $ycnt_1) { (@l) = split(/\n/,${$parm{xvals}}[$ix]); for ($k=0;$k<=$#l;$k++) { $g->string(gdSmallFont, ($barxlo+($parm{barxsiz}*($parm{barpct}/100)-(length($l[$k])*$sfw))/2), ($chartbottom2+($k*$sfh)),$l[$k],$headercolr); } #$g->string(gdSmallFont, ($barxlo+($parm{barxsiz}*($parm{barpct}/100)-(length(${$parm{yvals}}[$_])*$sfw))/2), # ($chartbottom2+($k*$sfh)),$ysum,$headercolr); if ($parm{showvalues} =~ /total/i) { $myyval = &commatize($ysum, $parm{commatize}); if ($ysum < 0) #DISPLAY TOTALS WHERE THEY SHOULD GO { #$ysum = '(' . $ysum . ')'; if ($parm{showvalues} =~ /bottom/i) { #ADDED 20001204 TO SHOW TOTALS AFTER STACK TOTALS AT BOTTOM. #$g->string(gdSmallFont, ($barxlo+($parm{barxsiz}*($parm{barpct}/100)-(length(${$parm{yvals}}[$_])*$sfw))), # ($chartbottom3+($ycnt*$sfh2)+2),$myyval,$headercolr); $g->string(gdSmallFont, ($barxlo+($parm{barxsiz}*($parm{barpct}/100)-(length($myyval)*$sfw))), ($chartbottom3+($ycnt*$sfh2)+2),$myyval,$headercolr); $g->string(gdSmallFont,($barxlo+($barxpix-(length($myyval)*$sfw))/2), $baryhi+1,$myyval,$valxcolr) if ($parm{showvalues} =~ /top/i); } # elsif (($baryhi >= ($barylo+$sfh)) && ((length($myyval)*$sfw) <= $barxpix1)) # { ##print "
---fits!\n"; # #$g->string(gdSmallFont,($barxlo+($barxpix-(length($myyval)*$sfw))/2), # # $baryhi-$sfh,$myyval,$valcolr); # $g->string(gdSmallFont,($barxlo+($barxpix-(length($myyval)*$sfw))/2), # $baryhi-$sfh,$myyval,$valcolr); # } else { #print "
---does not fit!\n"; $g->string(gdSmallFont,($barxlo+($barxpix-(length($myyval)*$sfw))/2), $baryhi+1,$myyval,$valxcolr); } #$g->string(gdSmallFont,($barxlo+($barxpix-(length($myyval)*$sfw))/2), # $baryhi+1,$myyval,$valxcolr); } else { #$myyval = '(' . $myyval . ')'; if ($parm{showvalues} =~ /bottom/i) { #ADDED 20001204 TO SHOW TOTALS AFTER STACK TOTALS AT BOTTOM. #$g->string(gdSmallFont, ($barxlo+($parm{barxsiz}*($parm{barpct}/100)-(length(${$parm{yvals}}[$_])*$sfw))), $g->string(gdSmallFont, ($barxlo+($parm{barxsiz}*($parm{barpct}/100)-(length($myyval)*$sfw))), ($chartbottom3+($ycnt*$sfh2)+2),$myyval,$headercolr); #($chartbottom3+4),$myyval,$headercolr); $g->string(gdSmallFont,($barxlo+($barxpix-(length($myyval)*$sfw))/2), $baryhi-$sfh,$myyval,$valxcolr) if ($parm{showvalues} =~ /top/i); } # elsif (($barylo >= ($baryhi+$sfh)) && ((length($myyval)*$sfw) <= $barxpix1)) # { # #$g->string(gdSmallFont,($barxlo+($barxpix-(length($myyval)*$sfw))/2), # # $baryhi+1,$myyval,$valcolr); # $g->string(gdSmallFont,($barxlo+($parm{barxsiz}*($parm{barpct}/100)-(length($myyval)*$sfw))), # $baryhi+1,$myyval,$valcolr); # } else { #$g->string(gdSmallFont,($barxlo+($barxpix-(length($myyval)*$sfw))/2), # $baryhi-$sfh,$myyval,$valxcolr); $g->string(gdSmallFont,($barxlo+($barxpix-(length($myyval)*$sfw))/2), $baryhi-$sfh,$myyval,$valxcolr); } } } #!!! if (defined($parm{barseplegend})) #MOVED HERE 20030903. { my $mylegendx = ($parm{lmgn} + $sfh) /2; my $myycenter = $legendy + $sfh2; for (my $x=0;$x<=$#{$parm{barseplegend}};$x++) { $g->line($mylegendx, $myycenter, $mylegendx, ($myycenter+$sfh), (defined $barsepcolrs[$x]) ? $barsepcolrs[$x] : ($barsepcolr||$axiscolr)); $g->string(gdSmallFont, $mylegendx+$sfw, $myycenter, $parm{barseplegend}->[$x], $headercolr); $mylegendx += ($sfw * length($parm{barseplegend}->[$x])) + 10 + $sfw; } } } $barylo = $baryhi; } $ix++; $barxbase += $parm{barxsiz}; } #BUGFIX BY STAN PINTE (Thanks, Stan!) if (defined($parm{xlegend})) { my $ix = 0; my $i = 0; foreach $legendItem (@{$parm{xlegend}}) { if (defined($legendItem)) { @l = split(/\n/, $legendItem); $llegendx = $parm{lmgn} - $sfh; $llegendx = 0 unless ($llegendx > 0); for (my $k=0;$k<$xlegendycnt;$k++) { if (length($l[$k])) { $g->filledRectangle($legendx[$k],$legendy+($k*$sfh2),($legendx[$k]+$sfh),($legendy+($k*$sfh2)+$sfh), $barcolrs[$ix+($k*$ycnt)]); #DRAW RECTANGLES LEFT OF XLEGEND VALUES. if ($parm{showvalues} =~ /bottom/i) #DRAW LITTLE LEGEND RECTANGLES LEFT OF "BOTTOM" VALUES. { $g->filledRectangle($llegendx,($chartbottom3+(($ycnt-($ix+1))*$sfh2)), $llegendx+int($sfh / $xlegendycnt),(($chartbottom3+(($ycnt-($ix+1))*$sfh2))+$sfh), $barcolrs[$ix+($k*$ycnt)]); } $g->string(gdSmallFont,$legendx[$k]+$sfh2+4,$legendy+($k*$sfh2),$l[$k], $headercolr); #print "
legend($k) =$legendx[$k]= extra=".($sfh2 + ($sfw * length($l[$k]))+2)."=\n"; if ($parm{legendlinks}[$i]) { $mapstr .= '\n"; ."\">\n"; $mapstr =~ s#\*#$parm{legendlinks}[$i]#; #print "
??? ix=$ix= i=$i= l=$parm{legendlinks}[$i]=\n"; } } $legendx[$k] += $sfh2 + ($sfw * length($l[$k])) + 10; $llegendx += int($sfh / $xlegendycnt); #print "
??? llegendx=$llegendx=\n"; $i++; } } ++$ix; } } if ($parm{showvalues} =~ /bar/i) { $barxbase = $parm{lmgn} + (((100-$parm{barpct})*$parm{barxsiz})/200); $barxlo = $barxbase; $ix = 0; for ($j=0;$j<=$#{$parm{yvals}};$j+=$ycnt) { $barxlo = $barxbase; #$barylo = $parm{tmgn} + $chartysiz; $barylo = $parm{tmgn} + ($chartysiz * (($parm{ymax}-$parm{ybase}) / ($parm{ymax}-$parm{ymin}))); $baryhi = $barylo; $ylast = $parm{ybase}; #$vcolr = $valcolr; next if ($barxlo > $rightedge); #AVOID PRINTING BARS OFF CHART! for ($i=0;$i<$ycnt;$i++) #DRAY ALL MULTIBARS FOR EACH X-VALUE. { $_ = $i + $j; #$vcolr = $valxcolr if ($i >= ($ycnt-1)); #COLOR IF PRINTING OUTSIDE ALL BARS. #PRINT X HEADERS $ylast += ${$parm{yvals}}[$_]; $baryhi = $parm{tmgn} + ($chartysiz * (($parm{ymax}-$ylast) / ($parm{ymax}-$parm{ymin}))); if (${$parm{yvals}}[$_] < $parm{ybase}) { if (($baryhi >= ($barylo+$sfh)) && ((length("${$parm{yvals}}[$_]")*$sfw) <= $barxpix1)) { $g->string(gdSmallFont,($barxlo+($barxpix-(length(${$parm{yvals}}[$_])*$sfw))/2), $baryhi-$sfh,"${$parm{yvals}}[$_]",$valcolr); } #else #BAR TOO SMALL, PRINT LABEL BELOW BAR. #{ # $g->string(gdSmallFont,($barxlo+($barxpix-(length(${$parm{yvals}}[$_])*$sfw))/2), # $baryhi+1,"${$parm{yvals}}[$_]",$vcolr); #} } else { if (($barylo >= ($baryhi+$sfh)) && ((length("${$parm{yvals}}[$_]")*$sfw) <= $barxpix1)) { $g->string(gdSmallFont,($barxlo+($barxpix-(length(${$parm{yvals}}[$_])*$sfw))/2), $baryhi+1,"${$parm{yvals}}[$_]",$valcolr); } #else #BAR TOO SMALL, PRINT LABEL ABOVE BAR. #{ # $g->string(gdSmallFont,($barxlo+($barxpix-(length(${$parm{yvals}}[$_])*$sfw))/2), # $baryhi-$sfh,"${$parm{yvals}}[$_]",$vcolr); #} } $barylo = $baryhi; } $ix++; $barxbase += $parm{barxsiz}; } } if (defined($parm{links}) || defined($parm{mouseovers}) || defined($parm{link}) || defined($parm{mouseover})) { $l = 'HREF="//'; if (defined($parm{link})) { $l = 'HREF="' . $parm{link}; #$l = $parm{linkpath} . $l unless ($l =~ m#^\s*(http\:|\/)#); unless ($l =~ m#\"\s*(http\:|\/)#) { $l = "HREF=\"$parm{linkpath}"; #$l .= $parm{link} unless ($l =~ s#\*#$parm{link}#); #CHGD. TO NEXT 20050204 TO GET ALL OF 'EM! $l .= $parm{link} unless ($l =~ s#\*#$parm{link}#g); } } $l .= '"'; if (defined($parm{link}) || defined($parm{mouseover} || defined($parm{legendlinks}))) { $mapstr .= 'string(gdLargeFont,(($chartxsiz - ($lfw*length($parm{title})))/2) + $parm{lmgn}, # ($parm{tmgn} - $lfh) / 2, $parm{title}, $titlecolr); #CHGD. TO NEXT 20030417 TO MAKE TITLE APPEAR CENTERED IN CHART RATHER THAN ABOVE GRAPH. #THIS LOOKS BETTER ESPECIALLY WHEN GRAPH IS ONLY ON LEFT SIDE OF CHART. #$g->string(gdLargeFont,(($parm{maxxsiz} - ($lfw*length($parm{title})))/2), # ($parm{tmgn} - $lfh) / 2, $parm{title}, $titlecolr); #CHGD. TO NEXT (FOR-LOOP) 20030430 TO SUPPORT MULTILINE TITLES! for (my $i=0;$i<=$#titles;$i++) { $g->string(gdLargeFont,(($parm{maxxsiz} - ($lfw*length($titles[$i])))/2), (($parm{tmgn} - (scalar(@titles)*($lfh+2))) / 2)+(($lfh+2)*$i), $titles[$i], $titlecolr); } } if (defined($parm{xtitle})) { $g->string(gdSmallFont, (($chartxsiz - ($sfw*length($parm{xtitle})))/2) + $parm{lmgn}, $legendy-($sfh2+4), $parm{xtitle}, $titlecolr); #print "
??? legendy=$legendy= sfh2=$sfh2=\n"; } if (defined($parm{lrtitle})) #ADDED 20030506 TO ADD LOWER-RIGHT CORNER TITLE. { $_ = ($parm{lmgn}+$chartxsiz) - ($sfw*length($parm{lrtitle})); #print "
cash=$_= legendx=".($legendx[$#legendx])."=\n"; if ($_ >= $legendx[$#legendx]) { $g->string(gdSmallFont, ($parm{lmgn}+$chartxsiz) - ($sfw*length($parm{lrtitle})), ($parm{maxysiz}-(2*$sfh+2)), $parm{lrtitle}, $titlecolr); } } if (defined($parm{ytitle})) { $i = $sfw*length($parm{ytitle}); $g->stringUp(gdSmallFont, ((($parm{lmgn}-$yheadxmax)-$sfh)-$sfh) / 2, (($chartysiz - $i)/2) + $i + $parm{tmgn}, $parm{ytitle}, $titlecolr); } #print "
mapstr=$mapstr=\n"; return ($g,$mapstr); } sub fincx { my ($x,$grid) = @_; my ($i, $i1, $j, $k, $ystep, $yinc, $carry); $yinc = int($x / $grid); #print "
---yinc=$yinc= grid=$grid= x=$x=\n"; $yinc += 1 unless (($yinc * $grid) >= $x); $ylen = length($yinc); my @ydigits = split(//,$yinc); for ($i=$ylen-2;$i>=0;$i--) { $i1 = $i + 1; #print "
????? yinc=$yinc= digits($i,$i1) =$ydigits[$i]=$ydigits[$i1]=\n"; if ($ydigits[$i] > 0 && $ydigits[$i] <= 2) { if ($ydigits[$i1] > 0 && $ydigits[$i1] < 5) { $ydigits[$i1] = 5; for ($k=$i1+1;$k<=$#ydigits;$k++) { $ydigits[$k] = 0; } } elsif ($ydigits[$i1] > 5 && $ydigits[$i1] <= 9) { $ydigits[$i1] = 0; $j = $i; #print "****** dig($j)=$ydigits[$j]=\n"; while ($j >= 0) { if ($ydigits[$j] < 9) { ++$ydigits[$j]; #print "*** dig($j) now =$ydigits[$j]= ..done.\n"; $carry = 0; last; } for ($k=$j;$k<=$#ydigits;$k++) { $ydigits[$k] = 0; } $carry = 1; --$j; #print "*** j decremented=$j=\n"; } #print "*** appending 1 to left of ".join('',@ydigits)."!\n" if ($carry); @ydigits = (1,@ydigits) if ($carry); } } elsif ($ydigits[$i1] > 0) { #$ydigits[$i1] = 0; for ($k=$i1;$k<=$#ydigits;$k++) { $ydigits[$k] = 0; } $j = $i; while ($j >= 0) { if ($ydigits[$j] < 9) { ++$ydigits[$j]; $carry = 0; last; } for ($k=$j;$k<=$#ydigits;$k++) { $ydigits[$k] = 0; } $carry = 1; --$j; } @ydigits = (1,@ydigits) if ($carry); } } $yinc = join('',@ydigits); #print "
------- factor=$factor= yinc now=$yinc=\n"; return $yinc; } sub commatize { my ($val) = shift; my ($doit) = shift; return ($val) unless ($doit); $val = sprintf('%.0f',$val); $val =~ s/(\d)(\d\d\d)$/$1,$2/; $val =~ s/(\d)(\d\d\d),/$1,$2,/g; $val = '(' . $val . ')' if ($val =~ s/^\-//); return ("$val"); } 1