changes from Patrick Michaud, line, bar, stacked column graphs
[imager-graph.git] / lib / Imager / Graph / Column.pm
1 package Imager::Graph::Column;
2
3 =head1 NAME
4
5   Imager::Graph::Column - a tool for drawing 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   foreach my $series (@series) {
62     my @data = @{$series->{'data'}};
63
64     foreach my $value (@data) {
65       $column_count++;
66       if ($value > $max_value) { $max_value = $value; }
67       if ($value < $min_value) { $min_value = $value; }
68     }
69   }
70
71   my $value_range = $max_value - $min_value;
72
73   my $width = $self->_get_number('width');
74   my $height = $self->_get_number('height');
75   my $size = $self->_get_number('size');
76
77   my $bottom = ($height - $size) / 2;
78   my $left   = ($width - $size) / 2;
79
80   my @graph_box = ( $left, $bottom, $left + $size - 1, $bottom + $size - 1 );
81
82   $img->box(
83             color   => '000000',
84             xmin    => $left,
85             xmax    => $left+$size,
86             ymin    => $bottom,
87             ymax    => $bottom+$size,
88             );
89
90   $img->box(
91             color   => 'FFFFFF',
92             xmin    => $left + 1,
93             xmax    => $left+$size - 1,
94             ymin    => $bottom + 1,
95             ymax    => $bottom+$size -1 ,
96             filled  => 1,
97             );
98
99   my $zero_position =  $bottom + $size - (-1*$min_value / $value_range) * ($size -1);
100
101   if ($min_value < 0) {
102     $img->box(
103             color   => 'EEEEEE',
104             xmin    => $left + 1,
105             xmax    => $left+$size - 1,
106             ymin    => $zero_position,
107             ymax    => $bottom+$size -1,
108             filled  => 1,
109     );
110   }
111
112   if ($self->_getYTics()) {
113     $self->_drawYTics($img, $min_value, $max_value, $self->_getYTics(), \@graph_box, \@chart_box);
114   }
115   if ($self->_getLabels()) {
116     $self->_drawXTics($img, \@graph_box, \@chart_box);
117   }
118
119   my $bar_width = $size / $column_count;
120
121   my $outline_color;
122   if ($style->{'features'}{'outline'}) {
123     $outline_color = $self->_get_color('outline.line');
124   }
125
126   my $series_counter = 0;
127   foreach my $series (@series) {
128     my @data = @{$series->{'data'}};
129     my $data_size = scalar @data;
130     my @fill = $self->_data_fill($series_counter, \@graph_box);
131     my $color = $self->_data_color($series_counter);
132     for (my $i = 0; $i < $data_size; $i++) {
133       my $x1 = $left + $i * $size / ($data_size) + ($bar_width * $series_counter);
134       my $x2 = $x1 + $bar_width;
135
136       my $y1 = $bottom + ($value_range - $data[$i] + $min_value)/$value_range * $size;
137
138       if ($data[$i] > 0) {
139         $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position-1, @fill);
140         if ($style->{'features'}{'outline'}) {
141           $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position, color => $outline_color);
142         }
143       }
144       else {
145         $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position, ymax => $y1-1, @fill);
146         if ($style->{'features'}{'outline'}) {
147           $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position, ymax => $y1, color => $outline_color);
148         }
149       }
150     }
151
152     $series_counter++;
153   }
154
155   return $img;
156 }
157
158 sub _drawYTics {
159   my $self = shift;
160   my $img = shift;
161   my $min = shift;
162   my $max = shift;
163   my $tic_count = shift;
164   my $graph_box = shift;
165   my $image_box = shift;
166
167   my $interval = ($max - $min) / ($tic_count - 1);
168
169   my %text_info = $self->_text_style('legend')
170     or return;
171
172   my $tic_distance = ($graph_box->[3] - $graph_box->[1]) / ($tic_count - 1);
173   for my $count (0 .. $tic_count - 1) {
174     my $x1 = $graph_box->[0] - 5;
175     my $x2 = $graph_box->[0] + 5;
176     my $y1 = $graph_box->[3] - ($count * $tic_distance);
177
178     $img->line(x1 => $x1, x2 => $x2, y1 => $y1, y2 => $y1, aa => 1, color => '000000');
179
180     my $value = sprintf("%.2f", ($count*$interval)+$min);
181
182     my @box = $self->_text_bbox($value, 'legend')
183       or return;
184
185     my $width = $box[2];
186     my $height = $box[3];
187
188     $img->string(%text_info,
189                  x    => ($x1 - $width - 3),
190                  y    => ($y1 + ($height / 2)),
191                  text => $value
192                 );
193   }
194
195 }
196
197 sub _drawXTics {
198   my $self = shift;
199   my $img = shift;
200   my $graph_box = shift;
201   my $image_box = shift;
202
203   my $labels = $self->_getLabels();
204
205   my $tic_count = (scalar @$labels) - 1;
206
207   my $tic_distance = ($graph_box->[2] - $graph_box->[0]) / ($tic_count);
208   my %text_info = $self->_text_style('legend')
209     or return;
210
211   for my $count (0 .. $tic_count) {
212     my $label = $labels->[$count];
213     my $x1 = $graph_box->[0] + ($tic_distance * $count);
214     my $y1 = $graph_box->[3] + 5;
215     my $y2 = $graph_box->[3] - 5;
216
217     $img->line(x1 => $x1, x2 => $x1, y1 => $y1, y2 => $y2, aa => 1, color => '000000');
218
219     my @box = $self->_text_bbox($label, 'legend')
220       or return;
221
222     my $width = $box[2];
223     my $height = $box[3];
224
225     $img->string(%text_info,
226                  x    => ($x1 - ($width / 2)),
227                  y    => ($y1 + ($height + 5)),
228                  text => $label
229                 );
230
231   }
232 }
233
234 sub _validInput {
235   my $self = shift;
236
237   if (!defined $self->_getDataSeries() || !scalar @{$self->_getDataSeries()}) {
238     return $self->_error("No data supplied");
239   }
240
241   if (!scalar @{$self->_getDataSeries()->[0]->{'data'}}) {
242     return $self->_error("No values in data series");
243   }
244
245   my @data = @{$self->_getDataSeries()->[0]->{'data'}};
246
247   return 1;
248 }
249
250
251
252 1;
253