Chart
view release on metacpan or search on metacpan
lib/Chart/Base.pm view on Meta::CPAN
$self->{'curr_x_min'} = 0;
$self->{'curr_x_max'} = $x; # maximum pixel in x direction (right)
# use a 10 pixel border around the whole png
$self->{'png_border'} = 10;
# leave some space around the text fields
$self->{'text_space'} = 2;
# and leave some more space around the chart itself
$self->{'graph_border'} = 10;
# leave a bit of space inside the legend box
$self->{'legend_space'} = 4;
# set some default fonts
$self->{'title_font'} = gdLargeFont,
$self->{'sub_title_font'} = gdLargeFont,
$self->{'legend_font'} = gdSmallFont,
$self->{'label_font'} = gdMediumBoldFont,
$self->{'tick_label_font'} = gdSmallFont;
# put the legend on the bottom of the chart
$self->{'legend'} = 'right';
# default to an empty list of labels
$self->{'legend_labels'} = [];
# use 20 pixel length example lines in the legend
$self->{'legend_example_size'} = 20;
# Set the maximum & minimum number of ticks to use.
$self->{'y_ticks'} = 6,
$self->{'min_y_ticks'} = 6,
$self->{'max_y_ticks'} = 100,
$self->{'x_number_ticks'} = 1,
$self->{'min_x_ticks'} = 6,
$self->{'max_x_ticks'} = 100;
# make the ticks 4 pixels long
$self->{'tick_len'} = 4;
# no custom y tick labels
$self->{'y_tick_labels'} = undef;
# no patterns
$self->{'patterns'} = undef;
# let the lines in Chart::Lines be 6 pixels wide
$self->{'brush_size'} = 6;
# let the points in Chart::Points and Chart::LinesPoints be 18 pixels wide
$self->{'pt_size'} = 18;
# use the old non-spaced bars
$self->{'spaced_bars'} = 'true';
# use the new grey background for the plots
$self->{'grey_background'} = 'true';
# don't default to transparent
$self->{'transparent'} = 'false';
# default to "normal" x_tick drawing
$self->{'x_ticks'} = 'normal';
# we're not a component until Chart::Composite says we are
$self->{'component'} = 'false';
# don't force the y-axes in a Composite chare to be the same
$self->{'same_y_axes'} = 'false';
# plot rectangeles in the legend instead of lines in a composite chart
$self->{'legend_example_height'} = 'false';
# don't force integer y-ticks
$self->{'integer_ticks_only'} = 'false';
# don't forbid a false zero scale.
$self->{'include_zero'} = 'false';
# don't waste time/memory by storing imagemap info unless they ask
$self->{'imagemap'} = 'false';
# default for grid_lines is off
$self->{grid_lines} = 'false',
$self->{x_grid_lines} = 'false',
$self->{y_grid_lines} = 'false',
$self->{y2_grid_lines} = 'false';
# default for no_cache is false. (it breaks netscape 4.5)
$self->{no_cache} = 'false';
# default value for skip_y_ticks for the labels
$self->{skip_y_ticks} = 1;
# default value for skip_int_ticks only for integer_ticks_only
$self->{skip_int_ticks} = 1;
# default value for precision
$self->{precision} = 3;
# default value for legend label values in pie charts
$self->{legend_label_values} = 'value';
# default value for the labels in a pie chart
$self->{label_values} = 'percent';
# default position for the y-axes
$self->{y_axes} = 'left';
# copies of the current values at the x-ticks function
$self->{temp_x_min} = 0;
$self->{temp_x_max} = 0;
$self->{temp_y_min} = 0;
$self->{temp_y_max} = 0;
# Instance for a sum
$self->{sum} = 0;
# Don't sort the data unless they ask
$self->{'sort'} = 'false';
lib/Chart/Base.pm view on Meta::CPAN
$self->{'x_tick_label_length'} = $length;
# find x-scale, if a x-y plot is wanted
# makes only sense for some charts
if ( $self->true( $self->{'xy_plot'} ) && ( $self->isa('Chart::Lines')
|| $self->isa('Chart::Points')
|| $self->isa('Chart::LinesPoints')
|| $self->isa('Chart::Split')
|| $self->isa('Chart::ErrorBars') ) ) {
$self->_find_x_scale;
}
return 1;
}
## @fn private int _draw
# Plot the chart to the gd object\n
# Calls:
# @see _draw_title
# @see _draw_sub_title
# @see _sort_data
# @see _plot
#
# @return status
sub _draw {
my $self = shift;
# leave the appropriate border on the png
$self->{'curr_x_max'} -= $self->{'png_border'};
$self->{'curr_x_min'} += $self->{'png_border'};
$self->{'curr_y_max'} -= $self->{'png_border'};
$self->{'curr_y_min'} += $self->{'png_border'};
# draw in the title
$self->_draw_title() if $self->{'title'};
# have to leave this here for backwards compatibility
$self->_draw_sub_title() if $self->{'sub_title'};
# sort the data if they want to (mainly here to make sure
# pareto charts get sorted)
$self->_sort_data() if ( $self->true( $self->{'sort'} ) );
# start drawing the data (most methods in this will be
# overridden by the derived classes)
# include _draw_legend() in this to ensure that the legend
# will be flush with the chart
$self->_plot();
# and return
return 1;
}
## @fn private int _set_colors
# specify my colors
# @return status
sub _set_colors {
my $self = shift;
my $index = $self->_color_role_to_index('background'); # allocate GD color
if ( $self->true( $self->{'transparent'} ) )
{
$self->{'gd_obj'}->transparent($index);
}
# all other roles are initialized by calling $self->_color_role_to_index(ROLENAME);
# and return
return 1;
}
## @fn private int _color_role_to_index
# return a (list of) color index(es) corresponding to the (list of) role(s)
#
# @details wantarray
# is a special keyword which returns a flag indicating
# which context your subroutine has been called in.
# It will return one of three values.
#
# @li true: If your subroutine has been called in list context
# @li false: If your subroutine has been called in scalar context
# @li undef: If your subroutine has been called in void context
#
# @return a (list of) color index(es) corresponding to the (list of) role(s) in \\\@_.
sub _color_role_to_index {
my $self = shift;
# Return a (list of) color index(es) corresponding to the (list of) role(s) in @_.
my @result = map {
my $role = $_;
my $index = $self->{'color_table'}->{$role};
unless ( defined $index ) {
my $spec =
$self->{'colors'}->{$role}
|| $self->{'colors_default_spec'}->{$role}
|| $self->{'colors_default_spec'}->{ $self->{'colors_default_role'}->{$role} };
my @rgb = $self->_color_spec_to_rgb( $role, $spec );
my $string = sprintf " RGB(%d,%d,%d)", map { $_ + 0 } @rgb;
$index = $self->{'color_table'}->{$string};
unless ( defined $index ) {
$index = $self->{'gd_obj'}->colorAllocate(@rgb);
$self->{'color_table'}->{$string} = $index;
}
$self->{'color_table'}->{$role} = $index;
}
$index;
} @_;
( wantarray && @_ > 1 ? @result : $result[0] );
}
sub _color_spec_to_rgb {
my ($self, $role, $spec) = @_; # color role name (from set) for error msg
my $color = Chart::Property::DataType::Color->new( $spec );
return croak "Unrecognized color for $role\n" unless ref $color;
$color->rgb;
}
## @fn private int _brushStyles_of_roles
lib/Chart/Base.pm view on Meta::CPAN
}
return 1;
}
## @fn private int _prepare_brush($color,$type,$role)
# prepare brush
#
# @details
# set the gdBrush object to tick GD into drawing fat lines & points
# of interesting shapes
# Needed by "Lines", "Points" and "LinesPoints"
# All hacked up by Richard Dice <rdice@pobox.com> Sunday 16 May 1999
#
# @param color
# @param type 'line','point'
# @param role
#
# @return status
sub _prepare_brush {
my $self = shift;
my $color = shift;
my $type = shift;
my $role = shift || 'default';
my $brushStyle = $self->{'brushStyle'};
if ( defined $role ) {
my (@brushStyles) = $self->_brushStyles_of_roles($role);
$brushStyle = $brushStyles[0];
}
#print STDERR "role=$role\n";
# decide what $type should be in the event that a param isn't
# passed -- this is necessary to preserve backward compatibility
# with apps that use this module prior to putting _prepare_brush
# in with Base.pm
if ( !defined($type) ) { $type = 'point'; }
if ( ( !length($type) )
|| ( !grep { $type eq $_ } ( 'line', 'point' ) ) ) {
$brushStyle = $self->{'brushStyle'};
$type = 'line' if ref $self eq 'Chart::Lines';
$type = 'point' if ref $self eq 'Chart::Points';
}
my ( $radius, @rgb, $brush, $white, $newcolor );
# get the rgb values for the desired color
@rgb = $self->{'gd_obj'}->rgb($color);
# get the appropriate brush size
if ( $type eq 'line' ) {
$radius = $self->{'brush_size'} / 2;
} elsif ( $type eq 'point' ) {
$radius = $self->{'pt_size'} / 2;
}
# create the new image
$brush = GD::Image->new( $radius * 2, $radius * 2 );
# get the colors, make the background transparent
$white = $brush->colorAllocate( 255, 255, 255 );
$newcolor = $brush->colorAllocate(@rgb);
$brush->transparent($white);
# draw the circle
if ( $type eq 'line' ) {
$brush->arc( $radius - 1, $radius - 1, $radius, $radius, 0, 360, $newcolor );
$brush->fill( $radius - 1, $radius - 1, $newcolor );
# RLD
#
# Does $brush->fill really have to be here? Dunno... this
# seems to be a relic from earlier code
#
# Note that 'line's don't benefit from a $brushStyle... yet.
# It shouldn't be too tough to hack this in by taking advantage
# of GD's gdStyled facility
}
if ( $type eq 'point' ) {
$brushStyle = $self->{'brushStyle'}
unless grep { $brushStyle eq $_ } (
'FilledCircle', 'circle', 'donut', 'OpenCircle',
'triangle', 'upsidedownTriangle', 'square', 'hollowSquare',
'OpenRectangle', 'fatPlus', 'Star', 'OpenStar',
'FilledDiamond', 'OpenDiamond'
);
my ( $xc, $yc ) = ( $radius, $radius );
if ( grep { $brushStyle eq $_ } ( 'default', 'circle', 'donut', 'OpenCircle', 'FilledCircle' ) ) {
$brush->arc( $xc, $yc, $radius, $radius, 0, 360, $newcolor );
$brush->fill( $xc, $yc, $newcolor );
# draw a white (and therefore transparent) circle in the middle
# of the existing circle to make the "donut", if appropriate
if ( $brushStyle eq 'donut' || $brushStyle eq 'OpenCircle' )
{
$brush->arc( $xc, $yc, int( $radius / 2 ), int( $radius / 2 ), 0, 360, $white );
$brush->fill( $xc, $yc, $white );
}
}
if ( grep { $brushStyle eq $_ } ( 'triangle', 'upsidedownTriangle' ) ) {
my $poly = new GD::Polygon;
my $sign = ( $brushStyle eq 'triangle' ) ? 1 : (-1);
my $z = int( 0.8 * $radius ); # scaling factor
# co-ords are chosen to make an equilateral triangle
$poly->addPt( $xc, $yc - ( $z * $sign ) );
$poly->addPt( $xc + int( ( sqrt(3) * $z ) / 2 ), $yc + ( int( $z / 2 ) * $sign ) );
$poly->addPt( $xc - int( ( sqrt(3) * $z ) / 2 ), $yc + ( int( $z / 2 ) * $sign ) );
$brush->filledPolygon( $poly, $newcolor );
}
if ( $brushStyle eq 'fatPlus' ) {
my $poly = new GD::Polygon;
my $z = int( 0.3 * $radius );
$poly->addPt( $xc + $z, $yc + $z );
$poly->addPt( $xc + 2 * $z, $yc + $z );
$poly->addPt( $xc + 2 * $z, $yc - $z );
$poly->addPt( $xc + $z, $yc - $z );
$poly->addPt( $xc + $z, $yc - 2 * $z );
$poly->addPt( $xc - $z, $yc - 2 * $z );
$poly->addPt( $xc - $z, $yc - $z );
$poly->addPt( $xc - 2 * $z, $yc - $z );
$poly->addPt( $xc - 2 * $z, $yc + $z );
$poly->addPt( $xc - $z, $yc + $z );
$poly->addPt( $xc - $z, $yc + 2 * $z );
$poly->addPt( $xc + $z, $yc + 2 * $z );
$brush->filledPolygon( $poly, $newcolor );
}
if ( $brushStyle eq 'Star' || $brushStyle eq 'OpenStar' ) {
my $poly = new GD::Polygon;
my $z = int($radius);
my $sz = int( $z / 3 * 1.75 ); # small z
my $x1 = int( $xc + $z );
my $y1 = int($yc);
my ( $x2, $y2 );
my $xyRatio = $self->_xyRatio();
$poly->addPt( $x1, $y1 );
$x2 = $xc + int( $sz * 0.5 );
( run in 1.424 second using v1.01-cache-2.11-cpan-39bf76dae61 )