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<Imager::Graph::Pie>, 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<Imager::Font> 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.
\%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';
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,
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,
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);
"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.
--- /dev/null
+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;
+
--- /dev/null
+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;
+
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);
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;
}
$item->{begin} = $pos;
$pos += $size;
$item->{end} = $pos;
- if ($opts{labels}) {
+ if (scalar @labels) {
$item->{text} = $labels[$index];
}
if ($style->{features}{labelspconly}) {
$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
--- /dev/null
+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;
+
--- /dev/null
+#!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);
+
+
projects / imager-graph.git / commitdiff