changes from Patrick Michaud, line, bar, stacked column graphs
authorpmichaud <pmichaud@pobox.com>
Sun, 22 Mar 2009 23:41:13 +0000 (23:41 +0000)
committerTony Cook <tony@develop-help.com>
Sun, 22 Mar 2009 23:41:13 +0000 (23:41 +0000)
Graph.pm
lib/Imager/Graph/Column.pm [new file with mode: 0644]
lib/Imager/Graph/Line.pm [new file with mode: 0644]
lib/Imager/Graph/Pie.pm
lib/Imager/Graph/StackedColumn.pm [new file with mode: 0644]
t/t20api.t [new file with mode: 0644]

index 0f7b05c..32606b2 100644 (file)
--- 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<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.
@@ -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 (file)
index 0000000..099141a
--- /dev/null
@@ -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 (file)
index 0000000..f69079c
--- /dev/null
@@ -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;
+
index 23ea92d..0ecc132 100644 (file)
@@ -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 (file)
index 0000000..2199ea2
--- /dev/null
@@ -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 (file)
index 0000000..97cfb2a
--- /dev/null
@@ -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);
+
+