lib/Imager/Graph/StackedColumn.pm

   1 package Imager::Graph::StackedColumn;
   2
   3 =head1 NAME
   4
   5   Imager::Graph::StackedColumn - a tool for drawing stacked column charts on Imager images
   6
   7 =head1 SYNOPSIS
   8
   9   This subclass is still in green development.
  10
  11 =cut
  12
  13 use strict;
  14 use vars qw(@ISA);
  15 use Imager::Graph;
  16 @ISA = qw(Imager::Graph);
  17
  18 =item setYTics($count)
  19
  20 Set the number of Y tics to use.  Their value and position will be determined by the data range.
  21
  22 =cut
  23
  24 sub setYTics {
  25   $_[0]->{'y_tics'} = $_[1];
  26 }
  27
  28 sub _getYTics {
  29   return $_[0]->{'y_tics'};
  30 }
  31
  32 sub draw {
  33   my ($self, %opts) = @_;
  34
  35   $self->_processOptions(\%opts);
  36
  37   if (!$self->_validInput()) {
  38     return;
  39   }
  40
  41   $self->_style_setup(\%opts);
  42
  43   my $style = $self->{_style};
  44
  45   my $img = $self->_make_img()
  46     or return;
  47
  48   my @chart_box = ( 0, 0, $img->getwidth-1, $img->getheight-1 );
  49
  50   my @labels = map { $_->{'series_name'} } @{$self->_getDataSeries()};
  51   if ($style->{features}{legend} && (scalar @labels)) {
  52     $self->_draw_legend($img, \@labels, \@chart_box)
  53       or return;
  54   }
  55
  56   my @series = @{$self->_getDataSeries()};
  57   my $max_value = 0;
  58   my $min_value = 0;
  59
  60   my $column_count = 0;
  61   my @max_entries;
  62   my @min_entries;
  63   for (my $i = scalar @series - 1; $i >= 0; $i--) {
  64     my $series = $series[$i];
  65     my $data = $series->{'data'};
  66
  67     for (my $i = 0; $i < scalar @$data; $i++) {
  68       my $value = 0;
  69       if ($data->[$i] > 0) {
  70         $value = $data->[$i] + $max_entries[$i];
  71         $data->[$i] = $value;
  72         $max_entries[$i] = $value;
  73       }
  74       elsif ($data->[$i] < 0) {
  75         $value = $data->[$i] + $min_entries[$i];
  76         $data->[$i] = $value;
  77         $min_entries[$i] = $value;
  78       }
  79       if ($value > $max_value) { $max_value = $value; }
  80       if ($value < $min_value) { $min_value = $value; }
  81     }
  82     if (scalar @$data > $column_count) {
  83       $column_count = scalar @$data;
  84     }
  85   }
  86
  87   my $value_range = $max_value - $min_value;
  88
  89   my $width = $self->_get_number('width');
  90   my $height = $self->_get_number('height');
  91   my $size = $self->_get_number('size');
  92
  93   my $bottom = ($height - $size) / 2;
  94   my $left   = ($width - $size) / 2;
  95
  96   my @graph_box = ( $left, $bottom, $left + $size - 1, $bottom + $size - 1 );
  97
  98   $img->box(
  99             color   => '000000',
 100             xmin    => $left,
 101             xmax    => $left+$size,
 102             ymin    => $bottom,
 103             ymax    => $bottom+$size,
 104             );
 105
 106   $img->box(
 107             color   => 'FFFFFF',
 108             xmin    => $left + 1,
 109             xmax    => $left+$size - 1,
 110             ymin    => $bottom + 1,
 111             ymax    => $bottom+$size -1 ,
 112             filled  => 1,
 113             );
 114
 115   my $zero_position =  $bottom + $size - (-1*$min_value / $value_range) * ($size -1);
 116
 117   if ($min_value < 0) {
 118     $img->box(
 119             color   => 'EEEEEE',
 120             xmin    => $left + 1,
 121             xmax    => $left+$size - 1,
 122             ymin    => $zero_position,
 123             ymax    => $bottom+$size -1,
 124             filled  => 1,
 125     );
 126   }
 127
 128   if ($self->_getYTics()) {
 129     $self->_drawYTics($img, $min_value, $max_value, $self->_getYTics(), \@graph_box, \@chart_box);
 130   }
 131   if ($self->_getLabels()) {
 132     $self->_drawXTics($img, \@graph_box, \@chart_box);
 133   }
 134
 135   my $bar_width = $size / $column_count;
 136
 137   my $outline_color;
 138   if ($style->{'features'}{'outline'}) {
 139     $outline_color = $self->_get_color('outline.line');
 140   }
 141
 142   my $series_counter = 0;
 143   foreach my $series (@series) {
 144     my @data = @{$series->{'data'}};
 145     my $data_size = scalar @data;
 146     my @fill = $self->_data_fill($series_counter, \@graph_box);
 147     my $color = $self->_data_color($series_counter);
 148     for (my $i = 0; $i < $data_size; $i++) {
 149       my $x1 = $left + $i * $size / ($data_size);
 150       my $x2 = $x1 + $bar_width;
 151
 152       my $y1 = $bottom + ($value_range - $data[$i] + $min_value)/$value_range * $size;
 153
 154       if ($data[$i] > 0) {
 155         $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position-1, @fill);
 156         if ($style->{'features'}{'outline'}) {
 157           $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position, color => $outline_color);
 158         }
 159       }
 160       else {
 161         $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position, ymax => $y1-1, @fill);
 162         if ($style->{'features'}{'outline'}) {
 163           $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position, ymax => $y1, color => $outline_color);
 164         }
 165       }
 166     }
 167
 168     $series_counter++;
 169   }
 170
 171   return $img;
 172 }
 173
 174 sub _drawYTics {
 175   my $self = shift;
 176   my $img = shift;
 177   my $min = shift;
 178   my $max = shift;
 179   my $tic_count = shift;
 180   my $graph_box = shift;
 181   my $image_box = shift;
 182
 183   my $interval = ($max - $min) / ($tic_count - 1);
 184
 185   my %text_info = $self->_text_style('legend')
 186     or return;
 187
 188   my $tic_distance = ($graph_box->[3] - $graph_box->[1]) / ($tic_count - 1);
 189   for my $count (0 .. $tic_count - 1) {
 190     my $x1 = $graph_box->[0] - 5;
 191     my $x2 = $graph_box->[0] + 5;
 192     my $y1 = $graph_box->[3] - ($count * $tic_distance);
 193
 194     $img->line(x1 => $x1, x2 => $x2, y1 => $y1, y2 => $y1, aa => 1, color => '000000');
 195
 196     my $value = sprintf("%.2f", ($count*$interval)+$min);
 197
 198     my @box = $self->_text_bbox($value, 'legend')
 199       or return;
 200
 201     my $width = $box[2];
 202     my $height = $box[3];
 203
 204     $img->string(%text_info,
 205                  x    => ($x1 - $width - 3),
 206                  y    => ($y1 + ($height / 2)),
 207                  text => $value
 208                 );
 209   }
 210
 211 }
 212
 213 sub _drawXTics {
 214   my $self = shift;
 215   my $img = shift;
 216   my $graph_box = shift;
 217   my $image_box = shift;
 218
 219   my $labels = $self->_getLabels();
 220
 221   my $tic_count = (scalar @$labels) - 1;
 222
 223   my $tic_distance = ($graph_box->[2] - $graph_box->[0]) / ($tic_count);
 224   my %text_info = $self->_text_style('legend')
 225     or return;
 226
 227   for my $count (0 .. $tic_count) {
 228     my $label = $labels->[$count];
 229     my $x1 = $graph_box->[0] + ($tic_distance * $count);
 230     my $y1 = $graph_box->[3] + 5;
 231     my $y2 = $graph_box->[3] - 5;
 232
 233     $img->line(x1 => $x1, x2 => $x1, y1 => $y1, y2 => $y2, aa => 1, color => '000000');
 234
 235     my @box = $self->_text_bbox($label, 'legend')
 236       or return;
 237
 238     my $width = $box[2];
 239     my $height = $box[3];
 240
 241     $img->string(%text_info,
 242                  x    => ($x1 - ($width / 2)),
 243                  y    => ($y1 + ($height + 5)),
 244                  text => $label
 245                 );
 246
 247   }
 248 }
 249
 250 sub _validInput {
 251   my $self = shift;
 252
 253   if (!defined $self->_getDataSeries() || !scalar @{$self->_getDataSeries()}) {
 254     return $self->_error("No data supplied");
 255   }
 256
 257   if (!scalar @{$self->_getDataSeries()->[0]->{'data'}}) {
 258     return $self->_error("No values in data series");
 259   }
 260
 261   my @data = @{$self->_getDataSeries()->[0]->{'data'}};
 262
 263   return 1;
 264 }
 265
 266
 267
 268 1;
 269