From dfd889da462b52589a8b1d8dfa8aecf64be9f7ec Mon Sep 17 00:00:00 2001 From: pmichaud Date: Sun, 22 Mar 2009 23:41:13 +0000 Subject: [PATCH] changes from Patrick Michaud, line, bar, stacked column graphs --- Graph.pm | 179 +++++++++++++++++++- lib/Imager/Graph/Column.pm | 253 ++++++++++++++++++++++++++++ lib/Imager/Graph/Line.pm | 237 ++++++++++++++++++++++++++ lib/Imager/Graph/Pie.pm | 67 +++++--- lib/Imager/Graph/StackedColumn.pm | 269 ++++++++++++++++++++++++++++++ t/t20api.t | 59 +++++++ 6 files changed, 1042 insertions(+), 22 deletions(-) create mode 100644 lib/Imager/Graph/Column.pm create mode 100644 lib/Imager/Graph/Line.pm create mode 100644 lib/Imager/Graph/StackedColumn.pm create mode 100644 t/t20api.t diff --git a/Graph.pm b/Graph.pm index 0f7b05c..32606b2 100644 --- a/Graph.pm +++ b/Graph.pm @@ -45,6 +45,127 @@ sub new { bless {}, $_[0]; } +=item setGraphSize($size) + +Sets the size of the graph (in pixels) within the image. The size of the image defaults to 1.5 * $graph_size. + +=cut + +sub setGraphSize { + $_[0]->{'graph_size'} = $_[1]; +} + +sub _getGraphSize { + return $_[0]->{'graph_size'}; +} + +=item setImageWidth($width) + +Sets the width of the image in pixels. + +=cut + +sub setImageWidth { + $_[0]->{'image_width'} = $_[1]; +} + +sub _getImageWidth { + return $_[0]->{'image_width'}; +} + +=item setImageHeight($height) + +Sets the height of the image in pixels. + +=cut + +sub setImageHeight { + $_[0]->{'image_height'} = $_[1]; +} + +sub _getImageHeight { + return $_[0]->{'image_height'}; +} + +=item addDataSeries([8, 6, 7, 5, 3, 0, 9], 'Series Name'); + +Adds a data series to the graph. For L, only one data series can be added. + +=cut + +sub addDataSeries { + my $self = shift; + my $data_ref = shift; + my $series_name = shift; + + my $graph_data = $self->{'graph_data'} || []; + + push @$graph_data, { data => $data_ref, series_name => $series_name }; + + $self->{'graph_data'} = $graph_data; + return; +} + +sub _getDataSeries { + return $_[0]->{'graph_data'}; +} + +=item setLabels(['label1', 'label2' ... ]) + +Labels the specific data points. For line/bar graphs, this is the x-axis. For pie graphs, it is the label for the wedges. + +=cut + +sub setLabels { + $_[0]->{'labels'} = $_[1]; +} + +sub _getLabels { + return $_[0]->{'labels'} +} + +=item setTitle($title) + +Sets the title of the graph. Requires setting a font. + +=cut + +sub setTitle { + $_[0]->{'image_title'} = $_[1]; +} + +sub _getTitle { + return $_[0]->{'image_title'}; +} + +=item setFont(Imager::Font->new()) + +Sets the font to use for text. Takes an L object. + +=cut + +sub setFont { + $_[0]->{'font'} = $_[1]; +} + +sub _getFont { + return $_[0]->{'font'}; +} + +=item setStyle($style_name) + +Sets the style to be used for the graph. Imager::Graph comes with several pre-defined styles: fount_lin (default), fount_rad, mono, primary_red, and primary. + +=cut + +sub setStyle { + $_[0]->{'style'} = $_[1]; +} + +sub _getStyle { + return $_[0]->{'style'}; +} + =item error Returns an error message. Only value if the draw() method returns false. @@ -719,6 +840,24 @@ sub _style_defs { \%style_defs; } +sub _processOptions { + my $self = shift; + my $opts = shift; + + if ($opts->{'style'}) { + $self->setStyle($opts->{'style'}); + } + + if ($opts->{'data'}) { + $self->addDataSeries($opts->{'data'}); + } + if ($opts->{'labels'}) { + $self->setLabels($opts->{'labels'}); + } +} + + + # Let's make the default something that looks really good, so folks will be interested enough to customize the style. my $def_style = 'fount_lin'; @@ -806,6 +945,9 @@ my %styles = colors=>[ NC('FFC0FF'), NC('FF00FF') ]), }, ], + colors => [ + qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF) + ], back=>{ fountain=>'linear', xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, @@ -851,6 +993,9 @@ my %styles = colors=>[ NC('FF80FF'), NC('FF00FF') ]), }, ], + colors => [ + qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF) + ], back=>{ fountain=>'linear', xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, @@ -873,7 +1018,20 @@ sub _style_setup { my ($self, $opts) = @_; my $style_defs = $self->_style_defs; my $style; - $style = $styles{$opts->{style}} if $opts->{style}; + + # fill in values from api calls + $opts->{'size'} = $opts->{'size'} || $self->_getGraphSize(); + $opts->{'width'} = $opts->{'width'} || $self->_getImageWidth(); + $opts->{'height'} = $opts->{'height'} || $self->_getImageHeight(); + $opts->{'font'} = $opts->{'font'} || $self->_getFont(); + $opts->{'title'} = $opts->{'title'}; + if (!$opts->{'title'} && $self->_getTitle()) { + $opts->{'title'} = { text => $self->_getTitle() }; + } + + my $pre_def_style = $self->_getStyle(); + $style = $styles{$pre_def_style} if $pre_def_style; + $style ||= $styles{$def_style}; my @search_list = ( $style_defs, $style, $opts); @@ -1176,6 +1334,25 @@ sub _data_fill { "data.$index"); } +sub _data_color { + my ($self, $index) = @_; + + my $colors = $self->{'_style'}{'colors'} || []; + my $fills = $self->{'_style'}{'fills'} || []; + + # Try to just use a fill, so non-fountain styles don't need + # to have a duplicated set of fills and colors + my $fill = $fills->[$index % @$fills]; + if (!ref $fill) { + return $fill; + } + + if (@$colors) { + return $colors->[$index % @$colors] || '000000'; + } + return '000000'; +} + =item _get_fill($index, $box) Retrieves fill parameters for a named fill. diff --git a/lib/Imager/Graph/Column.pm b/lib/Imager/Graph/Column.pm new file mode 100644 index 0000000..099141a --- /dev/null +++ b/lib/Imager/Graph/Column.pm @@ -0,0 +1,253 @@ +package Imager::Graph::Column; + +=head1 NAME + + Imager::Graph::Column - a tool for drawing column charts on Imager images + +=head1 SYNOPSIS + + This subclass is still in green development. + +=cut + +use strict; +use vars qw(@ISA); +use Imager::Graph; +@ISA = qw(Imager::Graph); + +=item setYTics($count) + +Set the number of Y tics to use. Their value and position will be determined by the data range. + +=cut + +sub setYTics { + $_[0]->{'y_tics'} = $_[1]; +} + +sub _getYTics { + return $_[0]->{'y_tics'}; +} + +sub draw { + my ($self, %opts) = @_; + + $self->_processOptions(\%opts); + + if (!$self->_validInput()) { + return; + } + + $self->_style_setup(\%opts); + + my $style = $self->{_style}; + + my $img = $self->_make_img() + or return; + + my @chart_box = ( 0, 0, $img->getwidth-1, $img->getheight-1 ); + + my @labels = map { $_->{'series_name'} } @{$self->_getDataSeries()}; + if ($style->{features}{legend} && (scalar @labels)) { + $self->_draw_legend($img, \@labels, \@chart_box) + or return; + } + + my @series = @{$self->_getDataSeries()}; + my $max_value = 0; + my $min_value = 0; + + my $column_count = 0; + foreach my $series (@series) { + my @data = @{$series->{'data'}}; + + foreach my $value (@data) { + $column_count++; + if ($value > $max_value) { $max_value = $value; } + if ($value < $min_value) { $min_value = $value; } + } + } + + my $value_range = $max_value - $min_value; + + my $width = $self->_get_number('width'); + my $height = $self->_get_number('height'); + my $size = $self->_get_number('size'); + + my $bottom = ($height - $size) / 2; + my $left = ($width - $size) / 2; + + my @graph_box = ( $left, $bottom, $left + $size - 1, $bottom + $size - 1 ); + + $img->box( + color => '000000', + xmin => $left, + xmax => $left+$size, + ymin => $bottom, + ymax => $bottom+$size, + ); + + $img->box( + color => 'FFFFFF', + xmin => $left + 1, + xmax => $left+$size - 1, + ymin => $bottom + 1, + ymax => $bottom+$size -1 , + filled => 1, + ); + + my $zero_position = $bottom + $size - (-1*$min_value / $value_range) * ($size -1); + + if ($min_value < 0) { + $img->box( + color => 'EEEEEE', + xmin => $left + 1, + xmax => $left+$size - 1, + ymin => $zero_position, + ymax => $bottom+$size -1, + filled => 1, + ); + } + + if ($self->_getYTics()) { + $self->_drawYTics($img, $min_value, $max_value, $self->_getYTics(), \@graph_box, \@chart_box); + } + if ($self->_getLabels()) { + $self->_drawXTics($img, \@graph_box, \@chart_box); + } + + my $bar_width = $size / $column_count; + + my $outline_color; + if ($style->{'features'}{'outline'}) { + $outline_color = $self->_get_color('outline.line'); + } + + my $series_counter = 0; + foreach my $series (@series) { + my @data = @{$series->{'data'}}; + my $data_size = scalar @data; + my @fill = $self->_data_fill($series_counter, \@graph_box); + my $color = $self->_data_color($series_counter); + for (my $i = 0; $i < $data_size; $i++) { + my $x1 = $left + $i * $size / ($data_size) + ($bar_width * $series_counter); + my $x2 = $x1 + $bar_width; + + my $y1 = $bottom + ($value_range - $data[$i] + $min_value)/$value_range * $size; + + if ($data[$i] > 0) { + $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position-1, @fill); + if ($style->{'features'}{'outline'}) { + $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position, color => $outline_color); + } + } + else { + $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position, ymax => $y1-1, @fill); + if ($style->{'features'}{'outline'}) { + $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position, ymax => $y1, color => $outline_color); + } + } + } + + $series_counter++; + } + + return $img; +} + +sub _drawYTics { + my $self = shift; + my $img = shift; + my $min = shift; + my $max = shift; + my $tic_count = shift; + my $graph_box = shift; + my $image_box = shift; + + my $interval = ($max - $min) / ($tic_count - 1); + + my %text_info = $self->_text_style('legend') + or return; + + my $tic_distance = ($graph_box->[3] - $graph_box->[1]) / ($tic_count - 1); + for my $count (0 .. $tic_count - 1) { + my $x1 = $graph_box->[0] - 5; + my $x2 = $graph_box->[0] + 5; + my $y1 = $graph_box->[3] - ($count * $tic_distance); + + $img->line(x1 => $x1, x2 => $x2, y1 => $y1, y2 => $y1, aa => 1, color => '000000'); + + my $value = sprintf("%.2f", ($count*$interval)+$min); + + my @box = $self->_text_bbox($value, 'legend') + or return; + + my $width = $box[2]; + my $height = $box[3]; + + $img->string(%text_info, + x => ($x1 - $width - 3), + y => ($y1 + ($height / 2)), + text => $value + ); + } + +} + +sub _drawXTics { + my $self = shift; + my $img = shift; + my $graph_box = shift; + my $image_box = shift; + + my $labels = $self->_getLabels(); + + my $tic_count = (scalar @$labels) - 1; + + my $tic_distance = ($graph_box->[2] - $graph_box->[0]) / ($tic_count); + my %text_info = $self->_text_style('legend') + or return; + + for my $count (0 .. $tic_count) { + my $label = $labels->[$count]; + my $x1 = $graph_box->[0] + ($tic_distance * $count); + my $y1 = $graph_box->[3] + 5; + my $y2 = $graph_box->[3] - 5; + + $img->line(x1 => $x1, x2 => $x1, y1 => $y1, y2 => $y2, aa => 1, color => '000000'); + + my @box = $self->_text_bbox($label, 'legend') + or return; + + my $width = $box[2]; + my $height = $box[3]; + + $img->string(%text_info, + x => ($x1 - ($width / 2)), + y => ($y1 + ($height + 5)), + text => $label + ); + + } +} + +sub _validInput { + my $self = shift; + + if (!defined $self->_getDataSeries() || !scalar @{$self->_getDataSeries()}) { + return $self->_error("No data supplied"); + } + + if (!scalar @{$self->_getDataSeries()->[0]->{'data'}}) { + return $self->_error("No values in data series"); + } + + my @data = @{$self->_getDataSeries()->[0]->{'data'}}; + + return 1; +} + + + +1; + diff --git a/lib/Imager/Graph/Line.pm b/lib/Imager/Graph/Line.pm new file mode 100644 index 0000000..f69079c --- /dev/null +++ b/lib/Imager/Graph/Line.pm @@ -0,0 +1,237 @@ +package Imager::Graph::Line; + +=head1 NAME + + Imager::Graph::Line - a tool for drawing line charts on Imager images + +=head1 SYNOPSIS + + This subclass is still in green development. + +=cut + +use strict; +use vars qw(@ISA); +use Imager::Graph; +@ISA = qw(Imager::Graph); + +=item setYTics($count) + +Set the number of Y tics to use. Their value and position will be determined by the data range. + +=cut + +sub setYTics { + $_[0]->{'y_tics'} = $_[1]; +} + +sub _getYTics { + return $_[0]->{'y_tics'}; +} + +sub draw { + my ($self, %opts) = @_; + + $self->_processOptions(\%opts); + + if (!$self->_validInput()) { + return; + } + + $self->_style_setup(\%opts); + + my $style = $self->{_style}; + + my $img = $self->_make_img() + or return; + + my @chart_box = ( 0, 0, $img->getwidth-1, $img->getheight-1 ); + + my @labels = map { $_->{'series_name'} } @{$self->_getDataSeries()}; + if ($style->{features}{legend} && (scalar @labels)) { + $self->_draw_legend($img, \@labels, \@chart_box) + or return; + } + + my @series = @{$self->_getDataSeries()}; + my $max_value = 0; + my $min_value = 0; + + foreach my $series (@series) { + my @data = @{$series->{'data'}}; + + foreach my $value (@data) { + if ($value > $max_value) { $max_value = $value; } + if ($value < $min_value) { $min_value = $value; } + } + } + + my $value_range = $max_value - $min_value; + + my $width = $self->_get_number('width'); + my $height = $self->_get_number('height'); + my $size = $self->_get_number('size'); + + my $bottom = ($height - $size) / 2; + my $left = ($width - $size) / 2; + + my @graph_box = ( $left, $bottom, $left + $size - 1, $bottom + $size - 1 ); + + $img->box( + color => '000000', + xmin => $left, + xmax => $left+$size, + ymin => $bottom, + ymax => $bottom+$size, + ); + + $img->box( + color => 'FFFFFF', + xmin => $left + 1, + xmax => $left+$size - 1, + ymin => $bottom + 1, + ymax => $bottom+$size -1 , + filled => 1, + ); + + if ($min_value < 0) { + $img->box( + color => 'EEEEEE', + xmin => $left + 1, + xmax => $left+$size - 1, + ymin => $bottom + $size - (-1*$min_value / $value_range) * ($size -1), + ymax => $bottom+$size -1, + filled => 1, + ); + } + + if ($self->_getYTics()) { + $self->_drawYTics($img, $min_value, $max_value, $self->_getYTics(), \@graph_box, \@chart_box); + } + if ($self->_getLabels()) { + $self->_drawXTics($img, \@graph_box, \@chart_box); + } + + my $series_counter = 0; + foreach my $series (@series) { + my @data = @{$series->{'data'}}; + my $data_size = scalar @data; + my @fill = $self->_data_fill($series_counter, \@graph_box); + my $color = $self->_data_color($series_counter); + for (my $i = 0; $i < $data_size - 1; $i++) { + my $x1 = $left + $i * $size / ($data_size - 1); + my $x2 = $left + ($i + 1) * $size / ($data_size - 1); + + my $y1 = $bottom + ($value_range - $data[$i] + $min_value)/$value_range * $size; + my $y2 = $bottom + ($value_range - $data[$i + 1] + $min_value)/$value_range * $size; + + $img->line(x1 => $x1, y1 => $y1, x2 => $x2, y2 => $y2, aa => 1, color => $color) || die $img->errstr; + $img->circle(x => $x1, y => $y1, r => 3, aa => 1, filled => 1, @fill); + } + + my $x2 = $left + ($data_size - 1) * $size / ($data_size - 1); + my $y2 = $bottom + ($value_range - $data[$data_size - 1] + $min_value)/$value_range * $size; + + $img->circle(x => $x2, y => $y2, r => 3, aa => 1, filled => 1, @fill); + $series_counter++; + } + + return $img; +} + +sub _drawYTics { + my $self = shift; + my $img = shift; + my $min = shift; + my $max = shift; + my $tic_count = shift; + my $graph_box = shift; + my $image_box = shift; + + my $interval = ($max - $min) / ($tic_count - 1); + + my %text_info = $self->_text_style('legend') + or return; + + my $tic_distance = ($graph_box->[3] - $graph_box->[1]) / ($tic_count - 1); + for my $count (0 .. $tic_count - 1) { + my $x1 = $graph_box->[0] - 5; + my $x2 = $graph_box->[0] + 5; + my $y1 = $graph_box->[3] - ($count * $tic_distance); + + $img->line(x1 => $x1, x2 => $x2, y1 => $y1, y2 => $y1, aa => 1, color => '000000'); + + my $value = sprintf("%.2f", ($count*$interval)+$min); + + my @box = $self->_text_bbox($value, 'legend') + or return; + + my $width = $box[2]; + my $height = $box[3]; + + $img->string(%text_info, + x => ($x1 - $width - 3), + y => ($y1 + ($height / 2)), + text => $value + ); + } + +} + +sub _drawXTics { + my $self = shift; + my $img = shift; + my $graph_box = shift; + my $image_box = shift; + + my $labels = $self->_getLabels(); + + my $tic_count = (scalar @$labels) - 1; + + my $tic_distance = ($graph_box->[2] - $graph_box->[0]) / ($tic_count); + my %text_info = $self->_text_style('legend') + or return; + + for my $count (0 .. $tic_count) { + my $label = $labels->[$count]; + my $x1 = $graph_box->[0] + ($tic_distance * $count); + my $y1 = $graph_box->[3] + 5; + my $y2 = $graph_box->[3] - 5; + + $img->line(x1 => $x1, x2 => $x1, y1 => $y1, y2 => $y2, aa => 1, color => '000000'); + + my @box = $self->_text_bbox($label, 'legend') + or return; + + my $width = $box[2]; + my $height = $box[3]; + + $img->string(%text_info, + x => ($x1 - ($width / 2)), + y => ($y1 + ($height + 5)), + text => $label + ); + + } +} + +sub _validInput { + my $self = shift; + + if (!defined $self->_getDataSeries() || !scalar @{$self->_getDataSeries()}) { + return $self->_error("No data supplied"); + } + + if (!scalar @{$self->_getDataSeries()->[0]->{'data'}}) { + return $self->_error("No values in data series"); + } + + my @data = @{$self->_getDataSeries()->[0]->{'data'}}; + + return 1; +} + + + +1; + diff --git a/lib/Imager/Graph/Pie.pm b/lib/Imager/Graph/Pie.pm index 23ea92d..0ecc132 100644 --- a/lib/Imager/Graph/Pie.pm +++ b/lib/Imager/Graph/Pie.pm @@ -193,27 +193,16 @@ suitable for monochrome output: sub draw { my ($self, %opts) = @_; - $opts{data} - or return $self->_error("No data parameter supplied"); - my @data = @{$opts{data}} - or return $self->_error("No values in the data parameter"); - my @labels; - @labels = @{$opts{labels}} if $opts{labels}; + $self->_processOptions(\%opts); - my $total = 0; - { - my $index = 0; - for my $item (@data) { - $item < 0 - and return $self->_error("Data index $index is less than zero"); - - $total += $item; - - ++$index; - } + if (!$self->_validInput()) { + return; } - $total == 0 - and return $self->_error("Sum of all data values is zero"); + + my @data = @{$self->_getDataSeries()->[0]->{'data'}}; + + my @labels = @{$self->_getLabels() || []}; + $self->_style_setup(\%opts); @@ -228,10 +217,15 @@ sub draw { or return; } + my $total = 0; + for my $item (@data) { + $total += $item; + } + # consolidate any segments that are too small to display $self->_consolidate_segments(\@data, \@labels, $total); - if ($style->{features}{legend} && $opts{labels}) { + if ($style->{features}{legend} && (scalar @labels)) { $self->_draw_legend($img, \@labels, \@chart_box) or return; } @@ -260,7 +254,7 @@ sub draw { $item->{begin} = $pos; $pos += $size; $item->{end} = $pos; - if ($opts{labels}) { + if (scalar @labels) { $item->{text} = $labels[$index]; } if ($style->{features}{labelspconly}) { @@ -435,6 +429,37 @@ sub draw { $img; } +sub _validInput { + my $self = shift; + + if (!defined $self->_getDataSeries() || !scalar @{$self->_getDataSeries()}) { + return $self->_error("No data supplied"); + } + + if (!scalar @{$self->_getDataSeries()->[0]->{'data'}}) { + return $self->_error("No values in data series"); + } + + my @data = @{$self->_getDataSeries()->[0]->{'data'}}; + + my $total = 0; + { + my $index = 0; + for my $item (@data) { + $item < 0 + and return $self->_error("Data index $index is less than zero"); + + $total += $item; + + ++$index; + } + } + $total == 0 + and return $self->_error("Sum of all data values is zero"); + + return 1; +} + =head1 INTERNAL FUNCTIONS These are used in the implementation of Imager::Graph, and are diff --git a/lib/Imager/Graph/StackedColumn.pm b/lib/Imager/Graph/StackedColumn.pm new file mode 100644 index 0000000..2199ea2 --- /dev/null +++ b/lib/Imager/Graph/StackedColumn.pm @@ -0,0 +1,269 @@ +package Imager::Graph::StackedColumn; + +=head1 NAME + + Imager::Graph::StackedColumn - a tool for drawing stacked column charts on Imager images + +=head1 SYNOPSIS + + This subclass is still in green development. + +=cut + +use strict; +use vars qw(@ISA); +use Imager::Graph; +@ISA = qw(Imager::Graph); + +=item setYTics($count) + +Set the number of Y tics to use. Their value and position will be determined by the data range. + +=cut + +sub setYTics { + $_[0]->{'y_tics'} = $_[1]; +} + +sub _getYTics { + return $_[0]->{'y_tics'}; +} + +sub draw { + my ($self, %opts) = @_; + + $self->_processOptions(\%opts); + + if (!$self->_validInput()) { + return; + } + + $self->_style_setup(\%opts); + + my $style = $self->{_style}; + + my $img = $self->_make_img() + or return; + + my @chart_box = ( 0, 0, $img->getwidth-1, $img->getheight-1 ); + + my @labels = map { $_->{'series_name'} } @{$self->_getDataSeries()}; + if ($style->{features}{legend} && (scalar @labels)) { + $self->_draw_legend($img, \@labels, \@chart_box) + or return; + } + + my @series = @{$self->_getDataSeries()}; + my $max_value = 0; + my $min_value = 0; + + my $column_count = 0; + my @max_entries; + my @min_entries; + for (my $i = scalar @series - 1; $i >= 0; $i--) { + my $series = $series[$i]; + my $data = $series->{'data'}; + + for (my $i = 0; $i < scalar @$data; $i++) { + my $value = 0; + if ($data->[$i] > 0) { + $value = $data->[$i] + $max_entries[$i]; + $data->[$i] = $value; + $max_entries[$i] = $value; + } + elsif ($data->[$i] < 0) { + $value = $data->[$i] + $min_entries[$i]; + $data->[$i] = $value; + $min_entries[$i] = $value; + } + if ($value > $max_value) { $max_value = $value; } + if ($value < $min_value) { $min_value = $value; } + } + if (scalar @$data > $column_count) { + $column_count = scalar @$data; + } + } + + my $value_range = $max_value - $min_value; + + my $width = $self->_get_number('width'); + my $height = $self->_get_number('height'); + my $size = $self->_get_number('size'); + + my $bottom = ($height - $size) / 2; + my $left = ($width - $size) / 2; + + my @graph_box = ( $left, $bottom, $left + $size - 1, $bottom + $size - 1 ); + + $img->box( + color => '000000', + xmin => $left, + xmax => $left+$size, + ymin => $bottom, + ymax => $bottom+$size, + ); + + $img->box( + color => 'FFFFFF', + xmin => $left + 1, + xmax => $left+$size - 1, + ymin => $bottom + 1, + ymax => $bottom+$size -1 , + filled => 1, + ); + + my $zero_position = $bottom + $size - (-1*$min_value / $value_range) * ($size -1); + + if ($min_value < 0) { + $img->box( + color => 'EEEEEE', + xmin => $left + 1, + xmax => $left+$size - 1, + ymin => $zero_position, + ymax => $bottom+$size -1, + filled => 1, + ); + } + + if ($self->_getYTics()) { + $self->_drawYTics($img, $min_value, $max_value, $self->_getYTics(), \@graph_box, \@chart_box); + } + if ($self->_getLabels()) { + $self->_drawXTics($img, \@graph_box, \@chart_box); + } + + my $bar_width = $size / $column_count; + + my $outline_color; + if ($style->{'features'}{'outline'}) { + $outline_color = $self->_get_color('outline.line'); + } + + my $series_counter = 0; + foreach my $series (@series) { + my @data = @{$series->{'data'}}; + my $data_size = scalar @data; + my @fill = $self->_data_fill($series_counter, \@graph_box); + my $color = $self->_data_color($series_counter); + for (my $i = 0; $i < $data_size; $i++) { + my $x1 = $left + $i * $size / ($data_size); + my $x2 = $x1 + $bar_width; + + my $y1 = $bottom + ($value_range - $data[$i] + $min_value)/$value_range * $size; + + if ($data[$i] > 0) { + $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position-1, @fill); + if ($style->{'features'}{'outline'}) { + $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position, color => $outline_color); + } + } + else { + $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position, ymax => $y1-1, @fill); + if ($style->{'features'}{'outline'}) { + $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position, ymax => $y1, color => $outline_color); + } + } + } + + $series_counter++; + } + + return $img; +} + +sub _drawYTics { + my $self = shift; + my $img = shift; + my $min = shift; + my $max = shift; + my $tic_count = shift; + my $graph_box = shift; + my $image_box = shift; + + my $interval = ($max - $min) / ($tic_count - 1); + + my %text_info = $self->_text_style('legend') + or return; + + my $tic_distance = ($graph_box->[3] - $graph_box->[1]) / ($tic_count - 1); + for my $count (0 .. $tic_count - 1) { + my $x1 = $graph_box->[0] - 5; + my $x2 = $graph_box->[0] + 5; + my $y1 = $graph_box->[3] - ($count * $tic_distance); + + $img->line(x1 => $x1, x2 => $x2, y1 => $y1, y2 => $y1, aa => 1, color => '000000'); + + my $value = sprintf("%.2f", ($count*$interval)+$min); + + my @box = $self->_text_bbox($value, 'legend') + or return; + + my $width = $box[2]; + my $height = $box[3]; + + $img->string(%text_info, + x => ($x1 - $width - 3), + y => ($y1 + ($height / 2)), + text => $value + ); + } + +} + +sub _drawXTics { + my $self = shift; + my $img = shift; + my $graph_box = shift; + my $image_box = shift; + + my $labels = $self->_getLabels(); + + my $tic_count = (scalar @$labels) - 1; + + my $tic_distance = ($graph_box->[2] - $graph_box->[0]) / ($tic_count); + my %text_info = $self->_text_style('legend') + or return; + + for my $count (0 .. $tic_count) { + my $label = $labels->[$count]; + my $x1 = $graph_box->[0] + ($tic_distance * $count); + my $y1 = $graph_box->[3] + 5; + my $y2 = $graph_box->[3] - 5; + + $img->line(x1 => $x1, x2 => $x1, y1 => $y1, y2 => $y2, aa => 1, color => '000000'); + + my @box = $self->_text_bbox($label, 'legend') + or return; + + my $width = $box[2]; + my $height = $box[3]; + + $img->string(%text_info, + x => ($x1 - ($width / 2)), + y => ($y1 + ($height + 5)), + text => $label + ); + + } +} + +sub _validInput { + my $self = shift; + + if (!defined $self->_getDataSeries() || !scalar @{$self->_getDataSeries()}) { + return $self->_error("No data supplied"); + } + + if (!scalar @{$self->_getDataSeries()->[0]->{'data'}}) { + return $self->_error("No values in data series"); + } + + my @data = @{$self->_getDataSeries()->[0]->{'data'}}; + + return 1; +} + + + +1; + diff --git a/t/t20api.t b/t/t20api.t new file mode 100644 index 0000000..97cfb2a --- /dev/null +++ b/t/t20api.t @@ -0,0 +1,59 @@ +#!perl -w +use strict; +use Imager::Graph::Pie; +use lib 't/lib'; +use Imager::Font::Test; +use Test::More; + +++$|; + +use Imager qw(:handy); + +plan tests => 3; + +#my $fontfile = 'ImUgly.ttf'; +#my $font = Imager::Font->new(file=>$fontfile, type => 'ft2', aa=>1) +# or plan skip_all => "Cannot create font object: ",Imager->errstr,"\n"; +my $font = Imager::Font::Test->new(); + +my @data = ( 100, 180, 80, 20, 2, 1, 0.5 ); +my @labels = qw(alpha beta gamma delta epsilon phi gi); + +my $api_pie = Imager::Graph::Pie->new(); + +$api_pie->addDataSeries(\@data, 'Demo series'); +$api_pie->setFont($font); +$api_pie->setLabels(\@labels); +$api_pie->setGraphSize(50); +$api_pie->setImageWidth(200); +$api_pie->setImageHeight(200); +$api_pie->setTitle('Test 20'); +$api_pie->setStyle('fount_rad'); + +my $api_img = $api_pie->draw(); +ok($api_img); + +my $data_pie = Imager::Graph::Pie->new(); + +my $data_img = $data_pie->draw( + data => \@data, + labels => \@labels, + font => $font, + title => { text => 'Test 20' }, + style => 'fount_rad', + size => 50, + width => 200, + height => 200, + ); + + +ok($data_img); + +my ($api_content, $data_content); + +$data_img->write(data => \$data_content, type=>'tiff', tiff_compression => 'none') or die "Err: ".$data_img->errstr; +$api_img->write(data => \$api_content, type=>'tiff', tiff_compression => 'none') or die "Err: ".$api_img->errstr; + +ok($data_content eq $api_content); + + -- 2.30.2