DBD-Chart
view release on metacpan or search on metacpan
Chart/Plot.pm view on Meta::CPAN
#23456789012345678901234567890123456789012345678901234567890123456789012345
#
# DBD::Chart::Plot -- Plotting engine for DBD::Chart
#
# Copyright (C) 2001,2002 by Dean Arnold <darnold@presicient.com>
#
# You may distribute under the terms of the Artistic License,
# as specified in the Perl README file.
#
# Change History:
#
# 0.81 2005-Jan-26 D. Arnold
# use TITLE instead of ALT in AREAMAPs
# exit w/ error if compute scales/ranges would fail
#
# 0.80 2002-Sep-13 D. Arnold
# programmable fonts
# fix origin alignment for areagraphs w/ linegraphs
# make image border programmable
# fix 3-D piecharts where width >> height
# improved 3-D piechart label positioning
#
# 0.73 2002-Sep-11 D. Arnold
# fix scaling for 3-D bars w/ < 4 bars
# fix all plots with single data point
# add axis labels for 3-D bars
# improve error reporting for iconic too wide,
# icon format unsupported
# fix for odd segmented quadtrees
# fix scaling for 3-D bars when KEEPORIGIN=1
# fix SHOWVALUES for 3-D bars when clipped from origin
#
# 0.72 2002-Aug-17 D. Arnold
# fix showvalues for nonstacked bars/histos/candles
# fix legend placement
#
# 0.71 2002-Aug-12 D. Arnold
# add float property for bars/histos/areas
# fix linewidth to be local property
# fix bug in stacked areagraphs
#
# 0.70 2002-Jun-10 D. Arnold
# add stacked bar, histo, area, and candlestick graphs
# add quadtree graph
# support new property keywords stack, showvalues
# consolidated candlestick w/ 2D bars functions
# add programmable linewidth to linegraph, candlesticks
# add mapModifier callback
# support NULL shapes entries
#
# 0.63 2002-May-16 D. Arnold
# fix for Gantt chart date axis alignment
#
# 0.61 2002-Feb-07 D. Arnold
# fix for :PLOTNUM imagemap variable in Gantt chart
# fix for undef range values
# added 'dot' point shape (contributed by Andrea Spinelli)
# fix for temporal alignment
# fix for tick labels overwriting axis labels
#
# 0.60 2002-Jan-12 D. Arnold
# support temporal datatypes
# support histograms
# support composite images
# support user defined colors
# scale boxchart vertical offsets
# support Gantt charts
#
# 0.52 2001-Dec-14 D. Arnold
# fix for ymax in 2d bars
#
# 0.51 2001-Dec-01 D. Arnold
# Support multicolor barcharts
# Support 3D piecharts
#
# 0.50 2001-Oct-14 D. Arnold
# Add barchart, piechart engine
# Add iconic barcharts, pointshapes
# Add 3D, 3 axis barcharts
# Add HTML imagemap generation
# Increase axis label text length
#
# 0.43 2001-Oct-11 P. Scott
# Allow a 'gif' (or any future format supported by
# GD::Image) format to be called in plot().
#
# 0.42 2001-Sep-29 Dean Arnold
# - fixed xVertAxis handling for candlestick and symbolic domains
#
# 0.30 Jun 1, 2001 Dean Arnold
# - fixed Y-axis tick problem when no grid used
#
# 0.20 Mar 10, 2001 Dean Arnold
# - added logrithmic graphs
# - added area graphs
Chart/Plot.pm view on Meta::CPAN
#
# indices of 3-D projection vertices
# mapped to line segments
#
our @vert2lines = (
1*2, 4*2, # top front l-r
0*2, 1*2, # left front b-t
0*2, 5*2, # bottom front l-r
4*2, 5*2, # right front b-t
1*2, 2*2, # top left f-r
2*2, 3*2, # top rear l-r
3*2, 4*2, # right top r-f
3*2, 6*2, # right rear t-b
5*2, 6*2, # right bottom r-f
);
#
# indices of 3-D projection of axes planes
#
our @axesverts = (
0*2, 1*2, # left wall
1*2, 3*2,
3*2, 2*2,
2*2, 0*2,
# rear wall
3*2, 6*2, # trl to trr
6*2, 5*2, # trr to brr
5*2, 1*2, # brr to brl
# floor
9*2, 10*2, # brr to brl
10*2, 7*2, # brl to brf
9*2, 8*2, # brr to brf
7*2, 8*2, # blf to brf
);
#
# font sizes
#
our ($sfw,$sfh) = (gdSmallFont->width, gdSmallFont->height);
our ($tfw,$tfh) = (gdTinyFont->width, gdTinyFont->height);
our %valid_attr = qw(
width 1
height 1
genMap 1
mapType 1
mapURL 1
mapScript 1
horizMargin 1
vertMargin 1
xAxisLabel 1
yAxisLabel 1
zAxisLabel 1
xLog 1
yLog 1
zLog 1
title 1
signature 1
legend 1
horizGrid 1
vertGrid 1
xAxisVert 1
keepOrigin 1
bgColor 1
threed 1
icons 1
symDomain 1
timeDomain 1
gridColor 1
textColor 1
font 1
logo 1
timeRange 1
mapModifier 1
border 1
);
our @lines = (
[ 0*2, 4*2, 5*2, 1*2 ], # top face
[ 0*2, 1*2, 3*2, 2*2 ], # front face
[ 1*2, 5*2, 7*2, 3*2 ] # side face
);
our %gdfontmap = (
5, gdTinyFont,
6, gdSmallFont,
7, gdMediumBoldFont,
8, gdLargeFont,
9, gdGiantFont
);
our %fontMap = ();
our %month = ( 'JAN', 0, 'FEB', 1, 'MAR', 2, 'APR', 3, 'MAY', 4, 'JUN', 5,
'JUL', 6, 'AUG', 7, 'SEP', 8, 'OCT', 9, 'NOV', 10, 'DEC', 11);
our @monthmap = qw( JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC );
#
# URI escape map
#
our %escapes = ();
for (0..255) {
$escapes{chr($_)} = sprintf("%%%02X", $_);
}
use constant LINE => 1;
use constant POINT => 2;
use constant AREA => 4;
use constant BOX => 8;
use constant PIE => 16;
use constant HISTO => 32;
use constant BAR => 64;
use constant CANDLE => 128;
use constant GANTT => 256;
use constant QUADTREE => 512;
our %typemap = ( 'BAR', BAR, 'HISTO', HISTO, 'FILL', AREA,
'CANDLE', CANDLE, 'BOX', BOX, 'GANTT', GANTT, 'QUADTREE', QUADTREE );
sub new {
my $class = shift;
my $obj = {};
bless $obj, $class;
$obj->init (@_);
return $obj;
}
#
# Plot object members:
#
# img - GD::Image object
# width - image width in pixels
# height - image height in pixels
# signature - signature string
# genMap - 1 => generate HTML imagemap
# horizMargin - image horizontal margins in pixels
# vertMargin - image vertical margins in pixels
# data - data points to be plotted
# props - graph properties
# plotCnt - number of plots in graph
# xl, xh, yl, yh, zl, zh - min/max of each axis
# xscale, yscale, zscale - scaling factors for assoc. axis
# horizEdge, vertEdge - horizontal/vertical edge location
# horizStep, vertStep - horizontal/vertical pixel increment
# haveScale - calculated min/max is valid
# xAxisLabel, yAxisLabel, zAxisLabel - label for assoc. axis
# title - title string
# xLog, yLog, zLog - 1 => assoc axis is logarithmic
# errmsg - last error msg
# keepOrigin - force (0,0[,0]) into graph
# imgMap - HTML imagemap text
# symDomain - 1 => domain is symbolic
# timeDomain - 1 => domain is temporal
# icon - name of icon image file for iconic barcharts/points
# logo - name of background logo image file
# mapModifier - ref to callback to modify imagemap entries
# _legends - arrayref to hold legend info til we render it
#
sub init {
my ($obj, $w, $h, $colormap) = @_;
$w = 400 unless $w;
$h = 300 unless $h;
my $img = new GD::Image($w, $h);
#
# if a colormap supplied, copy it into our color list
#
if ($colormap) {
foreach my $color (keys(%$colormap)) {
$colors{lc $color} = $$colormap{$color};
}
}
my $white = $img->colorAllocate(@{$colors{white}});
my $black = $img->colorAllocate(@{$colors{black}});
$obj->{width} = $w;
$obj->{height} = $h;
$obj->{img} = $img;
# imagemap attributes
$obj->{genMap} = undef; # name of map
$obj->{imgMap} = ''; # contains resulting map text
$obj->{mapType} = 'HTML'; # default HTML
$obj->{mapURL} = ''; # base URL for hotspots
$obj->{mapScript} = ''; # base script call for hotspots
# image margins
$obj->{horizMargin} = 50;
$obj->{vertMargin} = 70;
# create an empty array for point arrays and properties
$obj->{data} = [ ];
$obj->{props} = [ ];
$obj->{plotCnt} = 0;
$obj->{plotTypes} = 0;
# used for pt2pxl()
$obj->{xl} = undef;
$obj->{xh} = undef;
$obj->{yl} = undef;
$obj->{yh} = undef;
$obj->{zl} = undef;
$obj->{zh} = undef;
$obj->{xscale} = 0;
$obj->{yscale} = 0;
$obj->{zscale} = 0;
$obj->{horizEdge} = 0;
$obj->{vertEdge} = 0;
$obj->{horizStep} = 0;
$obj->{vertStep} = 0;
$obj->{Xcard} = 0; # cardinality of 3-axis barcharts
$obj->{Zcard} = 0;
$obj->{plotWidth} = 0; # true plot width; height; depth
$obj->{plotHeight} = 0;
$obj->{plotDepth} = 0;
$obj->{brushWidth} = 0; # width of bars or candlesticks
$obj->{brushDepth} = 0;
$obj->{rangeSum} = 0; # running total for piecharts
$obj->{haveScale} = 0; # 1 = last calculated min & max still valid
$obj->{domainValues} = { }; # map of domain values for bar/histo/candle/sym domains
$obj->{boxCount} = 0; # num of boxcharts in plot
$obj->{barCount} = 0; # num of barchart/histos in plot
$obj->{xMaxLen} = 0; # max length of symbolic X value
$obj->{yMaxLen} = 0; # max length of temporal Y value
$obj->{zMaxLen} = 0; # max length of symbolic Z value
# axis label strings
$obj->{xAxisLabel} = '';
$obj->{yAxisLabel} = '';
$obj->{zAxisLabel} = '';
$obj->{xLog} = 0; # 1 => log10 scaling
$obj->{yLog} = 0;
$obj->{zLog} = 0;
$obj->{title} = '';
$obj->{signature} = '';
$obj->{legend} = 0; # 1 => render legend
$obj->{horizGrid} = 0; # 1 => print y-axis gridlines
$obj->{vertGrid} = 0; # 1 => print x-axis gridlines
$obj->{xAxisVert} = 0; # 1 => print x-axis label vertically
$obj->{errmsg} = ''; # error result of last operation
$obj->{keepOrigin} = 0; # 1 => force origin into graph
$obj->{threed} = 0; # 1 => use 3-D effect
$obj->{logo} = undef;
$obj->{icons} = [ ]; # array of icon filenames
$obj->{symDomain} = 0; # 1 => use symbolic domain
$obj->{timeDomain} = undef; # defines format of temporal domain labels
$obj->{timeRange} = undef; # defines format of temporal range labels
# allocate some oft used colors
$obj->{white} = $white;
$obj->{black} = $black;
$obj->{transparent} = $img->colorAllocate(@{$colors{'transparent'}});
$obj->{bgColor} = $white; # background color
$obj->{gridColor} = $black;
$obj->{textColor} = $black;
$obj->{border} = 1;
$obj->{mapModifier} = undef;
# for now these aren't used, but someday we'll let them be configured
$obj->{font} = 'gd';
$obj->{_legends} = [ ];
# set image basic properties
$img->transparent($obj->{transparent});
$img->interlaced('true');
# $img->rectangle( 0, 0, $w-1, $h-1, $obj->{black});
}
#
# compare function for numeric sort
#
sub numerically { $a <=> $b }
sub convert_temporal {
my ($value, $format) = @_;
#
# use Perl funcs to compute seconds from date
my $t;
$t = timegm(0, 0, 0, $3, $2 - 1, $1),
$t -= ($t%86400), # timelocal isn't behaving quite right
return $t
if (($format eq 'YYYY-MM-DD') &&
($value=~/^(\d+)[\-\.\/](\d+)[\-\.\/](\d+)$/));
$t = timegm(0, 0, 0, $3, $month{uc $2}, $1),
$t -= ($t%86400), # timelocal isn't behaving quite right
return $t
if (($format eq 'YYYY-MM-DD') &&
($value=~/^(\d+)[\-\.\/](\w+)[\-\.\/](\d+)$/) &&
defined($month{uc $2}));
return timegm($6, $5, $4, $3, $2 - 1, $1) + ($7 ? $7 : 0)
if (($format eq 'YYYY-MM-DD HH:MM:SS') &&
($value=~/^(\d+)[\-\.\/](\d+)[\-\.\/](\d+)\s+(\d+):(\d+):(\d+)(\.\d+)?$/));
return timegm($6, $5, $4, $3, $month{uc $2}, $1) + ($7 ? $7 : 0)
if (($format eq 'YYYY-MM-DD HH:MM:SS') &&
($value=~/^(\d+)[\-\.\/](\w+)[\-\.\/](\d+)\s+(\d+):(\d+):(\d+)(\.\d+)?$/) &&
(defined($month{uc $2})));
return (($1 ? (($1 eq '-') ? -1 : 1) : 1) * (($3 ? ($3 * 3600) : 0) + ($5 ? ($5 * 60) : 0) +
$6 + ($7 ? $7 : 0)))
if ((($format eq '+HH:MM:SS') || ($format eq 'HH:MM:SS')) &&
($value=~/^([\-\+])?((\d+):)?((\d+):)?(\d+)(\.\d+)?$/));
return undef; # for completeness, shouldn't get here
}
#
# restore the readable datetime form from
# the input numeric value
sub restore_temporal {
my ($value, $format) = @_;
my ($sign, $subsec, $sec, $min, $hour, $mday, $mon, $yr, $wday, $yday, $isdst);
$sign = ($value < 0);
$value = abs($value);
if (($format eq '+HH:MM:SS') || ($format eq 'HH:MM:SS')) {
$hour = int($value/3600);
$min = int(($value%3600)/60);
$sec = int($value%60);
$hour = "0$hour" if ($hour < 10);
Chart/Plot.pm view on Meta::CPAN
$obj->drawTitle if $obj->{title}; # vert offset may be increased
$obj->drawSignature if $obj->{signature};
# $obj->{numRanges} = scalar @{$obj->{data}};
my $rc = 1;
#
# sort the domain values if temporal domain
#
$obj->sortData if $obj->{symDomain};
my $plottypes = $obj->{plotTypes};
my $props = $obj->{props};
my $prop;
#
# if its boxchart only, then establish dummy yl, yh
($obj->{yl}, $obj->{yh}) = (1, 100) if ($plottypes == BOX);
#
# get scale of all included plots
#
$rc = $obj->computeScales()
unless ($obj->{haveScale} ||
($plottypes == PIE) || ($plottypes == QUADTREE));
return undef unless $rc;
#
# if boxchart included, distribute the range values among the
# plots
$obj->{boxHeight} = int($obj->{plotHeight}/($obj->{boxCount}+1))
if $obj->{boxCount};
#
# pies are always solo, get em out of the way...
$rc = $obj->plotPie,
return ($rc ? (($format) && $obj->{img}->$format) : undef)
if ($plottypes == PIE);
#
# plot axes based on plot type
#
$rc = ($plottypes == BOX) ? $obj->plotBoxAxes :
($plottypes & (HISTO|GANTT)) ? $obj->plotHistoAxes :
$obj->plotAxes
unless ($plottypes == QUADTREE);
return undef unless $rc;
#
# now we can plot each dataset
#
my @proptypes = ();
foreach (@{$obj->{props}}) {
push(@proptypes, $typemap{uc $1}), next
if /\b(candle|fill|box|bar|histo|gantt|quadtree)\b/i;
push(@proptypes, POINT),next if /\bnoline\b/i;
push(@proptypes, LINE);
}
my $plotcnt = $#{$obj->{props}} + 1;
#
# hueristically render plots in "best" visible order
#
if ($obj->{zAxisLabel} || $obj->{threed}) {
return undef # since 3-D only compatible with 3-D
if (! $obj->plot3DBars);
return undef
unless (($#{$obj->{_legends}} < 0) || $obj->drawLegend);
$obj->plot3DTicks;
return (($format) && $obj->{img}->$format);
}
return undef # since quadtree must be solo
if (($plottypes & QUADTREE) && (! $obj->plotQuadtree(\@proptypes)));
return undef # since histo only compatible with histo
if (($plottypes & HISTO) && (! $obj->plot2DBars(HISTO, \@proptypes)));
return undef # since Gantt only compatible with Gantt
if (($plottypes & GANTT) && (! $obj->plotGantt));
return undef
if (($plottypes & AREA) && (! $obj->plotAll(AREA,\@proptypes)));
return undef
if (($plottypes & BAR) && (! $obj->plot2DBars(BAR, \@proptypes)));
return undef
if (($plottypes & CANDLE) && (! $obj->plot2DBars(CANDLE, \@proptypes)));
return undef
if (($plottypes & BOX) && (! $obj->plotBox(\@proptypes)));
return undef
if (($plottypes & LINE) && (! $obj->plotAll(LINE,\@proptypes)));
return undef
if (($plottypes & POINT) && (! $obj->plotAll(POINT,\@proptypes)));
#
# add any accumulated legends
#
return undef
unless (($#{$obj->{_legends}} < 0) || $obj->drawLegend);
#
# now render it in the requested format
#
return (($format) && $obj->{img}->$format);
}
sub getMap {
my ($obj) = @_;
my $mapname = $obj->{genMap};
return "\$$mapname = [\n" . $obj->{imgMap} . " ];"
if (uc $obj->{mapType} eq 'PERL');
return "<MAP NAME=\"$mapname\">" .
$obj->{imgMap} . "\n</MAP>\n";
}
#
# sets xscale, yscale, and edge values used in pt2pxl
# also adjusts min or max of barcharts to clip away origin
#
sub computeScales {
my $obj = shift;
my ($xl, $yl, $zl, $xh, $yh, $zh) =
($obj->{xl}, $obj->{yl}, $obj->{zl}, $obj->{xh}, $obj->{yh},
$obj->{zh});
my $i;
#
# if keepOrigin, make sure (0,0) is included
# (but only if not in logarithmic mode)
#
if ($obj->{keepOrigin}) {
unless ($obj->{xLog} || $obj->{symDomain} ||
$obj->{zAxisLabel} || $obj->{threed}) {
$xl = 0 if ($xl > 0);
$xh = 0 if ($xh < 0);
}
unless ($obj->{yLog}) {
$yl = 0 if ($yl > 0);
$yh = 0 if ($yh < 0);
}
#
# doesn't apply to Z axis (yet)
#
}
my $plottypes = $obj->{plotTypes};
# set axis ranges for widest/tallest/deepest dataset
$obj->{errmsg} = 'Invalid dataset.',
return undef
unless $obj->computeRanges($xl, $xh, $yl, $yh, $zl, $zh);
$obj->{yl} = 0 if (($plottypes & (BAR|HISTO)) && ($yl == 0));
if ($obj->{keepOrigin}) {
unless ($obj->{xLog} || $obj->{symDomain} ||
$obj->{zAxisLabel} || $obj->{threed}) {
$obj->{xl} = 0 if ($xl >= 0);
$obj->{xh} = 0 if ($xh <= 0);
}
unless ($obj->{yLog}) {
$obj->{yl} = 0 if ($yl >= 0);
$obj->{yh} = 0 if ($yh <= 0);
}
}
($xl, $xh, $yl, $yh, $zl, $zh) =
($obj->{xl}, $obj->{xh}, $obj->{yl}, $obj->{yh},
$obj->{zl}, $obj->{zh});
if (($plottypes & (BAR|HISTO)) && ($yl > 0)
&& (! $obj->{keepOrigin})) {
#
# adjust mins to clip away from origin
#
foreach (0..$#{$obj->{props}}) {
next unless ($obj->{props}->[$_]=~/\b(bar|histo)\b/i);
my $datastack = $obj->{data}->[$_];
my $j = 1;
$datastack->[$j]->[0] = $yl, $j += 3
while ($j <= $#$datastack);
}
}
#
# heuristically adjust image margins to fit labels
#
my ($botmargin, $topmargin, $ltmargin, $rtmargin) = (40, 40, 0, 5*$sfw);
$botmargin += (3 * $tfh) if $obj->{legend};
#
# compute space needed for X axis labels
#
my $maxlen = 0;
my ($tl, $th) = (0, 0);
($tl, $th) = ($obj->{xLog}) ? (10**$xl, 10**$xh) : ($xl, $xh)
unless $obj->{symDomain};
$maxlen = $obj->{symDomain} ? $obj->{xMaxLen} :
$obj->{timeDomain} ? length($obj->{timeDomain}) :
(length($th) > length($tl)) ? length($th) : length($tl);
$maxlen = 25 if ($maxlen > 25);
$maxlen = 7 if ($maxlen < 7);
$botmargin += (($sfw * $maxlen) + 10) unless ($plottypes & (HISTO|GANTT));
$ltmargin = (($sfw * $maxlen) + 20) if ($plottypes & (HISTO|GANTT));
#
# compute space needed for Y axis labels
#
($tl, $th) = ($obj->{yLog}) ? (10**$yl, 10**$yh) : ($yl, $yh);
$maxlen = $obj->{timeRange} ? length($obj->{timeRange}) :
(length($th) > length($tl)) ? length($th) : length($tl);
$maxlen = 25 if ($maxlen > 25);
$maxlen = 7 if ($maxlen < 7);
$botmargin += (($sfw * $maxlen) + 10) if ($plottypes & (HISTO|GANTT));
$ltmargin = (($sfw * $maxlen) + 20) unless ($plottypes & (HISTO|GANTT));
#
# compute space needed for Z axis labels
#
if ($obj->{zAxisLabel}) {
$maxlen = $obj->{zMaxLen};
$maxlen = 25 if ($maxlen > 25);
$maxlen = 7 if ($maxlen < 7);
$rtmargin = ($sfw * $maxlen) + 10;
}
#
# calculate axis scales
if ($obj->{zAxisLabel} || $obj->{threed}) {
my $tht = $obj->{height} - $topmargin - $botmargin;
my $twd = $obj->{width} - $ltmargin - $rtmargin;
#
# compute ratio of Z values to X values
# to adjust percent of plot area reserved for
# depth. Max is 40%, min is 10%
#
my $xzratio =
$obj->{Zcard}/($obj->{Xcard}*(scalar @{$obj->{data}}));
# $xzratio = 0.1 if ($xzratio < 0.1);
#
# compute actual height as adjusted height x (1 - depth ratio)
# actual depth is based on 30 deg. rotation of adjusted
# width x depth ratio
# actual width is adjust width - the 30 deg. rotation effect
#
$xh = 0.5 + int($xh), $xl = 0.5,
$obj->{xh} = $xh, $obj->{xl} = $xl
if ($xh - $xl < int($xh));
$obj->{plotWidth} = int($twd / ($xzratio*sin(3.1415926/6) + 1)),
$obj->{plotDepth} = int(($twd - $obj->{plotWidth})/sin(3.1415926/6)),
$obj->{plotHeight} = int($tht - ($obj->{plotDepth}*cos(3.1415926/3))),
# $obj->{xscale} = $obj->{plotWidth}/($xh - $xl),
$obj->{xscale} = $obj->{plotWidth}/int($xh),
Chart/Plot.pm view on Meta::CPAN
$obj->{xl} = $obj->{xl} - ($obj->{xl}%$align);
$obj->{xh} += ($align - ($obj->{xh}%$align));
}
$obj->{yl} = ($obj->{yLog}) ? $yl : (! $ym) ? 0 : $ym * (int(($yl-0.00001*$sign[2])/$ym) + $sign[2] - 1);
$obj->{yh} = ($obj->{yLog}) ? $yh : (! $ym) ? 0 : $ym * (int(($yh-0.00001*$sign[3])/$ym) + $sign[3] + 1);
#
# day align here too
if ($obj->{timeRange} && ($obj->{timeRange}=~/^YYYY/i)) {
my $align =
(($obj->{timeRange}!~/HH/i) ||
($obj->{yh} - $obj->{yl} > (3 * 24 * 60 * 60))) ? 86400 :
($obj->{yh} - $obj->{yl} > (3 * 60 * 60)) ? 3600 : 60;
$obj->{yl} = $obj->{yl} - ($obj->{yl}%$align);
$obj->{yh} += ($align - ($obj->{yh}%$align));
}
return 1;
}
#
# compute bar spacing
#
sub computeSpacing {
my ($obj, $type) = @_;
#
# compute number of domain values
#
my $domains = 0;
$domains = ($obj->{Xcard}) ? 1 : scalar(@{$obj->{domain}});
my $bars = $obj->{barCount};
$bars = $obj->{Xcard} if ($obj->{Xcard});
my $spacer = 10;
my $width = ($type & HISTO) ? $obj->{plotHeight} : $obj->{plotWidth};
my $pxlsperdom = int($width/($domains+1)) - $spacer;
$obj->{errmsg} = 'Insufficient width for number of domain values.',
return undef
if ($pxlsperdom < 2);
#
# compute width of each bar from number of bars per domain value
#
my $pxlsperbar = int($pxlsperdom/$bars);
$obj->{errmsg} = 'Insufficient width for number of ranges or values.',
return undef
if ($pxlsperbar < 2);
$obj->{brushWidth} = $pxlsperbar;
return 1;
}
sub plot2DBars {
my ($obj, $type, $typeary) = @_;
my ($i, $j, $k, $x, $n, $ary, $pxl, $pxr, $py, $pyt, $pyb);
my ($color, $prop, $s, $colorcnt);
my @barcolors = ();
my @brushes = ();
my @markers = ();
my @props = ();
my $legend = $obj->{legend};
my ($xl, $xh, $yl, $yh) = ($obj->{xl}, $obj->{xh}, $obj->{yl},
$obj->{yh});
my ($brush, $ci, $t);
my ($useicon, $marker);
my $img = $obj->{img};
my $plottypes = $obj->{plotTypes};
my @tary = ();
my $bars = $obj->{barCount};
my $boff = int($obj->{brushWidth}/2);
my $ttlw = int($bars * $boff);
my $domain = $obj->{domain};
my $xhash = $obj->{domainValues};
my ($prtX,$prtYH,$prtYL);
my ($iconw, $iconh) = (0,0);
#
# get indexes of all same type
foreach (0..$#$typeary) {
push(@tary, $_)
if ($$typeary[$_] == $type);
}
for ($n = 0; $n <= $#tary; $n++) {
@barcolors = ();
@brushes = ();
@markers = ();
$marker = undef;
$color = 'black';
$k = $tary[$n];
$ary = $obj->{data}->[$k];
$t = $obj->{props}->[$k];
$t=~s/\s+/ /g;
# $t = lc $t;
@props = split (' ', $t);
my $showvals;
my $stacked = 0;
foreach (@props) {
#
# if its iconic, load the icon image
#
push(@markers,$1),
push (@barcolors, undef),
next
if /^icon:(\S+)$/i;
$_ = lc $_;
$showvals = $1, next
if /^showvalues:(\d+)/;
$stacked = 1, next
if ($_ eq 'stack');
push (@barcolors, $_),
push (@markers, undef),
next
if (($type != CANDLE) && $colors{$_});
next unless ($type == CANDLE);
#
# for candlesticks we rely on the DBD::Chart layer to provide
# sufficient colors and shapes as needed
push (@barcolors, $_),
next
if ($colors{$_});
#
# generate pointshape if requested
#
push(@markers, $_),
next
if ($valid_shapes{$_} && ($_ ne 'null'));
} # end for each property
#
# allocate each color we're using
$colorcnt = 0;
my ($bw, $bh, $bbasew, $bbaseh) = ($plottypes & HISTO) ?
(1, $obj->{brushWidth}, 0, $obj->{brushWidth}) :
($obj->{brushWidth}, 1, $obj->{brushWidth}, 0);
foreach (@barcolors) {
$colorcnt++;
push(@brushes, undef),
next
unless $_;
$obj->{$_} = $obj->{img}->colorAllocate(@{$colors{$_}})
unless $obj->{$_};
#
# generate brushes to draw bars
#
$brush = new GD::Image($bw, $bh),
$ci = $brush->colorAllocate(@{$colors{$_}}),
$brush->filledRectangle(0,0,$bbasew, $bbaseh,$ci),
push(@brushes, $brush);
}
#
# load each icon we're using
#
foreach (0..$#markers) {
next unless $markers[$_];
$markers[$_] = ($valid_shapes{$markers[$_]} && ($markers[$_] ne 'null')) ?
$obj->make_marker($markers[$_], $barcolors[$_]) :
$obj->getIcon($markers[$_], 1);
return undef unless $markers[$_];
}
#
# render legend if requested
# (a bit confusing here for multicolor single range charts?)
$obj->addLegend($barcolors[0], $markers[0], $$legend[$k], undef)
if ((! $stacked) && $legend && $$legend[$k]);
if ($stacked && $legend && $$legend[$k]) {
#
# there may be alignment problems here, due to the
# possibility of drawing multiple stacked bars in the same image
#
$obj->addLegend($barcolors[$_], $markers[$_], $$legend[$k]->[$_], undef)
foreach (0..$#{$$legend[$k]});
}
#
# heuristically determine whether to print Y values vert or horiz.
my $yorient = (length($yl) > length($yh)) ? length($yl) : length($yh);
$yorient *= $tfw;
#
# compute the center data point, then
# adjust horizontal location based on brush width
# and data set number
#
my $xoffset = ($n * $obj->{brushWidth}) - $ttlw
+ $boff;
my @val_palette = ();
my ($px, $py);
$j = 0;
for ($x = 0; $x <= $#$domain; $x++) {
($iconw,$iconh) = (0,0);
$i = $$xhash{$$domain[$x]} * 3; # get actual index for the current point
next unless defined($$ary[$i+1]);
# compute top and bottom (left/right) points, and stuff into
# array with printable x,y and either the brush or marker we use to draw
# NOTE: this implementation supports stacked and unstacked
my @ppts = ();
my $ys = $$ary[$i+1];
$j = 0 if ($#$ys > 1);
foreach (0..$#$ys) {
($pxl, $pyb) = $obj->pt2pxl ( $x+1, $$ys[$_] );
($pxr, $pyt) = $obj->pt2pxl ( $x+1, $$ys[$_+1] );
push @ppts, $pxl, $pyb, $pxr, $pyt, $x+1, $$ys[$_], $$ys[$_+1], $j;
$j++;
$j = 0 if ($j >= $colorcnt);
last if ($_+1 == $#$ys);
}
#
# render each bar segment
while ($#ppts > 0) {
$pxl = shift @ppts;
$pyb = shift @ppts;
$pxr = shift @ppts;
$pyt = shift @ppts;
$prtX = shift @ppts;
$prtYL = shift @ppts;
$prtYH = shift @ppts;
my $bidx = shift @ppts;
#
# adjust for bar location
$pxl += $xoffset,
$pxr += $xoffset
unless ($plottypes & HISTO);
$pyb += $xoffset,
$pyt += $xoffset
if ($plottypes & HISTO);
# draw line between top and bottom(left and right)
$img->setBrush($brushes[$bidx]),
$img->line($pxl, $pyb, $pxr, $pyt, gdBrushed)
if $brushes[$bidx];
#
# unless its iconic
Chart/Plot.pm view on Meta::CPAN
# now render values...note that candlesticks still use old method;
# eventually we'll clean them up as well.
# We need to compute complementary colors for rendering the text
# inside bars!!!
#
while ($#val_palette >= 0) {
$px = shift @val_palette;
$py = shift @val_palette;
$prtYH = shift @val_palette;
$obj->string($showvals, 90, $px, $py, $prtYH, $tfw),
next
if (($plottypes & BAR) &&
($obj->{yLog} || ($yorient >= $obj->{brushWidth})));
$obj->string($showvals, 0, $px, $py, $prtYH, $tfw);
}
} # end for each plot
return 1;
}
sub computeMedian {
my ($ary, $lo, $hi) = @_;
my $size = $hi - $lo +1;
my $midi = $size>>1;
$midi-- unless ($size & 1);
$midi += $lo;
return ($size & 1) ? $$ary[$midi] : (($$ary[$midi] + $$ary[$midi+1])/2);
}
sub computeBox {
my ($obj, $k) = @_;
my ($median, $uq, $lq, $lex, $uex, $midpt, $iqr, $val);
my $ary = $obj->{data}->[$k];
my $size = $#$ary;
#
# compute median
$median = computeMedian($ary, 0, $size);
#
# compute quartiles
$midpt = ($size)>>1;
$midpt-- unless ($size & 1);
$lq = computeMedian($ary, 0, $midpt);
$midpt += ($size & 1) ? 1 : 2;
$uq = computeMedian($ary, $midpt, $size);
#
# compute extremes within 1.5 IQR of median
$iqr = $uq - $lq;
$lex = $lq - ($iqr*1.5);
$uex = $uq + ($iqr*1.5);
$lex = $$ary[0] if ($lex < $$ary[0]);
$uex = $$ary[$#$ary] if ($uex > $$ary[$#$ary]);
return ($median, $lq, $uq, $lex, $uex);
}
sub plotBox {
my ($obj, $typeary) = @_;
my $legend = $obj->{legend};
my ($i, $j, $k, $n, $x);
my @tary = ();
for ($i = 0; $i <= $#$typeary; $i++) {
next unless ($$typeary[$i] == BOX);
push @tary, $i;
}
#
# compute the height of each box based range max and min
my $boxht = ($obj->{yh} - $obj->{yl})/($i+1);
for ($n = 0; $n <= $#tary; $n++) {
$k = $tary[$n];
my $ary = $obj->{data}->[$k];
my $t = lc $obj->{props}->[$k];
$t=~s/\s+/ /g;
my @props = split(' ', $t);
my $color = 'black';
my ($val, $xoff);
my $showvals;
foreach (@props) {
$showvals = $1, next if /^showvalues:(\d+)/i;
$color = $_
if ($colors{$_});
}
$obj->{$color} = $obj->{img}->colorAllocate(@{$colors{$color}})
unless $obj->{$color};
$obj->addLegend($color, undef, $$legend[$k], undef)
if (($legend) && ($$legend[$k]));
#
# compute median, quartiles, and extremes
#
my ($median, $lq, $uq, $lex, $uex) = $obj->computeBox($k);
#
# compute box bounds
my $ytop = $obj->{yl} + ($boxht * ($n + 1));
my $ybot = $ytop - $boxht;
my $dumy = ($ytop + $ybot)/2;
my $py = 0;
#
# draw the box
my ($p1x, $p1y) = $obj->pt2pxl($lq, $ytop);
my ($p2x, $p2y) = $obj->pt2pxl($uq, $ybot);
my $yoff = (($n+1) * (15 + $tfh));
$p1y -= $yoff;
$p2y -= $yoff;
my $img = $obj->{img};
#
# double up the box border
$img->rectangle($p1x, $p1y, $p2x, $p2y, $obj->{$color});
$img->rectangle($p1x+1, $p1y+1, $p2x-1, $p2y-1, $obj->{$color});
my ($tmed, $tlex, $tuex) = ($median, $lex, $uex);
$tmed = restore_temporal($tmed, $obj->{timeDomain}),
$lq = restore_temporal($lq, $obj->{timeDomain}),
$uq = restore_temporal($uq, $obj->{timeDomain}) ,
$tlex = restore_temporal($tlex, $obj->{timeDomain}),
$tuex = restore_temporal($tuex, $obj->{timeDomain})
if ($obj->{timeDomain} && ($obj->{genMap} || $showvals));
$xoff = int(length($lq) * $tfw/2),
$obj->string($showvals,0,$p1x-$xoff,$p1y-$tfh, $lq, $tfw),
$xoff = int(length($uq) * $tfw/2),
$obj->string($showvals,0,$p2x-$xoff,$p1y-$tfh, $uq, $tfw)
if ($showvals);
$obj->updateImagemap('RECT', "$tmed\[$lq..$uq\]", 0, $tmed,
$lq, $uq, $p1x, $p1y, $p2x, $p2y)
if ($obj->{genMap});
#
# draw median line
($p1x, $py) = $obj->pt2pxl($median, $dumy);
$p1y -= 5;
$p2y += 5;
$img->line($p1x, $p1y, $p1x, $p2y, $obj->{$color});
$xoff = int(length($median) * $tfw/2),
$obj->string($showvals,0,$p1x-$xoff,$p1y-$tfh, $tmed , $tfw)
if $showvals;
#
# draw whiskers
($p1x, $p1y) = $obj->pt2pxl($lex, $dumy);
($p2x, $py) = $obj->pt2pxl($lq, $dumy);
$p1y -= $yoff;
$img->line($p1x, $p1y, $p2x, $p1y, $obj->{$color});
$tmed = restore_temporal($tmed, $obj->{timeDomain}),
$lq = restore_temporal($lq, $obj->{timeDomain}),
$uq = restore_temporal($uq, $obj->{timeDomain})
Chart/Plot.pm view on Meta::CPAN
($px,$py) = $obj->pt2pxl($k, $yl);
($p1x, $p1y) = ($obj->{vertGrid}) ?
$obj->pt2pxl($k, $yh) : ($px, $py+2);
$img->line($px, ($obj->{vertGrid} ? $py : $py-2),
$px, $p1y, $obj->{gridColor});
$powk = ($obj->{timeDomain}) ?
restore_temporal(10**$k, $obj->{timeDomain}) : 10**$k,
$obj->string(6, 90, $px-$sfh/2, $py+length($powk)*$sfw, $powk, $sfw)
if (($n == 1) && ($px+$sfh < $xStart));
($n, $i) = (0, $k)
if ($n > $#logsteps);
}
return 1;
}
my $step = $obj->{horizStep};
my $prtX;
for ($i = $xl; $i <= $xh; $i += $step ) {
($px,$py) = $obj->pt2pxl($i,
((($obj->{yLog}) ||
($obj->{vertGrid}) || ($yl > 0) || ($yh < 0)) ? $yl : 0));
($p1x, $p1y) = ($obj->{vertGrid}) ?
$obj->pt2pxl($i, $yh) : ($px, $py+2);
$img->line($px, ($obj->{vertGrid} ? $py : $py-2), $px, $p1y, $obj->{gridColor});
next if ($obj->{xAxisVert} && ($px+$sfh >= $xStart));
$prtX = $obj->{timeDomain} ? restore_temporal($i, $obj->{timeDomain}) : $i;
$obj->string(6, 90, $px-($sfh>>1), $py+2+length($prtX)*$sfw, $prtX, $sfw), next
if ($obj->{xAxisVert});
$obj->string(6, 0, $px-length($prtX)*($sfw>>1), $py+($sfh>>1), $prtX, $sfw);
}
return 1;
}
sub plotAll {
my ($obj, $type, $typeary) = @_;
my ($i, $n, $k);
my @tary = ();
foreach (0..$#$typeary) {
push(@tary, $_)
if ($$typeary[$_] == $type);
}
foreach $n (@tary) {
my $ary = $obj->{data}->[$n];
my $t = $obj->{props}->[$n];
$t=~s/\s+/ /g;
# $t = lc $t;
my @props = split (' ', $t);
my $color = 'black';
my $marker = undef;
my $line = 'line';
my @areacolors = ();
my $stacked = 0;
my $coloridx = 0;
my $legend;
my $lwidth = 1;
my $anchor = 1;
my $showvals = 0;
foreach (@props) {
#
# if its iconic, load the icon image
#
$marker = $1,
next
if /^icon:(\S+)/i;
$_ = lc $_;
push(@areacolors, $_), next
if ($colors{$_});
$stacked = 1, next
if ($_ eq 'stack');
$showvals = $1, next
if /^showvalues:(\d+)/i;
$marker = $_,
next
if ($valid_shapes{$_} && ($_ ne 'null'));
$marker = 'fillcircle',
next
if ((! $marker) && ($_ eq 'points'));
$marker = undef, next
if ($_ eq 'nopoints');
$line = $_, next
if /^(line|noline|fill)$/;
$lwidth = $1, next if /width:(\d+)/;
$anchor = undef if ($_ eq 'float');
}
if (($line eq 'fill') && $stacked) {
#
# pull apart the datapoint arrays and plot them individually from the top
# to the bottom
my @newary = ();
my $j = $#{$ary->[1]};
#
# in case our color list is short
my $k = 0;
my $colorcnt = @areacolors;
while ($#areacolors < $j) {
push @areacolors, $areacolors[$k];
$k++;
$k = 0 if ($k == $colorcnt);
}
my $looplim = ($anchor ? 0 : 1);
my $ylo = $obj->{yl};
$ylo = 0 if ($ylo < 0);
for (; $j >= $looplim; $j--) {
@newary = ();
$color = $areacolors[$j-$looplim];
$i = 0;
push(@newary, $$ary[$i], ($anchor ? $ylo : $ary->[$i+1]->[0]), $ary->[$i+1]->[$j]),
$i += 2
while ($i <= $#$ary);
$legend = $obj->{legend} ? $obj->{legend}->[$n]->[$j] : undef;
return undef unless $obj->plotData($n, \@newary, $color, 'fill', $marker,
$legend, $lwidth, $anchor, $showvals);
}
next;
}
$legend = $obj->{legend} ? $obj->{legend}->[$n] : undef;
if (($line eq 'fill') && $anchor) {
#
# if its anchored, then add the origin points
#
my @newary = ();
$i = 0;
my $yl = $obj->{yl};
my $yh = $obj->{yh};
my $yaxpt = ((! $obj->{yLog}) && ($yl < 0) && ($yh > 0)) ? 0 : $yl;
push(@newary, $$ary[$i], $yaxpt, $$ary[$i+1]), $i += 2
while ($i <= $#$ary);
return undef unless $obj->plotData($n, \@newary,
$areacolors[$coloridx], $line, $marker,
$obj->{legend}->[$n], $lwidth, $anchor, $showvals);
}
else {
return undef unless $obj->plotData($n, $ary, $areacolors[$coloridx], $line, $marker,
$obj->{legend}->[$n], $lwidth, $anchor, $showvals);
}
$coloridx++;
$coloridx = 0 if ($coloridx = $#areacolors);
}
return 1;
}
# draws the specified dataset in $obj->{data}
sub plotData {
my ($obj, $k, $ary, $color, $line, $marker, $legend, $lw, $anchor, $showvals) = @_;
my ($i, $n, $px, $py, $prevpx, $prevpy, $pyt, $pyb);
my ($img, $prop, $s, $voff);
my @props = ();
# legend is left justified underneath
my ($xl, $xh, $yl, $yh) = ($obj->{xl}, $obj->{xh}, $obj->{yl},
$obj->{yh});
my ($markw, $markh, $yoff, $wdelta, $hdelta);
$img = $obj->{img};
$color = 'black' unless $color;
$obj->{$color} = $obj->{img}->colorAllocate(@{$colors{$color}})
unless $obj->{$color};
if ($marker) {
$marker = ($valid_shapes{$marker} && ($marker ne 'null')) ?
$obj->make_marker($marker, $color) :
$obj->getIcon($marker);
return undef unless $marker;
($markw, $markh) = $marker->getBounds();
$wdelta = $markw>>1;
$hdelta = $markh>>1;
}
$yoff = ($marker) ? $markh : 2;
#
# render legend if requested
#
$obj->addLegend($color, $marker, $legend, ($line eq 'line')) if $legend;
#
# line/point/area charts
#
# we need to heuristically sort data sets to optimize the view of
# overlapping areagraphs...for now the user will need to be smart
# about the order of registering the datasets
#
$obj->fill_region($obj->{$color}, $ary, $anchor)
if ($line eq 'fill');
($prevpx, $prevpy) = (0,0);
my ($prtX, $prtY);
# draw the rest of the points and lines
my $domain = $obj->{symDomain} ? $obj->{domain} : $ary;
my $xhash = $obj->{symDomain} ? $obj->{domainValues} : undef;
my $domsize = $obj->{symDomain} ? $#$domain : $#$ary;
my $x;
my $incr = $obj->{symDomain} ? 1 : ($line eq 'fill') ? 3 : 2;
my $offset = ($line eq 'fill') ? 2 : 1;
my $xd;
#
# create a brush to draw linegraphs
my $lbrush;
if ($line eq 'line') {
$lbrush = new GD::Image($lw,$lw);
my $ci = $lbrush->colorAllocate(@{$colors{$color}});
$lbrush->filledRectangle(0,0,$lw, $lw,$ci);
$img->setBrush($lbrush);
}
for ($x = 0; $x <= $domsize; $x += $incr) {
$xd = $$xhash{$$domain[$x]} if $obj->{symDomain};
$i = $obj->{symDomain} ? $xd * 2: $x;
next unless defined($$ary[$i+1]);
# get next point
($px, $py) = $obj->pt2pxl(($obj->{symDomain} ? $xd+1 : $$ary[$i]),
$$ary[$i+$offset] );
# draw line from previous point, maybe
$img->line($prevpx, $prevpy, $px, $py, gdBrushed)
if (($line eq 'line') && $i);
($prevpx, $prevpy) = ($px, $py);
# draw point, maybe
$img->copy($marker, $px-$wdelta, $py-$hdelta, 0, 0, $markw,
$markh)
if ($marker);
if ($obj->{genMap} || $showvals) {
($prtX, $prtY) = ($$ary[$i], $$ary[$i+$offset]);
$prtY = 10**$prtY if $obj->{yLog};
$prtX = 10**$prtX if $obj->{xLog};
$prtY = restore_temporal($prtY, $obj->{timeRange}) if $obj->{timeRange};
$prtX = restore_temporal($prtX, $obj->{timeDomain}) if $obj->{timeDomain};
$s = $obj->{symDomain} ? $prtY : "($prtX,$prtY)";
}
$obj->updateImagemap('CIRCLE', $s, $k, $prtX, $prtY,
undef, $px, $py, 4)
if ($obj->{genMap});
$voff = (length($s) * $tfw)>>1,
$obj->string($showvals,0,$px-$voff,$py-$yoff, $s, $tfw)
if $showvals;
}
return 1;
}
sub addLegend {
my ($obj, $color, $shape, $text, $line) = @_;
#
# add the dataset to the legend
#
push @{$obj->{_legends}}, [ $color, $shape, $text, $line ] ;
return 1;
}
sub drawLegend {
my ($obj) = @_;
#
# add the dataset to the legend using current color
# and shape (if any)
#
my ($color, $shape, $text, $line, $props);
my $legary = $obj->{_legends};
my $xadj = 30;
my $xoff = $obj->{horizEdge};
my $maxyoff = $obj->{height} - 40;
my $yoff = $obj->{height} - 40 - 20 - (2 * $tfh);
my ($w, $h);
while (@$legary) {
$props = shift @$legary;
($color, $shape, $text, $line) = @$props;
$color = 'black' unless $color;
$shape = $obj->make_marker('fillsquare', $color)
unless ($shape || $line);
#
# move to next column if shape too big to fit
#
($w, $h) = $shape ? $shape->getBounds() : (20, int($tfh * 1.5));
$yoff = $obj->{height} - 40 - 20 - (2 * $tfh),
$xoff += $xadj
if ($yoff + $h > $maxyoff);
$xadj = ((($w < 20) ? 20 : $w) + ($tfw * (length($text)+2)))
if ($xadj < ((($w < 20) ? 20 : $w) + ($tfw * (length($text)+2))));
my $img = $obj->{img};
$img->line($xoff, $yoff+4, $xoff+20, $yoff+4, $obj->{$color})
if $line;
$obj->string(5, 0,$xoff + ($line ? 25 : ($w + 5)),$yoff, $text, $tfw);
$img->copy($shape, $xoff+5, $yoff, 0, 0, $w-1, $w-1)
if $shape;
$yoff += ($h < int($tfh * 1.5)) ? int($tfh * 1.5) : $h;
}
return 1;
}
# compute pixel coordinates from datapoint
sub pt2pxl {
my ($obj, $x, $y, $z) = @_;
my $plottype = $obj->{plotTypes} & (HISTO|GANTT);
return (
int($obj->{horizEdge} + ($x - $obj->{xl}) * $obj->{xscale}),
int($obj->{vertEdge} - ($y - $obj->{yl}) * $obj->{yscale})
) unless (defined($z) || $plottype);
#
# histo version
return (
int($obj->{horizEdge} + ($y - $obj->{yl}) * $obj->{yscale}),
int($obj->{vertEdge} - ($x - $obj->{xl}) * $obj->{xscale})
) unless defined($z);
#
# translate x,y,z into x,y
#
my $tx = ($x - $obj->{xl}) * $obj->{xscale};
my $ty = ($y - $obj->{yl}) * $obj->{yscale};
Chart/Plot.pm view on Meta::CPAN
$text = substr($text, 0, 22) . '...' if (length($text) > 25);
$obj->string(6, 0, $gx, $gy, $text, $sfw);
}
}
my $xs = $obj->{xValues};
my $xoff = ($yl >= 0) ? 1 : $ishisto ? 0 : 0.5;
my $zv = (($yl >= 0) || $ishisto) ? $zl : $zh;
foreach (0..$#$xs) {
($gx, $gy) = $obj->pt2pxl($_+$xoff, $yl, $zv);
$text = $$xs[$_];
$text = substr($text, 0, 22) . '...' if (length($text) > 25);
$gy += (length($text) * $sfw) + 5,
$obj->string(6, 90, $gx-($sfh>>1), $gy, $text, $sfw),
next
unless $ishisto;
$gx -= (length($text) * $sfw) + 5;
$obj->string(6, 0, $gx, $gy-($sfw>>1), $text, $sfw);
}
my $ystep = $ishisto ? $obj->{horizStep} : $obj->{vertStep};
for ($i = $yl; $i < $yh; $i += $ystep) {
($gx, $gy) = $obj->pt2pxl($xl, $i, $zl);
$text = $i;
$text = substr($text, 0, 22) . '...' if (length($text) > 25);
$gx -= ((length($text) * $sfw) + 5),
$obj->string(6, 0, $gx, $gy-($sfw>>1), $text, $sfw),
next
unless $ishisto;
$gy += ((length($text) * $sfw) + 5),
$obj->string(6, 90, $gx-($sfh>>1), $gy, $text, $sfw);
}
return 1 if $ishisto;
#
# redraw the floor in case we had negative values
for ($i = 18; $i <= $#axesverts; $i+=2) {
$img->line($$xlatverts[$axesverts[$i]],
$$xlatverts[$axesverts[$i]+1],
$$xlatverts[$axesverts[$i+1]],
$$xlatverts[$axesverts[$i+1]+1], $obj->{gridColor});
}
1;
}
sub plot3DBars {
my ($obj) = @_;
my $img = $obj->{img};
my $numRanges = scalar @{$obj->{data}};
my ($xoff, $zcard) = ($obj->{zAxisLabel}) ?
(1.0, $obj->{Zcard}) : (0.9, 1);
my $xbarw = $xoff/$numRanges;
my $zbarw = ($obj->{zh} - $obj->{zl})/($zcard*2);
my ($xvals, $zvals) = ($obj->{xValues}, $obj->{zValues});
my @fronts = ();
my @tops = ();
my @sides = ();
my $legend = $obj->{legend};
my $k = 0;
my $color = 'black';
my $ary;
my $showvals;
my $ys;
my $t;
my $numPts = $#{$obj->{data}->[0]};
my @props;
my $stacked = undef;
my @barcolors = ();
my $svfont = 5;
#
# extract properties
#
for ($k = 0; $k < $numRanges; $k++) {
push @tops, [];
push @fronts, [];
push @sides, [];
$t = $obj->{props}->[$k];
$t=~s/\s+/ /g;
$t = lc $t;
@props = split (' ', $t);
$stacked = 0;
foreach (@props) {
$showvals = [ ], $svfont = $1, next if /^showvalues:(\d+)/i;
$stacked = 1, next if ($_ eq 'stack');
#
# generate light, medium, and dark version for front,
# top, and side faces
#
$color = $_,
push(@barcolors, $_),
$obj->{$color} = $img->colorAllocate(@{$colors{$_}}),
push(@{$tops[$k]}, $obj->{$color}),
push(@{$fronts[$k]}, $img->colorAllocate(int($colors{$_}->[0] * 0.8),
int($colors{$_}->[1] * 0.8), int($colors{$_}->[2] * 0.8))),
push(@{$sides[$k]}, $img->colorAllocate(int($colors{$_}->[0] * 0.6),
int($colors{$_}->[1] * 0.6), int($colors{$_}->[2] * 0.6))),
if ($colors{$_});
}
if (($legend) && ($$legend[$k])) {
$obj->addLegend($color, undef, $$legend[$k], undef), next
unless $stacked;
$obj->addLegend($barcolors[$_], undef, $$legend[$k]->[$_], undef)
foreach (0..$#{$$legend[$k]});
}
}
#
# draw each bar
# WE NEED A BETTER CONTROL VALUE HERE!!! since different plots may not
# have the exact same domain!!!
#
my ($i, $j) = (0,0);
unless (($numRanges > 1) || $stacked) {
#
# to support multicolor single ranges
$ary = $obj->{data}->[0];
for (; $i <= $numPts; $i+=3) {
$ys = $$ary[$i+1];
$obj->drawCube($$ary[$i], $$ys[0], $$ys[1], $$ary[$i+2],
0, $fronts[0]->[$j], $tops[0]->[$j], $sides[0]->[$j],
$xoff, $xbarw, $zbarw, $$xvals[$$ary[$i]-1],
$$zvals[$$ary[$i+2]-1], $showvals);
$obj->renderCubeValues($showvals, $svfont) if $showvals;
$j++;
$j = 0 if ($j > $#{$fronts[0]});
}
return 1;
}
#
# multirange (or stacked), draw the bar for each dataset
$numRanges--;
for (; $i <= $numPts; $i+=3) {
foreach $k (0..$numRanges) {
$numPts = $#{$obj->{data}->[$k]};
$ary = $obj->{data}->[$k];
$ys = $$ary[$i+1];
$obj->drawCube($$ary[$i], $$ys[$_-1], $$ys[$_], $$ary[$i+2],
$k, $fronts[$k]->[$_-1], $tops[$k]->[$_-1], $sides[$k]->[$_-1],
$xoff, $xbarw, $zbarw, $$xvals[$$ary[$i]-1],
$$zvals[$$ary[$i+2]-1], $showvals, $stacked),
foreach (1..$#$ys);
$obj->renderCubeValues($showvals, $svfont) if $showvals;
}
}
return 1;
}
sub computeSides {
my ($x, $xoff, $barw, $k) = @_;
return ($x - ($xoff/2) + ($k * $barw),
$x - ($xoff/2) + (($k+1) * $barw));
}
sub drawCube {
my ($obj, $x, $yl, $yh, $z, $k, $front, $top, $side,
$xoff, $xbarw, $zbarw, $xval, $zval, $showvals, $stacked) = @_;
my ($xl, $xr) = computeSides($x, $xoff, $xbarw, $k);
my $ishisto = $obj->{plotTypes} & HISTO;
my @val_stack = ();
my ($mx, $px, $py);
$z++;
#
Chart/Plot.pm view on Meta::CPAN
# if none of the fonts provided exists, then use defaults
#
$img->string($font,$x,$y, $val, $obj->{textColor}),
return 1
unless $angle;
$img->stringUp($font,$x,$y, $val, $obj->{textColor});
return 1
}
1;
}
__END__
=head1 NAME
DBD::Chart::Plot - Graph/chart Plotting engine for DBD::Chart
=head1 SYNOPSIS
use DBD::Chart::Plot;
my $img = DBD::Chart::Plot->new();
my $anotherImg = DBD::Chart::Plot->new($image_width, $image_height);
$img->setPoints(\@xdataset, \@ydataset, 'blue line nopoints');
$img->setOptions (
horizMargin => 75,
vertMargin => 100,
title => 'My Graph Title',
xAxisLabel => 'my X label',
yAxisLabel => 'my Y label' );
print $img->plot;
=head1 DESCRIPTION
B<DBD::Chart::Plot> creates images of various types of graphs for
2 or 3 dimensional data. Unlike GD::Graph, the input data sets
do not need to be uniformly distributed in the domain (X-axis),
and may be either numeric, temporal, or symbolic.
B<DBD::Chart::Plot> supports the following:
=over 4
=item - multiple data set plots
=item - line graphs, areagraphs, scatter graphs, linegraphs w/ points,
candlestick graphs, barcharts (2-D, 3-D, and 3-axis), histograms,
piecharts, box & whisker charts (aka boxcharts), and Gantt charts
=item - optional iconic barcharts or datapoints
=item - a wide selection of colors, and point shapes
=item - optional horizontal and/or vertical gridlines
=item - optional legend
=item - auto-sizing of axes based in input dataset ranges
=item - optional symbolic and temproal (i.e., non-numeric) domain values
=item - automatic sorting of numeric and temporal input datasets to assure
proper order of plotting
=item - optional X, Y, and Z axis labels
=item - optional X and/or Y logarithmic scaling
=item - optional title
=item - optional adjustment of horizontal and vertical margins
=item - optional HTML or Perl imagemap generation
=item - composite images from multiple graphs
=item - user programmable colors
=back
=head1 PREREQUISITES
=over 4
=item B<GD.pm> module minimum version 1.26 (available on B<CPAN>)
GD.pm requires additional libraries:
=item libgd
=item libpng
=item zlib
=head1 USAGE
=head2 Create an image object: new()
use DBD::Chart::Plot;
my $img = DBD::Chart::Plot->new;
my $img = DBD::Chart::Plot->new ( $image_width, $image_height );
my $img = DBD::Chart::Plot->new ( $image_width, $image_height, \%colormap );
my $anotherImg = new DBD::Chart::Plot;
Creates an empty image. If image size is not specified,
the default is 400 x 300 pixels.
=head2 Graph-wide options: setOptions()
$img->setOptions (_title => 'My Graph Title',
xAxisLabel => 'my X label',
yAxisLabel => 'my Y label',
xLog => 0,
yLog => 0,
horizMargin => $numHorPixels,
vertMargin => $numvertPixels,
horizGrid => 1,
vertGrid => 1,
showValues => 1,
legend => \@plotnames,
genMap => 'a_valid_HTML_anchor_name',
mapURL => 'http://some.website.com/cgi-bin/cgi.pl',
icon => [ 'redstar.png', 'bluestar.png' ]
symDomain => 0
);
As many (or few) of the options may be specified as desired.
=item width, height
The width and height of the image in pixels. Default is 400 and 300,
respectively.
=item genMap, mapType, mapURL, mapScript
Control generation of imagemaps. When genMap is set to a legal HTML
anchor name, an image map of the specified type is created for the image.
The default type is 'HTML' if no mapType is specified. Legal types are
'HTML' and 'PERL'.
If mapType is 'PERL', then Perl script compatible text is generated
representing an array ref of hashrefs containing the following
attributes:
plotnum => the plot number to which this hashref applies (to support
multi-range graphs), starting at zero.
x => the domain value for the plot element
y => the range value for the plot element
z => the Z axis value for 3-axis bar charts, if any
shape => the shape of the hotspot area of the plot element, same
as for HTML: 'RECT', 'CIRCLE', 'POLY'
coordinates => an arrayref of the (x,y) pixel coordinates of the hotspot
area to be mapped; for CIRCLE shape, its (x-center, y-center, radius),
for RECT, its (upper-left corner x, upper-left corner y,
lower-right corner x, lower-right corner y), and for POLY its the
set of vertices (x,y)'s.
If the mapType is 'HTML', then either the mapURL or mapScript (or both)
can be specified. mapURL specifies a legal URL string, e.g.,
'http://www.mysite.com/cgi-bin/plotproc.pl?plotnum=:PLOTNUM&X=:X&Y=:Y',
which will be added to the AREA tags generated for each mapped plot element.
mapScript specifies any legal HTML scripting tag, e.g.,
'ONCLICK="alert('Got X=:X, Y=:Y')"' to be added to each generated AREA tag.
For both mapURL and mapScript, special variables :PLOTNUM, :X, :Y, :Z
can be specified which are replaced by the following values when the
imagemap is generated.
Refer to the IMAGEMAP description at www.presicient.com/dbdchart#imagemap
for details.
=item horizMargin, vertMargin
Sets the number of pixels around the actual plot area.
=item xAxisLabel, yAxisLabel, zAxisLabel
Sets the label strings for each axis.
=item xLog, yLog
When set to a non-zero value, causes the associated axis to be
rendered in log10 format. Z axis plots are currently only
symbolic, so no zLog is supported.
=item title
Sets a title string to be rendered at the bottom center of the image
in bold text.
=item signature
Sets a string to be rendered in tiny font at the lower right corner of the
image, e.g., 'Copyright(C) 2001, Presicient Corp.'.
=item legend
Set to an array ref of domain names to be displayed in a legend
for the various plots.
The legend is displayed below the chart, left justified and placed
above the chart title string.
The legend for each plot is
printed in the same color as the plot. If a point shape or icon has been specified
for a plot, then the point shape is printed with the label; otherwise, a small
line segment is printed with the label. Due to space limitations,
the number of datasets plotted should be limited to 8 or less.
=item showValues
When set to a non-zero value, causes the data points for each
plotted element to be displayed next to hte plot point.
=item horizGrid, vertGrid
Causes grid lines to be drawn completely across the plot area.
=item xAxisVert
When set to a non-zero value, causes the X axis tick labels to be rendered
vertically.
=item keepOrigin
When set to a non-zero value, forces the (0,0) data point into the
graph. Normally, DBD::Chart::Plot will heuristically clip away from the
origin is the plot never crosses the origin.
=item bgColor
Sets the background color of the image. Default is white.
=item threed
When set to a non-zero value for barcharts, causes the bars to be
rendered in a 3-D effect.
=item icons
Set to an arrayref of image filenames. The images will be used
to plot iconic barcharts or individual plot points, if the
'icon' shape is specified in the property string supplied
to the setPoints() function (defined below). The array must
match 1-to-1 with the number of plots in the image; icons
and predefined point shapes can be mixed in the same image
by setting the icon arrayref entry to undef for plots using
predefined shapes in the properties string.
=item symDomain
When set to a non-zero value, causes the domain to be treated
as discrete symbolic values which are evenly distributed over
the X-axis. Numeric domains are plotted as scaled values
in the image.
=item timeDomain
When set to a valid format string, the domain data points
are treated as associated temporal values (e.g., date, time,
timestamp, interval). The values supplied by setPoints will
be strings of the specified format (e.g., 'YYYY-MM-DD'), but
will be converted to numeric time values for purposes of
plotting, so the domain is treated as continuous numeric
( run in 1.639 second using v1.01-cache-2.11-cpan-d8267643d1d )