17840dc87a357ec6480dc67093893220a8727c52
[imager-graph.git] / lib / Imager / Graph / Vertical.pm
1 package Imager::Graph::Vertical;
2
3 =head1 NAME
4
5 Imager::Graph::Vertical- A super class for line/bar/column/area charts
6
7 =head1 SYNOPSIS
8
9   use Imager::Graph::Vertical;
10
11   my $vert = Imager::Graph::Vertical->new;
12   $vert->add_column_data_series(\@data, "My data");
13   $vert->add_area_data_series(\@data2, "Area data");
14   $vert->add_stacked_column_data_series(\@data3, "stacked data");
15   $vert->add_line_data_series(\@data4, "line data");
16   my $img = $vert->draw();
17
18   use Imager::Graph::Column;
19   my $column = Imager::Graph::Column->new;
20   $column->add_data_series(\@data, "my data");
21   my $img = $column->draw();
22
23 =head1 DESCRIPTION
24
25 This is a base class that implements the functionality for column,
26 stacked column, line and area charts where the dependent variable is
27 represented in changes in the vertical position.
28
29 The subclasses, L<Imager::Graph::Column>,
30 L<Imager::Graph::StackedColumn>, L<Imager::Graph::Line> and
31 L<Imager::Graph::Area> simply provide default data series types.
32
33 =head1 METHODS
34
35 =cut
36
37 use strict;
38 use vars qw(@ISA);
39 use Imager::Graph;
40 @ISA = qw(Imager::Graph);
41 use Imager::Fill;
42
43 our $VERSION = "0.10";
44
45 use constant STARTING_MIN_VALUE => 99999;
46
47 =over
48
49 =item add_data_series(\@data, $series_name)
50
51 Add a data series to the graph, of the default type.  This requires
52 that the graph object be one of the derived graph classes.
53
54 =cut
55
56 sub add_data_series {
57   my $self = shift;
58   my $data_ref = shift;
59   my $series_name = shift;
60
61   my $series_type = $self->_get_default_series_type();
62   $self->_add_data_series($series_type, $data_ref, $series_name);
63
64   return;
65 }
66
67 =item add_column_data_series(\@data, $series_name)
68
69 Add a column data series to the graph.
70
71 =cut
72
73 sub add_column_data_series {
74   my $self = shift;
75   my $data_ref = shift;
76   my $series_name = shift;
77
78   $self->_add_data_series('column', $data_ref, $series_name);
79
80   return;
81 }
82
83 =item add_stacked_column_data_series(\@data, $series_name)
84
85 Add a stacked column data series to the graph.
86
87 =cut
88
89 sub add_stacked_column_data_series {
90   my $self = shift;
91   my $data_ref = shift;
92   my $series_name = shift;
93
94   $self->_add_data_series('stacked_column', $data_ref, $series_name);
95
96   return;
97 }
98
99 =item add_line_data_series(\@data, $series_name)
100
101 Add a line data series to the graph.
102
103 =cut
104
105 sub add_line_data_series {
106   my $self = shift;
107   my $data_ref = shift;
108   my $series_name = shift;
109
110   $self->_add_data_series('line', $data_ref, $series_name);
111
112   return;
113 }
114
115 =item add_area_data_series(\@data, $series_name)
116
117 Add a area data series to the graph.
118
119 =cut
120
121 sub add_area_data_series {
122   my $self = shift;
123   my $data_ref = shift;
124   my $series_name = shift;
125
126   $self->_add_data_series('area', $data_ref, $series_name);
127
128   return;
129 }
130
131 =item set_y_max($value)
132
133 Sets the maximum y value to be displayed.  This will be ignored if the
134 y_max is lower than the highest value.
135
136 =cut
137
138 sub set_y_max {
139   $_[0]->{'custom_style'}->{'y_max'} = $_[1];
140 }
141
142 =item set_y_min($value)
143
144 Sets the minimum y value to be displayed.  This will be ignored if the
145 y_min is higher than the lowest value.
146
147 =cut
148
149 sub set_y_min {
150   $_[0]->{'custom_style'}->{'y_min'} = $_[1];
151 }
152
153 =item set_column_padding($int)
154
155 Sets the padding between columns.  This is a percentage of the column
156 width.  Defaults to 0.
157
158 =cut
159
160 sub set_column_padding {
161   $_[0]->{'custom_style'}->{'column_padding'} = $_[1];
162 }
163
164 =item set_range_padding($percentage)
165
166 Sets the padding to be used, as a percentage.  For example, if your
167 data ranges from 0 to 10, and you have a 20 percent padding, the y
168 axis will go to 12.
169
170 Defaults to 10.  This attribute is ignored for positive numbers if
171 set_y_max() has been called, and ignored for negative numbers if
172 set_y_min() has been called.
173
174 =cut
175
176 sub set_range_padding {
177   $_[0]->{'custom_style'}->{'range_padding'} = $_[1];
178 }
179
180 =item set_negative_background($color)
181
182 Sets the background color or fill used below the x axis.
183
184 =cut
185
186 sub set_negative_background {
187   $_[0]->{'custom_style'}->{'negative_bg'} = $_[1];
188 }
189
190 =item draw()
191
192 Draw the graph
193
194 =cut
195
196 sub draw {
197   my ($self, %opts) = @_;
198
199   if (!$self->_valid_input()) {
200     return;
201   }
202
203   $self->_style_setup(\%opts);
204
205   my $style = $self->{_style};
206
207   $self->_make_img
208     or return;
209
210   my $img = $self->_get_image()
211     or return;
212
213   my @image_box = ( 0, 0, $img->getwidth-1, $img->getheight-1 );
214   $self->_set_image_box(\@image_box);
215
216   my @chart_box = ( 0, 0, $img->getwidth-1, $img->getheight-1 );
217   $self->_draw_legend(\@chart_box);
218   if ($style->{title}{text}) {
219     $self->_draw_title($img, \@chart_box)
220       or return;
221   }
222
223   # Scale the graph box down to the widest graph that can cleanly hold the # of columns.
224   return unless $self->_get_data_range();
225   $self->_remove_tics_from_chart_box(\@chart_box, \%opts);
226   my $column_count = $self->_get_column_count();
227
228   my $width = $self->_get_number('width');
229   my $height = $self->_get_number('height');
230
231   my $graph_width = $chart_box[2] - $chart_box[0];
232   my $graph_height = $chart_box[3] - $chart_box[1];
233
234   my $col_width = ($graph_width - 1) / $column_count;
235   if ($col_width > 1) {
236     $graph_width = int($col_width) * $column_count + 1;
237   }
238   else {
239     $graph_width = $col_width * $column_count + 1;
240   }
241
242   my $tic_count = $self->_get_y_tics();
243   my $tic_distance = ($graph_height-1) / ($tic_count - 1);
244   $graph_height = int($tic_distance * ($tic_count - 1));
245
246   my $top  = $chart_box[1];
247   my $left = $chart_box[0];
248
249   $self->{'_style'}{'graph_width'} = $graph_width;
250   $self->{'_style'}{'graph_height'} = $graph_height;
251
252   my @graph_box = ($left, $top, $left + $graph_width, $top + $graph_height);
253   $self->_set_graph_box(\@graph_box);
254
255   my @fill_box = ( $left, $top, $left+$graph_width, $top+$graph_height );
256   if ($self->_feature_enabled("graph_outline")) {
257     my @line = $self->_get_line("graph.outline")
258       or return;
259
260     $self->_box(
261                 @line,
262                 box => \@fill_box,
263                 img => $img,
264                );
265     ++$fill_box[0];
266     ++$fill_box[1];
267     --$fill_box[2];
268     --$fill_box[3];
269   }
270
271   $img->box(
272             $self->_get_fill('graph.fill'),
273             box => \@fill_box,
274            );
275
276   my $min_value = $self->_get_min_value();
277   my $max_value = $self->_get_max_value();
278   my $value_range = $max_value - $min_value;
279
280   my $zero_position;
281   if ($value_range) {
282     $zero_position =  $top + $graph_height - (-1*$min_value / $value_range) * ($graph_height-1);
283   }
284
285   if ($min_value < 0) {
286     my @neg_box = ( $left + 1, $zero_position, $left+$graph_width- 1, $top+$graph_height - 1 );
287     my @neg_fill = $self->_get_fill('negative_bg', \@neg_box)
288       or return;
289     $img->box(
290               @neg_fill,
291               box => \@neg_box,
292     );
293     $img->line(
294             x1 => $left+1,
295             y1 => $zero_position,
296             x2 => $left + $graph_width,
297             y2 => $zero_position,
298             color => $self->_get_color('outline.line'),
299     );
300   }
301
302   $self->_reset_series_counter();
303
304   if ($self->_get_data_series()->{'stacked_column'}) {
305     return unless $self->_draw_stacked_columns();
306   }
307   if ($self->_get_data_series()->{'column'}) {
308     return unless $self->_draw_columns();
309   }
310   if ($self->_get_data_series()->{'line'}) {
311     return unless $self->_draw_lines();
312   }
313   if ($self->_get_data_series()->{'area'}) {
314     return unless $self->_draw_area();
315   }
316
317   if ($self->_get_y_tics()) {
318     $self->_draw_y_tics();
319   }
320   if ($self->_get_labels(\%opts)) {
321     $self->_draw_x_tics(\%opts);
322   }
323
324   return $self->_get_image();
325 }
326
327 sub _get_data_range {
328   my $self = shift;
329
330   my $max_value = 0;
331   my $min_value = 0;
332   my $column_count = 0;
333
334   my ($sc_min, $sc_max, $sc_cols) = $self->_get_stacked_column_range();
335   my ($c_min, $c_max, $c_cols) = $self->_get_column_range();
336   my ($l_min, $l_max, $l_cols) = $self->_get_line_range();
337   my ($a_min, $a_max, $a_cols) = $self->_get_area_range();
338
339   # These are side by side...
340   $sc_cols += $c_cols;
341
342   $min_value = $self->_min(STARTING_MIN_VALUE, $sc_min, $c_min, $l_min, $a_min);
343   $max_value = $self->_max(0, $sc_max, $c_max, $l_max, $a_max);
344
345   my $config_min = $self->_get_number('y_min');
346   my $config_max = $self->_get_number('y_max');
347
348   if (defined $config_max && $config_max < $max_value) {
349     $config_max = undef;
350   }
351   if (defined $config_min && $config_min > $min_value) {
352     $config_min = undef;
353   }
354
355   my $range_padding = $self->_get_number('range_padding');
356   if (defined $config_min) {
357     $min_value = $config_min;
358   }
359   else {
360     if ($min_value > 0) {
361       $min_value = 0;
362     }
363     if ($range_padding && $min_value < 0) {
364       my $difference = $min_value * $range_padding / 100;
365       if ($min_value < -1 && $difference > -1) {
366         $difference = -1;
367       }
368       $min_value += $difference;
369     }
370   }
371   if (defined $config_max) {
372     $max_value = $config_max;
373   }
374   else {
375     if ($range_padding && $max_value > 0) {
376       my $difference = $max_value * $range_padding / 100;
377       if ($max_value > 1 && $difference < 1) {
378         $difference = 1;
379       }
380       $max_value += $difference;
381     }
382   }
383   $column_count = $self->_max(0, $sc_cols, $l_cols, $a_cols);
384
385   if ($self->_get_number('automatic_axis')) {
386     # In case this was set via a style, and not by the api method
387     eval { require Chart::Math::Axis; };
388     if ($@) {
389       return $self->_error("Can't use automatic_axis - $@");
390     }
391
392     my $axis = Chart::Math::Axis->new();
393     $axis->include_zero();
394     $axis->add_data($min_value, $max_value);
395     $max_value = $axis->top;
396     $min_value = $axis->bottom;
397     my $ticks     = $axis->ticks;
398     # The +1 is there because we have the bottom tick as well
399     $self->set_y_tics($ticks+1);
400   }
401
402   $self->_set_max_value($max_value);
403   $self->_set_min_value($min_value);
404   $self->_set_column_count($column_count);
405
406   return 1;
407 }
408
409 sub _min {
410   my $self = shift;
411   my $min = shift;
412
413   foreach my $value (@_) {
414     next unless defined $value;
415     if ($value < $min) { $min = $value; }
416   }
417   return $min;
418 }
419
420 sub _max {
421   my $self = shift;
422   my $min = shift;
423
424   foreach my $value (@_) {
425     next unless defined $value;
426     if ($value > $min) { $min = $value; }
427   }
428   return $min;
429 }
430
431 sub _get_line_range {
432   my $self = shift;
433   my $series = $self->_get_data_series()->{'line'};
434   return (undef, undef, 0) unless $series;
435
436   my $max_value = 0;
437   my $min_value = STARTING_MIN_VALUE;
438   my $column_count = 0;
439
440   my @series = @{$series};
441   foreach my $series (@series) {
442     my @data = @{$series->{'data'}};
443
444     if (scalar @data > $column_count) {
445       $column_count = scalar @data;
446     }
447
448     foreach my $value (@data) {
449       if ($value > $max_value) { $max_value = $value; }
450       if ($value < $min_value) { $min_value = $value; }
451     }
452   }
453
454   return ($min_value, $max_value, $column_count);
455 }
456
457 sub _get_area_range {
458   my $self = shift;
459   my $series = $self->_get_data_series()->{'area'};
460   return (undef, undef, 0) unless $series;
461
462   my $max_value = 0;
463   my $min_value = STARTING_MIN_VALUE;
464   my $column_count = 0;
465
466   my @series = @{$series};
467   foreach my $series (@series) {
468     my @data = @{$series->{'data'}};
469
470     if (scalar @data > $column_count) {
471       $column_count = scalar @data;
472     }
473
474     foreach my $value (@data) {
475       if ($value > $max_value) { $max_value = $value; }
476       if ($value < $min_value) { $min_value = $value; }
477     }
478   }
479
480   return ($min_value, $max_value, $column_count);
481 }
482
483
484 sub _get_column_range {
485   my $self = shift;
486
487   my $series = $self->_get_data_series()->{'column'};
488   return (undef, undef, 0) unless $series;
489
490   my $max_value = 0;
491   my $min_value = STARTING_MIN_VALUE;
492   my $column_count = 0;
493
494   my @series = @{$series};
495   foreach my $series (@series) {
496     my @data = @{$series->{'data'}};
497
498     foreach my $value (@data) {
499       $column_count++;
500       if ($value > $max_value) { $max_value = $value; }
501       if ($value < $min_value) { $min_value = $value; }
502     }
503   }
504
505   return ($min_value, $max_value, $column_count);
506 }
507
508 sub _get_stacked_column_range {
509   my $self = shift;
510
511   my $max_value = 0;
512   my $min_value = STARTING_MIN_VALUE;
513   my $column_count = 0;
514
515   return (undef, undef, 0) unless $self->_get_data_series()->{'stacked_column'};
516   my @series = @{$self->_get_data_series()->{'stacked_column'}};
517
518   my @max_entries;
519   my @min_entries;
520   for (my $i = scalar @series - 1; $i >= 0; $i--) {
521     my $series = $series[$i];
522     my $data = $series->{'data'};
523
524     for (my $i = 0; $i < scalar @$data; $i++) {
525       my $value = 0;
526       if ($data->[$i] > 0) {
527         $value = $data->[$i] + ($max_entries[$i] || 0);
528         $data->[$i] = $value;
529         $max_entries[$i] = $value;
530       }
531       elsif ($data->[$i] < 0) {
532         $value = $data->[$i] + ($min_entries[$i] || 0);
533         $data->[$i] = $value;
534         $min_entries[$i] = $value;
535       }
536       if ($value > $max_value) { $max_value = $value; }
537       if ($value < $min_value) { $min_value = $value; }
538     }
539     if (scalar @$data > $column_count) {
540       $column_count = scalar @$data;
541     }
542   }
543
544   return ($min_value, $max_value, $column_count);
545 }
546
547 sub _draw_legend {
548   my $self = shift;
549   my $chart_box = shift;
550   my $style = $self->{'_style'};
551
552   my @labels;
553   my $img = $self->_get_image();
554   if (my $series = $self->_get_data_series()->{'stacked_column'}) {
555     push @labels, map { $_->{'series_name'} } @$series;
556   }
557   if (my $series = $self->_get_data_series()->{'column'}) {
558     push @labels, map { $_->{'series_name'} } @$series;
559   }
560   if (my $series = $self->_get_data_series()->{'line'}) {
561     push @labels, map { $_->{'series_name'} } @$series;
562   }
563   if (my $series = $self->_get_data_series()->{'area'}) {
564     push @labels, map { $_->{'series_name'} } @$series;
565   }
566
567   if ($style->{features}{legend} && (scalar @labels)) {
568     $self->SUPER::_draw_legend($self->_get_image(), \@labels, $chart_box)
569       or return;
570   }
571   return;
572 }
573
574 sub _draw_flat_legend {
575   return 1;
576 }
577
578 sub _draw_lines {
579   my $self = shift;
580   my $style = $self->{'_style'};
581
582   my $img = $self->_get_image();
583
584   my $max_value = $self->_get_max_value();
585   my $min_value = $self->_get_min_value();
586   my $column_count = $self->_get_column_count();
587
588   my $value_range = $max_value - $min_value;
589
590   my $width = $self->_get_number('width');
591   my $height = $self->_get_number('height');
592
593   my $graph_width = $self->_get_number('graph_width');
594   my $graph_height = $self->_get_number('graph_height');
595
596   my $line_series = $self->_get_data_series()->{'line'};
597   my $series_counter = $self->_get_series_counter() || 0;
598
599   my $has_columns = (defined $self->_get_data_series()->{'column'} || $self->_get_data_series->{'stacked_column'}) ? 1 : 0;
600
601   my $col_width = int($graph_width / $column_count) -1;
602
603   my $graph_box = $self->_get_graph_box();
604   my $left = $graph_box->[0] + 1;
605   my $bottom = $graph_box->[1];
606
607   my $zero_position =  $bottom + $graph_height - (-1*$min_value / $value_range) * ($graph_height - 1);
608
609   my $line_aa = $self->_get_number("lineaa");
610   foreach my $series (@$line_series) {
611     my @data = @{$series->{'data'}};
612     my $data_size = scalar @data;
613
614     my $interval;
615     if ($has_columns) {
616       $interval = $graph_width / ($data_size);
617     }
618     else {
619       $interval = $graph_width / ($data_size - 1);
620     }
621     my $color = $self->_data_color($series_counter);
622
623     # We need to add these last, otherwise the next line segment will overwrite half of the marker
624     my @marker_positions;
625     for (my $i = 0; $i < $data_size - 1; $i++) {
626       my $x1 = $left + $i * $interval;
627       my $x2 = $left + ($i + 1) * $interval;
628
629       $x1 += $has_columns * $interval / 2;
630       $x2 += $has_columns * $interval / 2;
631
632       my $y1 = $bottom + ($value_range - $data[$i] + $min_value)/$value_range * $graph_height;
633       my $y2 = $bottom + ($value_range - $data[$i + 1] + $min_value)/$value_range * $graph_height;
634
635       push @marker_positions, [$x1, $y1];
636       $img->line(x1 => $x1, y1 => $y1, x2 => $x2, y2 => $y2, aa => $line_aa, color => $color) || die $img->errstr;
637     }
638
639     my $x2 = $left + ($data_size - 1) * $interval;
640     $x2 += $has_columns * $interval / 2;
641
642     my $y2 = $bottom + ($value_range - $data[$data_size - 1] + $min_value)/$value_range * $graph_height;
643
644     if ($self->_feature_enabled("linemarkers")) {
645       push @marker_positions, [$x2, $y2];
646       foreach my $position (@marker_positions) {
647         $self->_draw_line_marker($position->[0], $position->[1], $series_counter);
648       }
649     }
650     $series_counter++;
651   }
652
653   $self->_set_series_counter($series_counter);
654   return 1;
655 }
656
657 sub _area_data_fill {
658   my ($self, $index, $box) = @_;
659
660   my %fill = $self->_data_fill($index, $box);
661
662   my $opacity = $self->_get_number("area.opacity");
663   $opacity == 1
664     and return %fill;
665
666   my $orig_fill = $fill{fill};
667   unless ($orig_fill) {
668     $orig_fill = Imager::Fill->new
669       (
670        solid => $fill{color},
671        combine => "normal",
672       );
673   }
674   return
675     (
676      fill => Imager::Fill->new
677      (
678       type => "opacity",
679       other => $orig_fill,
680       opacity => $opacity,
681      ),
682     );
683 }
684
685 sub _draw_area {
686   my $self = shift;
687   my $style = $self->{'_style'};
688
689   my $img = $self->_get_image();
690
691   my $max_value = $self->_get_max_value();
692   my $min_value = $self->_get_min_value();
693   my $column_count = $self->_get_column_count();
694
695   my $value_range = $max_value - $min_value;
696
697   my $width = $self->_get_number('width');
698   my $height = $self->_get_number('height');
699
700   my $graph_width = $self->_get_number('graph_width');
701   my $graph_height = $self->_get_number('graph_height');
702
703   my $area_series = $self->_get_data_series()->{'area'};
704   my $series_counter = $self->_get_series_counter() || 0;
705
706   my $col_width = int($graph_width / $column_count) -1;
707
708   my $graph_box = $self->_get_graph_box();
709   my $left = $graph_box->[0] + 1;
710   my $bottom = $graph_box->[1];
711   my $right = $graph_box->[2];
712   my $top = $graph_box->[3];
713
714   my $zero_position =  $bottom + $graph_height - (-1*$min_value / $value_range) * ($graph_height - 1);
715
716   my $line_aa = $self->_get_number("lineaa");
717   foreach my $series (@$area_series) {
718     my @data = @{$series->{'data'}};
719     my $data_size = scalar @data;
720
721     my $interval = $graph_width / ($data_size - 1);
722
723     my $color = $self->_data_color($series_counter);
724
725     # We need to add these last, otherwise the next line segment will overwrite half of the marker
726     my @marker_positions;
727     my @polygon_points;
728     for (my $i = 0; $i < $data_size - 1; $i++) {
729       my $x1 = $left + $i * $interval;
730
731       my $y1 = $bottom + ($value_range - $data[$i] + $min_value)/$value_range * $graph_height;
732
733       if ($i == 0) {
734         push @polygon_points, [$x1, $top];
735       }
736       push @polygon_points, [$x1, $y1];
737
738       push @marker_positions, [$x1, $y1];
739     }
740
741     my $x2 = $left + ($data_size - 1) * $interval;
742
743     my $y2 = $bottom + ($value_range - $data[$data_size - 1] + $min_value)/$value_range * $graph_height;
744     push @polygon_points, [$x2, $y2];
745     push @polygon_points, [$x2, $top];
746     push @polygon_points, $polygon_points[0];
747
748     my @fill = $self->_area_data_fill($series_counter, [$left, $bottom, $right, $top]);
749     $img->polygon(points => [@polygon_points], @fill);
750
751     if ($self->_feature_enabled("areamarkers")) {
752       push @marker_positions, [$x2, $y2];
753       foreach my $position (@marker_positions) {
754         $self->_draw_line_marker($position->[0], $position->[1], $series_counter);
755       }
756     }
757     $series_counter++;
758   }
759
760   $self->_set_series_counter($series_counter);
761   return 1;
762 }
763
764 sub _draw_columns {
765   my $self = shift;
766   my $style = $self->{'_style'};
767
768   my $img = $self->_get_image();
769
770   my $max_value = $self->_get_max_value();
771   my $min_value = $self->_get_min_value();
772   my $column_count = $self->_get_column_count();
773
774   my $value_range = $max_value - $min_value;
775
776   my $width = $self->_get_number('width');
777   my $height = $self->_get_number('height');
778
779   my $graph_width = $self->_get_number('graph_width');
780   my $graph_height = $self->_get_number('graph_height');
781
782
783   my $graph_box = $self->_get_graph_box();
784   my $left = $graph_box->[0] + 1;
785   my $bottom = $graph_box->[1];
786   my $zero_position =  int($bottom + $graph_height - (-1*$min_value / $value_range) * ($graph_height -1));
787
788   my $bar_width = $graph_width / $column_count;
789
790   my $outline_color;
791   if ($style->{'features'}{'outline'}) {
792     $outline_color = $self->_get_color('outline.line');
793   }
794
795   my $series_counter = $self->_get_series_counter() || 0;
796   my $col_series = $self->_get_data_series()->{'column'};
797   my $column_padding_percent = $self->_get_number('column_padding') || 0;
798   my $column_padding = int($column_padding_percent * $bar_width / 100);
799
800   # This tracks the series we're in relative to the starting series - this way colors stay accurate, but the columns don't start out too far to the right.
801   my $column_series = 0;
802
803   # If there are stacked columns, non-stacked columns need to start one to the right of where they would otherwise
804   my $has_stacked_columns = (defined $self->_get_data_series()->{'stacked_column'} ? 1 : 0);
805
806   for (my $series_pos = 0; $series_pos < scalar @$col_series; $series_pos++) {
807     my $series = $col_series->[$series_pos];
808     my @data = @{$series->{'data'}};
809     my $data_size = scalar @data;
810     for (my $i = 0; $i < $data_size; $i++) {
811       my $part1 = $bar_width * (scalar @$col_series * $i);
812       my $part2 = ($series_pos) * $bar_width;
813       my $x1 = $left + $part1 + $part2;
814       if ($has_stacked_columns) {
815         $x1 += ($bar_width * ($i+1));
816       }
817       $x1 = int($x1);
818
819       my $x2 = int($x1 + $bar_width - $column_padding)-1;
820       # Special case for when bar_width is less than 1.
821       if ($x2 < $x1) {
822         $x2 = $x1;
823       }
824
825       my $y1 = int($bottom + ($value_range - $data[$i] + $min_value)/$value_range * $graph_height);
826
827       my $color = $self->_data_color($series_counter);
828
829       if ($data[$i] > 0) {
830         my @fill = $self->_data_fill($series_counter, [$x1, $y1, $x2, $zero_position-1]);
831         $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position-1, @fill);
832         if ($style->{'features'}{'outline'}) {
833           $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position, color => $outline_color);
834         }
835       }
836       else {
837         my @fill = $self->_data_fill($series_counter, [$x1, $zero_position+1, $x2, $y1]);
838         $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position+1, ymax => $y1, @fill);
839         if ($style->{'features'}{'outline'}) {
840           $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position+1, ymax => $y1+1, color => $outline_color);
841         }
842       }
843     }
844
845     $series_counter++;
846     $column_series++;
847   }
848   $self->_set_series_counter($series_counter);
849   return 1;
850 }
851
852 sub _draw_stacked_columns {
853   my $self = shift;
854   my $style = $self->{'_style'};
855
856   my $img = $self->_get_image();
857
858   my $max_value = $self->_get_max_value();
859   my $min_value = $self->_get_min_value();
860   my $column_count = $self->_get_column_count();
861   my $value_range = $max_value - $min_value;
862
863   my $graph_box = $self->_get_graph_box();
864   my $left = $graph_box->[0] + 1;
865   my $bottom = $graph_box->[1];
866
867   my $graph_width = $self->_get_number('graph_width');
868   my $graph_height = $self->_get_number('graph_height');
869
870   my $bar_width = $graph_width / $column_count;
871   my $column_series = 0;
872   if (my $column_series_data = $self->_get_data_series()->{'column'}) {
873     $column_series = (scalar @$column_series_data);
874   }
875   $column_series++;
876
877   my $column_padding_percent = $self->_get_number('column_padding') || 0;
878   if ($column_padding_percent < 0) {
879     return $self->_error("Column padding less than 0");
880   }
881   if ($column_padding_percent > 100) {
882     return $self->_error("Column padding greater than 0");
883   }
884   my $column_padding = int($column_padding_percent * $bar_width / 100);
885
886   my $outline_color;
887   if ($style->{'features'}{'outline'}) {
888     $outline_color = $self->_get_color('outline.line');
889   }
890
891   my $zero_position =  $bottom + $graph_height - (-1*$min_value / $value_range) * ($graph_height -1);
892   my $col_series = $self->_get_data_series()->{'stacked_column'};
893   my $series_counter = $self->_get_series_counter() || 0;
894
895   foreach my $series (@$col_series) {
896     my @data = @{$series->{'data'}};
897     my $data_size = scalar @data;
898     for (my $i = 0; $i < $data_size; $i++) {
899       my $part1 = $bar_width * $i * $column_series;
900       my $part2 = 0;
901       my $x1 = int($left + $part1 + $part2);
902       my $x2 = int($x1 + $bar_width - $column_padding) - 1;
903       # Special case for when bar_width is less than 1.
904       if ($x2 < $x1) {
905         $x2 = $x1;
906       }
907
908       my $y1 = int($bottom + ($value_range - $data[$i] + $min_value)/$value_range * $graph_height);
909
910       if ($data[$i] > 0) {
911         my @fill = $self->_data_fill($series_counter, [$x1, $y1, $x2, $zero_position-1]);
912         $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position-1, @fill);
913         if ($style->{'features'}{'outline'}) {
914           $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position, color => $outline_color);
915         }
916       }
917       else {
918         my @fill = $self->_data_fill($series_counter, [$x1, $zero_position+1, $x2, $y1]);
919         $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position+1, ymax => $y1, @fill);
920         if ($style->{'features'}{'outline'}) {
921           $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position+1, ymax => $y1+1, color => $outline_color);
922         }
923       }
924     }
925
926     $series_counter++;
927   }
928   $self->_set_series_counter($series_counter);
929   return 1;
930 }
931
932 sub _add_data_series {
933   my $self = shift;
934   my $series_type = shift;
935   my $data_ref = shift;
936   my $series_name = shift;
937
938   my $graph_data = $self->{'graph_data'} || {};
939
940   my $series = $graph_data->{$series_type} || [];
941
942   push @$series, { data => $data_ref, series_name => $series_name };
943
944   $graph_data->{$series_type} = $series;
945
946   $self->{'graph_data'} = $graph_data;
947   return;
948 }
949
950 =back
951
952 =head1 FEATURES
953
954 =over
955
956 =item show_horizontal_gridlines()
957
958 Feature: horizontal_gridlines
959 X<horizontal_gridlines>X<features, horizontal_gridlines>
960
961 Enables the C<horizontal_gridlines> feature, which shows horizontal
962 gridlines at the y-tics.
963
964 The style of the gridlines can be controlled with the
965 set_horizontal_gridline_style() method (or by setting the hgrid
966 style).
967
968 =cut
969
970 sub show_horizontal_gridlines {
971     $_[0]->{'custom_style'}{features}{'horizontal_gridlines'} = 1;
972 }
973
974 =item set_horizontal_gridline_style(style => $style, color => $color)
975
976 Style: hgrid.
977 X<hgrid>X<style parameters, hgrid>
978
979 Set the style and color of horizonal gridlines.
980
981 See: L<Imager::Graph/"Line styles">
982
983 =cut
984
985 sub set_horizontal_gridline_style {
986   my ($self, %opts) = @_;
987
988   $self->{custom_style}{hgrid} ||= {};
989   @{$self->{custom_style}{hgrid}}{keys %opts} = values %opts;
990
991   return 1;
992 }
993
994 =item show_graph_outline($flag)
995
996 Feature: graph_outline
997 X<graph_outline>X<features, graph_outline>
998
999 If no flag is supplied, unconditionally enable the graph outline.
1000
1001 If $flag is supplied, enable/disable the graph_outline feature based
1002 on that.
1003
1004 Enabled by default.
1005
1006 =cut
1007
1008 sub show_graph_outline {
1009   my ($self, $flag) = @_;
1010
1011   @_ == 1 and $flag = 1;
1012
1013   $self->{custom_style}{features}{graph_outline} = $flag;
1014
1015   return 1;
1016 }
1017
1018 =item set_graph_outline_style(color => ...)
1019
1020 =item set_graph_outline_style(style => ..., color => ...)
1021
1022 Style: graph.outline
1023 X<graph.outline>X<style parameters, graph.outline>
1024
1025 Sets the style of the graph outline.
1026
1027 Default: the style C<fg>.
1028
1029 =cut
1030
1031 sub set_graph_outline_style {
1032   my ($self, %opts) = @_;
1033
1034   $self->{custom_style}{graph}{outline} = \%opts;
1035
1036   return 1;
1037 }
1038
1039 =item set_graph_fill_style(I<fill parameters>)
1040
1041 Style: graph.fill
1042 X<graph.fill>X<style parameters, graph.fill>
1043
1044 Set the fill used to fill the graph data area.
1045
1046 Default: the style C<bg>.
1047
1048 eg.
1049
1050   $graph->set_graph_fill_style(solid => "FF000020", combine => "normal");
1051
1052 =cut
1053
1054 sub set_graph_fill_style {
1055   my ($self, %opts) = @_;
1056
1057   $self->{custom_style}{graph}{fill} = \%opts;
1058
1059   return 1;
1060 }
1061
1062 =item show_area_markers()
1063
1064 =item show_area_markers($value)
1065
1066 Feature: areamarkers.
1067
1068 If $value is missing or true, draw markers along the top of area data
1069 series.
1070
1071 eg.
1072
1073   $chart->show_area_markers();
1074
1075 =cut
1076
1077 sub show_area_markers {
1078   my ($self, $value) = @_;
1079
1080   @_ > 1 or $value = 1;
1081
1082   $self->{custom_style}{features}{areamarkers} = $value;
1083
1084   return 1;
1085 }
1086
1087 =item show_line_markers()
1088
1089 =item show_line_markers($value)
1090
1091 Feature: linemarkers.
1092
1093 If $value is missing or true, draw markers on a line data series.
1094
1095 Note: line markers are drawn by default.
1096
1097 =cut
1098
1099 sub show_line_markers {
1100   my ($self, $value) = @_;
1101
1102   @_ > 1 or $value = 1;
1103
1104   $self->{custom_style}{features}{linemarkers} = $value;
1105
1106   return 1;
1107 }
1108
1109 =item use_automatic_axis()
1110
1111 Automatically scale the Y axis, based on L<Chart::Math::Axis>.  If
1112 Chart::Math::Axis isn't installed, this sets an error and returns
1113 undef.  Returns 1 if it is installed.
1114
1115 =cut
1116
1117 sub use_automatic_axis {
1118   eval { require Chart::Math::Axis; };
1119   if ($@) {
1120     return $_[0]->_error("use_automatic_axis - $@\nCalled from ".join(' ', caller)."\n");
1121   }
1122   $_[0]->{'custom_style'}->{'automatic_axis'} = 1;
1123   return 1;
1124 }
1125
1126 =item set_y_tics($count)
1127
1128 Set the number of Y tics to use.  Their value and position will be
1129 determined by the data range.
1130
1131 =cut
1132
1133 sub set_y_tics {
1134   $_[0]->{'y_tics'} = $_[1];
1135 }
1136
1137 sub _get_y_tics {
1138   return $_[0]->{'y_tics'} || 0;
1139 }
1140
1141 sub _remove_tics_from_chart_box {
1142   my ($self, $chart_box, $opts) = @_;
1143
1144   # XXX - bad default
1145   my $tic_width = $self->_get_y_tic_width() || 10;
1146   my @y_tic_box = ($chart_box->[0], $chart_box->[1], $chart_box->[0] + $tic_width, $chart_box->[3]);
1147
1148   # XXX - bad default
1149   my $tic_height = $self->_get_x_tic_height($opts) || 10;
1150   my @x_tic_box = ($chart_box->[0], $chart_box->[3] - $tic_height, $chart_box->[2], $chart_box->[3]);
1151
1152   $self->_remove_box($chart_box, \@y_tic_box);
1153   $self->_remove_box($chart_box, \@x_tic_box);
1154
1155   # If there's no title, the y-tics will be part off-screen.  Half of the x-tic height should be more than sufficient.
1156   my @y_tic_tops = ($chart_box->[0], $chart_box->[1], $chart_box->[2], $chart_box->[1] + int($tic_height / 2));
1157   $self->_remove_box($chart_box, \@y_tic_tops);
1158
1159   # Make sure that the first and last label fit
1160   if (my $labels = $self->_get_labels($opts)) {
1161     if (my @box = $self->_text_bbox($labels->[0], 'legend')) {
1162       my @remove_box = ($chart_box->[0],
1163                         $chart_box->[1],
1164                         $chart_box->[0] + int($box[2] / 2) + 1,
1165                         $chart_box->[3]
1166                         );
1167
1168       $self->_remove_box($chart_box, \@remove_box);
1169     }
1170     if (my @box = $self->_text_bbox($labels->[-1], 'legend')) {
1171       my @remove_box = ($chart_box->[2] - int($box[2] / 2) - 1,
1172                         $chart_box->[1],
1173                         $chart_box->[2],
1174                         $chart_box->[3]
1175                         );
1176
1177       $self->_remove_box($chart_box, \@remove_box);
1178     }
1179   }
1180 }
1181
1182 sub _get_y_tic_width {
1183   my $self = shift;
1184   my $min = $self->_get_min_value();
1185   my $max = $self->_get_max_value();
1186   my $tic_count = $self->_get_y_tics();
1187
1188   my $interval = ($max - $min) / ($tic_count - 1);
1189
1190   my %text_info = $self->_text_style('legend')
1191     or return;
1192
1193   my $max_width = 0;
1194   for my $count (0 .. $tic_count - 1) {
1195     my $value = ($count*$interval)+$min;
1196
1197     if ($interval < 1 || ($value != int($value))) {
1198       $value = sprintf("%.2f", $value);
1199     }
1200     my @box = $self->_text_bbox($value, 'legend');
1201     my $width = $box[2] - $box[0];
1202
1203     # For the tic width
1204     $width += 10;
1205     if ($width > $max_width) {
1206       $max_width = $width;
1207     }
1208   }
1209
1210   return $max_width;
1211 }
1212
1213 sub _get_x_tic_height {
1214   my ($self, $opts) = @_;
1215
1216   my $labels = $self->_get_labels($opts);
1217
1218   if (!$labels) {
1219         return;
1220   }
1221
1222   my $tic_count = (scalar @$labels) - 1;
1223
1224   my %text_info = $self->_text_style('legend')
1225     or return;
1226
1227   my $max_height = 0;
1228   for my $count (0 .. $tic_count) {
1229     my $label = $labels->[$count];
1230
1231     my @box = $self->_text_bbox($label, 'legend');
1232
1233     my $height = $box[3] - $box[1];
1234
1235     # Padding + the tic
1236     $height += 10;
1237     if ($height > $max_height) {
1238       $max_height = $height;
1239     }
1240   }
1241
1242   return $max_height;
1243 }
1244
1245 sub _draw_y_tics {
1246   my $self = shift;
1247   my $min = $self->_get_min_value();
1248   my $max = $self->_get_max_value();
1249   my $tic_count = $self->_get_y_tics();
1250
1251   my $img = $self->_get_image();
1252   my $graph_box = $self->_get_graph_box();
1253   my $image_box = $self->_get_image_box();
1254
1255   my $interval = ($max - $min) / ($tic_count - 1);
1256
1257   my %text_info = $self->_text_style('legend')
1258     or return;
1259
1260   my $line_style = $self->_get_color('outline.line');
1261   my $show_gridlines = $self->{_style}{features}{'horizontal_gridlines'};
1262   my @grid_line = $self->_get_line("hgrid");
1263   my $tic_distance = ($graph_box->[3] - $graph_box->[1]) / ($tic_count - 1);
1264   for my $count (0 .. $tic_count - 1) {
1265     my $x1 = $graph_box->[0] - 5;
1266     my $x2 = $graph_box->[0] + 5;
1267     my $y1 = int($graph_box->[3] - ($count * $tic_distance));
1268
1269     my $value = ($count*$interval)+$min;
1270     if ($interval < 1 || ($value != int($value))) {
1271         $value = sprintf("%.2f", $value);
1272     }
1273
1274     my @box = $self->_text_bbox($value, 'legend')
1275       or return;
1276
1277     $img->line(x1 => $x1, x2 => $x2, y1 => $y1, y2 => $y1, aa => 1, color => $line_style);
1278
1279     my $width = $box[2];
1280     my $height = $box[3];
1281
1282     $img->string(%text_info,
1283                  x    => ($x1 - $width - 3),
1284                  y    => ($y1 + ($height / 2)),
1285                  text => $value
1286                 );
1287
1288     if ($show_gridlines && $y1 != $graph_box->[1] && $y1 != $graph_box->[3]) {
1289       $self->_line(x1 => $graph_box->[0], y1 => $y1,
1290                    x2 => $graph_box->[2], y2 => $y1,
1291                    img => $img,
1292                    @grid_line);
1293     }
1294   }
1295
1296 }
1297
1298 sub _draw_x_tics {
1299   my ($self, $opts) = @_;
1300
1301   my $img = $self->_get_image();
1302   my $graph_box = $self->_get_graph_box();
1303   my $image_box = $self->_get_image_box();
1304
1305   my $labels = $self->_get_labels($opts);
1306
1307   my $tic_count = (scalar @$labels) - 1;
1308
1309   my $has_columns = (defined $self->_get_data_series()->{'column'} || defined $self->_get_data_series()->{'stacked_column'});
1310
1311   # If we have columns, we want the x-ticks to show up in the middle of the column, not on the left edge
1312   my $denominator = $tic_count;
1313   if ($has_columns) {
1314     $denominator ++;
1315   }
1316   my $tic_distance = ($graph_box->[2] - $graph_box->[0]) / ($denominator);
1317   my %text_info = $self->_text_style('legend')
1318     or return;
1319
1320   # If automatic axis is turned on, let's be selective about what labels we draw.
1321   my $max_size = 0;
1322   my $tic_skip = 0;
1323   if ($self->_get_number('automatic_axis')) {
1324     foreach my $label (@$labels) {
1325       my @box = $self->_text_bbox($label, 'legend');
1326       if ($box[2] > $max_size) {
1327         $max_size = $box[2];
1328       }
1329     }
1330
1331     # Give the max_size some padding...
1332     $max_size *= 1.2;
1333
1334     $tic_skip = int($max_size / $tic_distance) + 1;
1335   }
1336
1337   my $line_style = $self->_get_color('outline.line');
1338
1339   for my $count (0 .. $tic_count) {
1340     next if ($count % ($tic_skip + 1));
1341     my $label = $labels->[$count];
1342     my $x1 = $graph_box->[0] + ($tic_distance * $count);
1343
1344     if ($has_columns) {
1345       $x1 += $tic_distance / 2;
1346     }
1347
1348     $x1 = int($x1);
1349
1350     my $y1 = $graph_box->[3] + 5;
1351     my $y2 = $graph_box->[3] - 5;
1352
1353     $img->line(x1 => $x1, x2 => $x1, y1 => $y1, y2 => $y2, aa => 1, color => $line_style);
1354
1355     my @box = $self->_text_bbox($label, 'legend')
1356       or return;
1357
1358     my $width = $box[2];
1359     my $height = $box[3];
1360
1361     $img->string(%text_info,
1362                  x    => ($x1 - ($width / 2)),
1363                  y    => ($y1 + ($height + 5)),
1364                  text => $label
1365                 );
1366
1367   }
1368 }
1369
1370 sub _valid_input {
1371   my $self = shift;
1372
1373   if (!defined $self->_get_data_series() || !keys %{$self->_get_data_series()}) {
1374     return $self->_error("No data supplied");
1375   }
1376
1377   my $data = $self->_get_data_series();
1378   if (defined $data->{'line'} && !scalar @{$data->{'line'}->[0]->{'data'}}) {
1379     return $self->_error("No values in data series");
1380   }
1381   if (defined $data->{'column'} && !scalar @{$data->{'column'}->[0]->{'data'}}) {
1382     return $self->_error("No values in data series");
1383   }
1384   if (defined $data->{'stacked_column'} && !scalar @{$data->{'stacked_column'}->[0]->{'data'}}) {
1385     return $self->_error("No values in data series");
1386   }
1387
1388   return 1;
1389 }
1390
1391 sub _set_column_count   { $_[0]->{'column_count'} = $_[1]; }
1392 sub _set_min_value      { $_[0]->{'min_value'} = $_[1]; }
1393 sub _set_max_value      { $_[0]->{'max_value'} = $_[1]; }
1394 sub _set_image_box      { $_[0]->{'image_box'} = $_[1]; }
1395 sub _set_graph_box      { $_[0]->{'graph_box'} = $_[1]; }
1396 sub _set_series_counter { $_[0]->{'series_counter'} = $_[1]; }
1397 sub _get_column_count   { return $_[0]->{'column_count'} }
1398 sub _get_min_value      { return $_[0]->{'min_value'} }
1399 sub _get_max_value      { return $_[0]->{'max_value'} }
1400 sub _get_image_box      { return $_[0]->{'image_box'} }
1401 sub _get_graph_box      { return $_[0]->{'graph_box'} }
1402 sub _reset_series_counter { $_[0]->{series_counter} = 0 }
1403 sub _get_series_counter { return $_[0]->{'series_counter'} }
1404
1405 sub _style_defs {
1406   my ($self) = @_;
1407
1408   my %work = %{$self->SUPER::_style_defs()};
1409   $work{area} =
1410     {
1411      opacity => 0.5,
1412     };
1413   push @{$work{features}}, qw/graph_outline graph_fill linemarkers/;
1414   $work{hgrid} =
1415     {
1416      color => "lookup(fg)",
1417      style => "solid",
1418     };
1419
1420   return \%work;
1421 }
1422
1423 sub _composite {
1424   my ($self) = @_;
1425   return ( $self->SUPER::_composite(), "graph", "hgrid" );
1426 }
1427
1428 1;
1429
1430 =back
1431
1432 =head1 AUTHOR
1433
1434 Patrick Michaud, Tony Cook.
1435
1436 =cut