use GD; sub PieChart { my %parm; my (@barcolrs); my ($g, $v); #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"; my ($h, $i, $j, $legendx, $legendy, $legendxsiz, $legendysiz, $mapstr); my ($lasttheta, $lastthetax); #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 ($sfw,$sfh) = (gdSmallFont->width,gdSmallFont->height); my ($lfw,$lfh) = (gdLargeFont->width,gdSmallFont->height); #SET UP PARAMETER DEFAULTS. $parm{rmgn} = 20 unless($parm{rmgn}); #NEXT LINE ADDED 20030917. my @titles = split(/\n|\/i, $parm{title}) if (defined($parm{title})); unless($parm{tmgn}) { $parm{tmgn} = 20; #$parm{tmgn} += $lfh + 6 if (defined($parm{title})); #CHGD. TO NEXT LINE 20030917. $parm{tmgn} += ($lfh+2)*scalar(@titles) + $sfh + 6 if ($#titles >= 0); #ADDED 20030527 TO SUPPORT MULTILINE TITLES! } unless ($parm{lmgn}) #CALCULATE LEFT MARGIN, IF NOT SPECIFIED. { $parm{lmgn} = 20; $parm{lmgn} += $sfh + 6 if (defined($parm{ytitle})); } unless ($parm{bmgn}) #CALCULATE BOTTOM MARGIN, IF NOT SPECIFIED. { $parm{bmgn} = 20; #CALCULATE BOTTOM MARGIN, IF NOT SPECIFIED. $parm{bmgn} += $sfh + 6 if (defined($parm{xtitle})); } $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{gridcolor} = $parm{barcolor} unless ($parm{gridcolor}); $parm{titlecolor} = $parm{axiscolor} unless ($parm{titlecolor}); $parm{headercolor} = $parm{barcolor} unless ($parm{headercolor}); $parm{valxcolor} = $parm{headercolor} unless ($parm{valxcolor}); #$parm{barcolors} = [qw(purple SteelBlue DarkGreen Yellow3 darkorange brown4 skyblue olivedrab khaki salmon gray bisque4)] unless(defined($parm{barcolors})); $parm{barcolors} = [qw(SteelBlue gray brown4 khaki DarkGreen salmon skyblue bisque3 purple yellow2 olivedrab darkorange darkcyan)] unless(defined($parm{barcolors})); $#{$parm{barcolors}} = $#{$parm{xvals}} if ($#{$parm{barcolors}} > $#{$parm{xvals}}); $parm{bordercolor} = 'black' unless ($parm{bordercolor}); unless (defined($parm{shadowcolor})) { $parm{shadowcolor} = 'black'; if (defined($parm{bgcolor})) { $parm{shadowcolor} = 'gray30' if ($parm{bgcolor} =~ /black/i); #print "-???- bg=$parm{bgcolor}= sc=$parm{shadowcolor}=\n"; } else { $parm{bgcolor} = 'white'; } } $parm{legendsiz} = (1.5*$sfh) unless (defined($parm{legendsiz})); $bulletxsiz = $parm{legendsiz} + 8; $bulletysiz = 75; $legendxsiz = 0; $legendysiz = $parm{legendsiz} + 4; $x = 0; for (0..$#{$parm{xvals}}) #CALC. NECESSARY SPACE FOR LEGEND ITEMS. { $l = length($parm{xvals}[$_]) * $sfw; $legendxsiz = $l unless ($legendxsiz > $l); $l = length($parm{yvals}[$_]) * $sfw; $x = $l unless ($x > $l); $legendysiz += $parm{legendsiz} + 4; } $l = int($x / $sfw); for (0..$#{$parm{yvals}}) #RIGHT-JUSTIFY LEGEND VALUES, IF NUMERIC. { $parm{yvals}[$_] = '0' unless ($parm{yvals}[$_] =~ /\d/); #ADDED 20030404 TO ENSURE SOMETHING ACTUALLY IS DISPLAYED. ${$parm{yvals}}[$_] = ' ' . ${$parm{yvals}}[$_] while (length(${$parm{yvals}}[$_]) < $l); } $legendxsiz += (length(': ') * $sfw); my ($legendxwidth) = $legendxsiz; $legendxsiz += $x + (9 * $sfw); unless($parm{maxxsiz}) #CALCULATE MAXIMUM WIDTH OF GIF. { $parm{radius} = 120 unless($parm{radius}); $chartxsiz = (2*$parm{radius}) + $bulletxsiz + $legendxsiz + $parm{rmgn} + (2*$parm{shadow}); $parm{maxxsiz} = $chartxsiz + $parm{lmgn} + $parm{rmgn}; } else #RESCALE EVERYTHING ELSE TO FIT. { $chartxsiz = $parm{maxxsiz} - ($parm{lmgn} + $parm{rmgn}); if ($chartxsiz < $legendxsiz) #LEGEND TAKES UP ENTIRE CHART AREA. { $bulletxsiz = $sfh + 8; $parm{legendsiz} = $sfh; $chartxsiz = $legendxsiz + $bulletxsiz if ($chartxsiz < ($legendxsiz + $bulletsiz)); #TRY TO TAKE SOME SPACE FROM THE MARGINS. $parm{rmgn} = $parm{maxxsiz} - ($parm{lmgn} + $chartxsiz + 2); if ($parm{rmgn} < 0) #TOOK RIGHT MGN, STILL NEED MORE. { $parm{rmgn} = 0; $parm{lmgn} = $parm{maxxsiz} - $chartxsiz; if ($parm{lmgn} < 0) #TOOK LEFT MGN, SET CHART TO MAX SIZE. { $parm{lmgn} = 0; $chartxsiz = $parm{maxxsiz}; } } } unless ($parm{radius}) #SET A DEFAULT RADIUS BASED ON ABOVE CONSTRAINTS. { $parm{radius} = $chartxsiz - ($legendxsiz + $bulletxsiz + 2); } if ($parm{radius} > (($chartxsiz - ($legendxsiz + $bulletxsiz + 2)) / 2)) { $parm{radius} = ($chartxsiz - ($legendxsiz + $bulletxsiz + 2)) / 2; #print "
----- radius set to $parm{radius}\n"; if ($parm{radius} < 50) #TRY TO RESCALE RADIUS TO AT LEAST 50 PIX. { $i = 100 - 2*$parm{radius}; $parm{rmgn} -= $i; if ($parm{rmgn} < 0) #STEAL FROM RIGHT MARGIN. { $parm{lmgn} += $parm{rmgn}; $parm{rmgn} = 0; if ($parm{lmgn} < 0) #STEAL FROM LEFT MARGIN. { $parm{lmgn} = 0; } } $chartxsiz = $parm{maxxsiz} - ($parm{lmgn} + $parm{rmgn}); $parm{radius} = ($chartxsiz - ($legendxsiz + $bulletxsiz + 2)) / 2; } } $maxxsiz = $parm{maxxsiz}; #SAVE MAX. X FOR RECALC. AFTER Y. CALCS. } unless ($parm{maxysiz}) #CALCULATE MAXIMUM HEIGHT OF GIF. { $chartysiz = (2*$parm{radius}) + (2*$parm{shadow}); $chartysiz = $legendysiz unless ($chartysiz > $legendysiz); $parm{maxysiz} = $chartysiz + $parm{tmgn} + $parm{bmgn}; #print "
should not be here! maxysiz=$parm{maxysiz}=\n"; } else #RESCALE EVERYTHING ELSE TO FIT. { $chartysiz = $parm{maxysiz} - ($parm{tmgn} + $parm{bmgn}); if ($chartysiz < $legendysiz) { $legendysiz = ($#{$parm{xvals}} + 2) * ($sfh + 4); $bulletysiz = $sfh; $parm{legendsiz} = $bulletysiz; $chartysiz = $legendysiz; $parm{bmgn} = $parm{maxysiz} - ($parm{tmgn} + $chartysiz); #TRY STEALING FROM THE MARGINS. if ($parm{bmgn} < 0) #1ST, STEAL FROM BOTTOM. { $parm{bmgn} = 0; $parm{tmgn} = $parm{maxysiz} - $chartysiz; if ($parm{tmgn} < 0) #MUST STEAL FROM TOP TOO! { $parm{tmgn} = 0; $chartysiz = $parm{maxysiz}; #NO MARGINS LEFT, USE FULL SIZE. } } } $parm{radius} = int($chartysiz-(2*$parm{shadow}) / 2) if ($parm{radius}+$parm{shadow} > ($chartysiz / 2)); #print "
ok, maxysiz=$parm{maxysiz}= maxxsiz=$maxxsiz= parm=$parm{maxxsiz}=\n"; } unless($maxxsiz) #RECALCULATE MAXIMUM WIDTH OF GIF BASED ON RESCALINGS FOR Y. { #print "
maxxsiz was=$parm{maxxsiz}=\n"; $parm{radius} = 200 unless($parm{radius}); $chartxsiz = (2*$parm{radius}) + $bulletxsiz + $legendxsiz + $parm{rmgn} + (2*$parm{shadow}); $parm{maxxsiz} = $chartxsiz + $parm{lmgn} + $parm{rmgn}; #print "
maxxsiz now=$parm{maxxsiz}=\n"; } $piesize = 0; $deg2rad = (atan2 (1, 1) * 4) / 180; foreach (@{$parm{yvals}}) #CALCULATE SUM OF Y-VALUES (PIE SIZE). { $piesize += $_; #print "
--- y=$_= piesize =$piesize=\n"; } $piesize = 1 unless ($piesize); #ADDED 20030403 TO PREVENT DIVIDE-BY-ZERO! #print "
ok, maxysiz=$parm{maxysiz}=\n"; for (0..$#{$parm{xvals}}) #CALC. SLICE PERCENTAGES AND ANGLES. { $yangledeg[$_] = int(($parm{yvals}[$_]/$piesize) * 360); $piepct[$_] = ($parm{yvals}[$_]/$piesize) * 100; #print "
--------yangledeg=$yangledeg[$_]=\n"; $yangle[$_] = $yangledeg[$_] * $deg2rad; #RADIANS. } #print "
----final values: radius=$parm{radius}= 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. 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)) { $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; } } } 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. $black = $g->colorAllocate(0,0,0); $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); $bgcolr = $g->colorAllocate(255,255,255) unless ($bgcolr); $shadowcolr = $g->colorAllocate(0,0,0) unless ($shadowcolr); if ($#barcolrs <= 0) #FILL OUT COLOR ARRAY WITH BAR-COLOR IF NOT SPECIFIED. { for ($j=0;$j<=$#{$parm{yvals}};$j++) { $barcolrs[$j] = $barcolr; } } elsif ($#barcolrs < $#{$parm{yvals}}) #FILL OUT COLOR ARRAY TO MATCH Y-ARRAY. { my ($colrcnt) = $#barcolrs + 1; for ($j=$#barcolrs+1;$j<=$#{$parm{yvals}};$j++) { $i = $j % $colrcnt; #print "
??? j=$j colorcnt=$colrcnt color($j) := color($i).\n"; $barcolrs[$j] = $barcolrs[$i]; } } # if (defined($parm{bgcolor})) # { #$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); } #SET UP IMAGE MAPPING, IF APPLICABLE. if (defined($parm{links}) || defined($parm{mouseovers}) || defined($parm{link}) || defined($parm{mouseover})) { $parm{mapname} = "BarChart.$$" unless (defined($parm{mapname})); $mapstr = '' . "\n"; } $centerx = $parm{lmgn} + $parm{radius}; $centery = $parm{tmgn} + ($chartysiz / 2); #print "
??? radius=$parm{radius}= chartxsiz=$chartxsiz= chartysiz=$chartysiz= centerx=$centerx= centery=$centery=\n"; #print "
??? maxxsiz=$parm{maxxsiz}= maxysiz=$parm{maxysiz}= legendxsiz=$legendxsiz= legendysiz=$legendysiz=\n"; #print "
??? lmgn=$parm{lmgn}= rmgn=$parm{rmgn}= tmgn=$parm{tmgn}= bmgn=$parm{bmgn}= \n"; #DRAW THE SLICES. my ($radius2) = $parm{radius}; $parm{radius} *= 2; if ($parm{radius} > 0) #DON'T BOTHER IF RADIUS <= 0! { if ($parm{shadow}) { $g->arc($centerx+$parm{shadow},$centery+$parm{shadow}, $parm{radius},$parm{radius},0,360,$shadowcolr); #DRAW SHADOW. $g->fill($centerx,$centery,$shadowcolr); $g->arc($centerx,$centery, $parm{radius},$parm{radius},0,360,$bgcolr); #DRAW SHADOW. $g->fill($centerx-($parm{radius}*-0.7071067), $centery-($parm{radius}*-0.7071067),$bgcolr); $g->fill($centerx,$centery,$bgcolr); } $g->arc($centerx,$centery,$parm{radius},$parm{radius},0,360,$black); #DRAW BORDER CIRCLE. $lasttheta = -90 * $deg2rad; # my ($radius2) = $parm{radius} / 2; for (0..$#{$parm{xvals}}) { $g->line($centerx, $centery, ($centerx + ($radius2 * cos($lasttheta))), ($centery + ($radius2 * sin($lasttheta))), $barcolrs[$_]); $lasttheta += $yangle[$_]; } } #goto SKIPslices; #FILL IN SLICES TO MAKE SOLID. $lasttheta = -90; $radius210 = $radius2 - 5; $legendx = ($parm{lmgn} + $chartxsiz) - ($legendxsiz + $bulletxsiz); $legendy = $parm{tmgn} + (($chartysiz - $legendysiz) / 2); my ($bulletx) = $legendx + $bulletxsiz; my ($bulletx2) = $bulletx + $legendxwidth; $piesize = &commatize($piesize, $parm{commatize}); $pieszlen = length($piesize); my ($bulletx3) = $bulletx2 + (($pieszlen + 2) * $sfw); my ($bullety) = $legendy + (($parm{legendsiz} - $sfh) / 2); my ($dispyval, $dispylen); #print "
???? xcnt=$#{$parm{xvals}}=\n"; for (0..$#{$parm{xvals}}+1) { #FILL IN EACH SLICE. unless ($_ > $#{$parm{xvals}}) { if ($parm{radius} > 0) { #$lastthetax = int($lasttheta + ($yangledeg[$_]/2)) * $deg2rad; #LAST LINE CHGD. TO NEXT 20030408 TO BETTER ENSURE SMALL SLICES ARE FILLED. $lastthetax = int($lasttheta + 1 + ($yangledeg[$_]/2)) * $deg2rad; $g->fill( ($centerx + ($radius210*cos($lastthetax))), ($centery + ($radius210*sin($lastthetax))), $barcolrs[$_]) if ($yangledeg[$_] > 0); #TEST ADDED 20040408! $lasttheta += $yangledeg[$_]; } #DRAW EACH LEGEND. $g->filledRectangle($legendx, $legendy, ($legendx+$parm{legendsiz}), ($legendy+$parm{legendsiz}), $barcolrs[$_]); $g->string(gdSmallFont, $bulletx, $bullety, "$parm{xvals}[$_]:", $valxcolr); $dispyval = &commatize($parm{yvals}[$_], $parm{commatize}); $dispylen = length($dispyval); #print "
ct=$parm{commatize}= yv=$parm{yvals}[$_]= dv=$dispyval=\n"; #for ($ix=length($parm{$yvals}[$_]),$ix<$pieszlen;$ix++ $dispyval = (' ' x ($pieszlen - $dispylen)) . $dispyval; $g->string(gdSmallFont, $bulletx2, $bullety, $dispyval, $headercolr); $g->string(gdSmallFont, $bulletx3, $bullety, '(' . sprintf("%4.1f",$piepct[$_]) . "\%)", $headercolr); } else { last unless (defined($parm{links}[$_]) || defined($parm{mouseovers}[$_])); } #ADD HYPERLINK, IF ANY, TO EACH LEGEND. if (defined($parm{links}[$_]) || defined($parm{mouseovers}[$_]) #ADD HYPERLINK, IF ANY, TO BAR. || defined($parm{link}) || defined($parm{mouseover})) { $l = 'HREF="//'; if (defined($parm{links}[$_]) || defined($parm{link})) { $parm{links}[$_] = $parm{link} unless($parm{links}[$_]); $l = ' HREF="' . $parm{links}[$_]; unless ($l =~ m#\"\s*(http\:|\/)#) { $l = 'HREF="' . $parm{linkpath}; $l .= $parm{links}[$_] unless ($l =~ s#\*#$parm{links}[$_]#); } } $l .= '"'; $l = '' if ($l eq 'HREF="//"' && !defined($parm{mouseovers}[$ix])); #ADDED 20000302! $mapstr .= ' $#{$parm{xvals}}) { $legendy += $parm{legendsiz} + 4; $bullety += $parm{legendsiz} + 4; } } #$g->rectangle($legendx, $legendy, ($legendx+$parm{legendsiz}), # ($legendy+$parm{legendsiz}), $black); $g->line($bulletx, ($legendy-2), ($parm{lmgn}+$chartxsiz), ($legendy-2), $axiscolr); #"total" ARG. ADDED 20030404 TO ALLOW USER TO SPECIFY TEXT THAT PRINTS ON TOTAL LINE. $g->string(gdSmallFont, $bulletx, $bullety, ($parm{total}||"Total:"), $headercolr); $g->string(gdSmallFont, $bulletx2, $bullety, "$piesize (100.0\%)", $headercolr); #FINISH IMAGE MAP STUFF. 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}#); } } $l .= '"'; if (defined($parm{link}) || defined($parm{mouseover})) { $mapstr .= 'string(gdLargeFont, # (($parm{maxxsiz} - ($lfw*length($parm{title})))/2), # ($parm{tmgn} - $lfh) / 2, $parm{title}, $titlecolr); 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})) #BOTTOM TITLE. { $g->string(gdSmallFont, (($parm{maxxsiz} - ($lfw*length($parm{title})))/2), ($parm{tmgn}+$chartysiz+3), $parm{xtitle}, $titlecolr); } if (defined($parm{ytitle})) #LEFT MARGIN TITLE. { $i = $sfw*length($parm{ytitle}); $g->stringUp(gdSmallFont, ($parm{lmgn}-($sfh+3)), (($chartysiz - $i)/2) + $i + $parm{tmgn}, $parm{ytitle}, $titlecolr); } if (defined($parm{lrtitle})) #ADDED 20030506 TO ADD LOWER-RIGHT CORNER TITLE. { $_ = ($parm{lmgn}+$chartxsiz) - ($sfw*length($parm{lrtitle})); $g->string(gdSmallFont, ($parm{lmgn}+$chartxsiz) - ($sfw*length($parm{lrtitle})), ($parm{maxysiz}-(2*$sfh+2)), $parm{lrtitle}, $titlecolr); } return ($g,$mapstr); } 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