changes from Patrick Michaud, line, bar, stacked column graphs
[imager-graph.git] / 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