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