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