[rt #59532] allow negative_bg to be a fill for vertical charts
[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 use constant STARTING_MIN_VALUE => 99999;
44
45 =over
46
47 =item add_data_series(\@data, $series_name)
48
49 Add a data series to the graph, of the default type.  This requires
50 that the graph object be one of the derived graph classes.
51
52 =cut
53
54 sub add_data_series {
55   my $self = shift;
56   my $data_ref = shift;
57   my $series_name = shift;
58
59   my $series_type = $self->_get_default_series_type();
60   $self->_add_data_series($series_type, $data_ref, $series_name);
61
62   return;
63 }
64
65 =item add_column_data_series(\@data, $series_name)
66
67 Add a column data series to the graph.
68
69 =cut
70
71 sub add_column_data_series {
72   my $self = shift;
73   my $data_ref = shift;
74   my $series_name = shift;
75
76   $self->_add_data_series('column', $data_ref, $series_name);
77
78   return;
79 }
80
81 =item add_stacked_column_data_series(\@data, $series_name)
82
83 Add a stacked column data series to the graph.
84
85 =cut
86
87 sub add_stacked_column_data_series {
88   my $self = shift;
89   my $data_ref = shift;
90   my $series_name = shift;
91
92   $self->_add_data_series('stacked_column', $data_ref, $series_name);
93
94   return;
95 }
96
97 =item add_line_data_series(\@data, $series_name)
98
99 Add a line data series to the graph.
100
101 =cut
102
103 sub add_line_data_series {
104   my $self = shift;
105   my $data_ref = shift;
106   my $series_name = shift;
107
108   $self->_add_data_series('line', $data_ref, $series_name);
109
110   return;
111 }
112
113 =item add_area_data_series(\@data, $series_name)
114
115 Add a area data series to the graph.
116
117 =cut
118
119 sub add_area_data_series {
120   my $self = shift;
121   my $data_ref = shift;
122   my $series_name = shift;
123
124   $self->_add_data_series('area', $data_ref, $series_name);
125
126   return;
127 }
128
129 =item set_y_max($value)
130
131 Sets the maximum y value to be displayed.  This will be ignored if the
132 y_max is lower than the highest value.
133
134 =cut
135
136 sub set_y_max {
137   $_[0]->{'custom_style'}->{'y_max'} = $_[1];
138 }
139
140 =item set_y_min($value)
141
142 Sets the minimum y value to be displayed.  This will be ignored if the
143 y_min is higher than the lowest value.
144
145 =cut
146
147 sub set_y_min {
148   $_[0]->{'custom_style'}->{'y_min'} = $_[1];
149 }
150
151 =item set_column_padding($int)
152
153 Sets the padding between columns.  This is a percentage of the column
154 width.  Defaults to 0.
155
156 =cut
157
158 sub set_column_padding {
159   $_[0]->{'custom_style'}->{'column_padding'} = $_[1];
160 }
161
162 =item set_range_padding($percentage)
163
164 Sets the padding to be used, as a percentage.  For example, if your
165 data ranges from 0 to 10, and you have a 20 percent padding, the y
166 axis will go to 12.
167
168 Defaults to 10.  This attribute is ignored for positive numbers if
169 set_y_max() has been called, and ignored for negative numbers if
170 set_y_min() has been called.
171
172 =cut
173
174 sub set_range_padding {
175   $_[0]->{'custom_style'}->{'range_padding'} = $_[1];
176 }
177
178 =item set_negative_background($color)
179
180 Sets the background color used below the x axis.
181
182 =cut
183
184 sub set_negative_background {
185   $_[0]->{'custom_style'}->{'negative_bg'} = $_[1];
186 }
187
188 =item draw()
189
190 Draw the graph
191
192 =cut
193
194 sub draw {
195   my ($self, %opts) = @_;
196
197   if (!$self->_valid_input()) {
198     return;
199   }
200
201   $self->_style_setup(\%opts);
202
203   my $style = $self->{_style};
204
205   $self->_make_img
206     or return;
207
208   my $img = $self->_get_image()
209     or return;
210
211   my @image_box = ( 0, 0, $img->getwidth-1, $img->getheight-1 );
212   $self->_set_image_box(\@image_box);
213
214   my @chart_box = ( 0, 0, $img->getwidth-1, $img->getheight-1 );
215   $self->_draw_legend(\@chart_box);
216   if ($style->{title}{text}) {
217     $self->_draw_title($img, \@chart_box)
218       or return;
219   }
220
221   # Scale the graph box down to the widest graph that can cleanly hold the # of columns.
222   return unless $self->_get_data_range();
223   $self->_remove_tics_from_chart_box(\@chart_box, \%opts);
224   my $column_count = $self->_get_column_count();
225
226   my $width = $self->_get_number('width');
227   my $height = $self->_get_number('height');
228
229   my $graph_width = $chart_box[2] - $chart_box[0];
230   my $graph_height = $chart_box[3] - $chart_box[1];
231
232   my $col_width = ($graph_width - 1) / $column_count;
233   if ($col_width > 1) {
234     $graph_width = int($col_width) * $column_count + 1;
235   }
236   else {
237     $graph_width = $col_width * $column_count + 1;
238   }
239
240   my $tic_count = $self->_get_y_tics();
241   my $tic_distance = ($graph_height-1) / ($tic_count - 1);
242   $graph_height = int($tic_distance * ($tic_count - 1));
243
244   my $top  = $chart_box[1];
245   my $left = $chart_box[0];
246
247   $self->{'_style'}{'graph_width'} = $graph_width;
248   $self->{'_style'}{'graph_height'} = $graph_height;
249
250   my @graph_box = ($left, $top, $left + $graph_width, $top + $graph_height);
251   $self->_set_graph_box(\@graph_box);
252
253   my @fill_box = ( $left, $top, $left+$graph_width, $top+$graph_height );
254   if ($self->_feature_enabled("graph_outline")) {
255     my @line = $self->_get_line("graph.outline")
256       or return;
257
258     $self->_box(
259                 @line,
260                 box => \@fill_box,
261                 img => $img,
262                );
263     ++$fill_box[0];
264     ++$fill_box[1];
265     --$fill_box[2];
266     --$fill_box[3];
267   }
268
269   $img->box(
270             $self->_get_fill('graph.fill'),
271             box => \@fill_box,
272            );
273
274   my $min_value = $self->_get_min_value();
275   my $max_value = $self->_get_max_value();
276   my $value_range = $max_value - $min_value;
277
278   my $zero_position;
279   if ($value_range) {
280     $zero_position =  $top + $graph_height - (-1*$min_value / $value_range) * ($graph_height-1);
281   }
282
283   if ($min_value < 0) {
284     my @neg_box = ( $left + 1, $zero_position, $left+$graph_width- 1, $top+$graph_height - 1 );
285     my @neg_fill = $self->_get_fill('negative_bg', \@neg_box)
286       or return;
287     $img->box(
288               @neg_fill,
289               box => \@neg_box,
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     if ($self->_feature_enabled("linemarkers")) {
643       push @marker_positions, [$x2, $y2];
644       foreach my $position (@marker_positions) {
645         $self->_draw_line_marker($position->[0], $position->[1], $series_counter);
646       }
647     }
648     $series_counter++;
649   }
650
651   $self->_set_series_counter($series_counter);
652   return 1;
653 }
654
655 sub _area_data_fill {
656   my ($self, $index, $box) = @_;
657
658   my %fill = $self->_data_fill($index, $box);
659
660   my $opacity = $self->_get_number("area.opacity");
661   $opacity == 1
662     and return %fill;
663
664   my $orig_fill = $fill{fill};
665   unless ($orig_fill) {
666     $orig_fill = Imager::Fill->new
667       (
668        solid => $fill{color},
669        combine => "normal",
670       );
671   }
672   return
673     (
674      fill => Imager::Fill->new
675      (
676       type => "opacity",
677       other => $orig_fill,
678       opacity => $opacity,
679      ),
680     );
681 }
682
683 sub _draw_area {
684   my $self = shift;
685   my $style = $self->{'_style'};
686
687   my $img = $self->_get_image();
688
689   my $max_value = $self->_get_max_value();
690   my $min_value = $self->_get_min_value();
691   my $column_count = $self->_get_column_count();
692
693   my $value_range = $max_value - $min_value;
694
695   my $width = $self->_get_number('width');
696   my $height = $self->_get_number('height');
697
698   my $graph_width = $self->_get_number('graph_width');
699   my $graph_height = $self->_get_number('graph_height');
700
701   my $area_series = $self->_get_data_series()->{'area'};
702   my $series_counter = $self->_get_series_counter() || 0;
703
704   my $col_width = int($graph_width / $column_count) -1;
705
706   my $graph_box = $self->_get_graph_box();
707   my $left = $graph_box->[0] + 1;
708   my $bottom = $graph_box->[1];
709   my $right = $graph_box->[2];
710   my $top = $graph_box->[3];
711
712   my $zero_position =  $bottom + $graph_height - (-1*$min_value / $value_range) * ($graph_height - 1);
713
714   my $line_aa = $self->_get_number("lineaa");
715   foreach my $series (@$area_series) {
716     my @data = @{$series->{'data'}};
717     my $data_size = scalar @data;
718
719     my $interval = $graph_width / ($data_size - 1);
720
721     my $color = $self->_data_color($series_counter);
722
723     # We need to add these last, otherwise the next line segment will overwrite half of the marker
724     my @marker_positions;
725     my @polygon_points;
726     for (my $i = 0; $i < $data_size - 1; $i++) {
727       my $x1 = $left + $i * $interval;
728
729       my $y1 = $bottom + ($value_range - $data[$i] + $min_value)/$value_range * $graph_height;
730
731       if ($i == 0) {
732         push @polygon_points, [$x1, $top];
733       }
734       push @polygon_points, [$x1, $y1];
735
736       push @marker_positions, [$x1, $y1];
737     }
738
739     my $x2 = $left + ($data_size - 1) * $interval;
740
741     my $y2 = $bottom + ($value_range - $data[$data_size - 1] + $min_value)/$value_range * $graph_height;
742     push @polygon_points, [$x2, $y2];
743     push @polygon_points, [$x2, $top];
744     push @polygon_points, $polygon_points[0];
745
746     my @fill = $self->_area_data_fill($series_counter, [$left, $bottom, $right, $top]);
747     $img->polygon(points => [@polygon_points], @fill);
748
749     if ($self->_feature_enabled("areamarkers")) {
750       push @marker_positions, [$x2, $y2];
751       foreach my $position (@marker_positions) {
752         $self->_draw_line_marker($position->[0], $position->[1], $series_counter);
753       }
754     }
755     $series_counter++;
756   }
757
758   $self->_set_series_counter($series_counter);
759   return 1;
760 }
761
762 sub _draw_columns {
763   my $self = shift;
764   my $style = $self->{'_style'};
765
766   my $img = $self->_get_image();
767
768   my $max_value = $self->_get_max_value();
769   my $min_value = $self->_get_min_value();
770   my $column_count = $self->_get_column_count();
771
772   my $value_range = $max_value - $min_value;
773
774   my $width = $self->_get_number('width');
775   my $height = $self->_get_number('height');
776
777   my $graph_width = $self->_get_number('graph_width');
778   my $graph_height = $self->_get_number('graph_height');
779
780
781   my $graph_box = $self->_get_graph_box();
782   my $left = $graph_box->[0] + 1;
783   my $bottom = $graph_box->[1];
784   my $zero_position =  int($bottom + $graph_height - (-1*$min_value / $value_range) * ($graph_height -1));
785
786   my $bar_width = $graph_width / $column_count;
787
788   my $outline_color;
789   if ($style->{'features'}{'outline'}) {
790     $outline_color = $self->_get_color('outline.line');
791   }
792
793   my $series_counter = $self->_get_series_counter() || 0;
794   my $col_series = $self->_get_data_series()->{'column'};
795   my $column_padding_percent = $self->_get_number('column_padding') || 0;
796   my $column_padding = int($column_padding_percent * $bar_width / 100);
797
798   # 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.
799   my $column_series = 0;
800
801   # If there are stacked columns, non-stacked columns need to start one to the right of where they would otherwise
802   my $has_stacked_columns = (defined $self->_get_data_series()->{'stacked_column'} ? 1 : 0);
803
804   for (my $series_pos = 0; $series_pos < scalar @$col_series; $series_pos++) {
805     my $series = $col_series->[$series_pos];
806     my @data = @{$series->{'data'}};
807     my $data_size = scalar @data;
808     for (my $i = 0; $i < $data_size; $i++) {
809       my $part1 = $bar_width * (scalar @$col_series * $i);
810       my $part2 = ($series_pos) * $bar_width;
811       my $x1 = $left + $part1 + $part2;
812       if ($has_stacked_columns) {
813         $x1 += ($bar_width * ($i+1));
814       }
815       $x1 = int($x1);
816
817       my $x2 = int($x1 + $bar_width - $column_padding)-1;
818       # Special case for when bar_width is less than 1.
819       if ($x2 < $x1) {
820         $x2 = $x1;
821       }
822
823       my $y1 = int($bottom + ($value_range - $data[$i] + $min_value)/$value_range * $graph_height);
824
825       my $color = $self->_data_color($series_counter);
826
827       if ($data[$i] > 0) {
828         my @fill = $self->_data_fill($series_counter, [$x1, $y1, $x2, $zero_position-1]);
829         $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position-1, @fill);
830         if ($style->{'features'}{'outline'}) {
831           $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position, color => $outline_color);
832         }
833       }
834       else {
835         my @fill = $self->_data_fill($series_counter, [$x1, $zero_position+1, $x2, $y1]);
836         $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position+1, ymax => $y1, @fill);
837         if ($style->{'features'}{'outline'}) {
838           $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position+1, ymax => $y1+1, color => $outline_color);
839         }
840       }
841     }
842
843     $series_counter++;
844     $column_series++;
845   }
846   $self->_set_series_counter($series_counter);
847   return 1;
848 }
849
850 sub _draw_stacked_columns {
851   my $self = shift;
852   my $style = $self->{'_style'};
853
854   my $img = $self->_get_image();
855
856   my $max_value = $self->_get_max_value();
857   my $min_value = $self->_get_min_value();
858   my $column_count = $self->_get_column_count();
859   my $value_range = $max_value - $min_value;
860
861   my $graph_box = $self->_get_graph_box();
862   my $left = $graph_box->[0] + 1;
863   my $bottom = $graph_box->[1];
864
865   my $graph_width = $self->_get_number('graph_width');
866   my $graph_height = $self->_get_number('graph_height');
867
868   my $bar_width = $graph_width / $column_count;
869   my $column_series = 0;
870   if (my $column_series_data = $self->_get_data_series()->{'column'}) {
871     $column_series = (scalar @$column_series_data);
872   }
873   $column_series++;
874
875   my $column_padding_percent = $self->_get_number('column_padding') || 0;
876   if ($column_padding_percent < 0) {
877     return $self->_error("Column padding less than 0");
878   }
879   if ($column_padding_percent > 100) {
880     return $self->_error("Column padding greater than 0");
881   }
882   my $column_padding = int($column_padding_percent * $bar_width / 100);
883
884   my $outline_color;
885   if ($style->{'features'}{'outline'}) {
886     $outline_color = $self->_get_color('outline.line');
887   }
888
889   my $zero_position =  $bottom + $graph_height - (-1*$min_value / $value_range) * ($graph_height -1);
890   my $col_series = $self->_get_data_series()->{'stacked_column'};
891   my $series_counter = $self->_get_series_counter() || 0;
892
893   foreach my $series (@$col_series) {
894     my @data = @{$series->{'data'}};
895     my $data_size = scalar @data;
896     for (my $i = 0; $i < $data_size; $i++) {
897       my $part1 = $bar_width * $i * $column_series;
898       my $part2 = 0;
899       my $x1 = int($left + $part1 + $part2);
900       my $x2 = int($x1 + $bar_width - $column_padding) - 1;
901       # Special case for when bar_width is less than 1.
902       if ($x2 < $x1) {
903         $x2 = $x1;
904       }
905
906       my $y1 = int($bottom + ($value_range - $data[$i] + $min_value)/$value_range * $graph_height);
907
908       if ($data[$i] > 0) {
909         my @fill = $self->_data_fill($series_counter, [$x1, $y1, $x2, $zero_position-1]);
910         $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position-1, @fill);
911         if ($style->{'features'}{'outline'}) {
912           $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position, color => $outline_color);
913         }
914       }
915       else {
916         my @fill = $self->_data_fill($series_counter, [$x1, $zero_position+1, $x2, $y1]);
917         $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position+1, ymax => $y1, @fill);
918         if ($style->{'features'}{'outline'}) {
919           $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position+1, ymax => $y1+1, color => $outline_color);
920         }
921       }
922     }
923
924     $series_counter++;
925   }
926   $self->_set_series_counter($series_counter);
927   return 1;
928 }
929
930 sub _add_data_series {
931   my $self = shift;
932   my $series_type = shift;
933   my $data_ref = shift;
934   my $series_name = shift;
935
936   my $graph_data = $self->{'graph_data'} || {};
937
938   my $series = $graph_data->{$series_type} || [];
939
940   push @$series, { data => $data_ref, series_name => $series_name };
941
942   $graph_data->{$series_type} = $series;
943
944   $self->{'graph_data'} = $graph_data;
945   return;
946 }
947
948 =back
949
950 =head1 FEATURES
951
952 =over
953
954 =item show_horizontal_gridlines()
955
956 Feature: horizontal_gridlines
957 X<horizontal_gridlines>X<features, horizontal_gridlines>
958
959 Enables the C<horizontal_gridlines> feature, which shows horizontal
960 gridlines at the y-tics.
961
962 The style of the gridlines can be controlled with the
963 set_horizontal_gridline_style() method (or by setting the hgrid
964 style).
965
966 =cut
967
968 sub show_horizontal_gridlines {
969     $_[0]->{'custom_style'}{features}{'horizontal_gridlines'} = 1;
970 }
971
972 =item set_horizontal_gridline_style(style => $style, color => $color)
973
974 Style: hgrid.
975 X<hgrid>X<style parameters, hgrid>
976
977 Set the style and color of horizonal gridlines.
978
979 See: L<Imager::Graph/"Line styles">
980
981 =cut
982
983 sub set_horizontal_gridline_style {
984   my ($self, %opts) = @_;
985
986   $self->{custom_style}{hgrid} ||= {};
987   @{$self->{custom_style}{hgrid}}{keys %opts} = values %opts;
988
989   return 1;
990 }
991
992 =item show_graph_outline($flag)
993
994 Feature: graph_outline
995 X<graph_outline>X<features, graph_outline>
996
997 If no flag is supplied, unconditionally enable the graph outline.
998
999 If $flag is supplied, enable/disable the graph_outline feature based
1000 on that.
1001
1002 Enabled by default.
1003
1004 =cut
1005
1006 sub show_graph_outline {
1007   my ($self, $flag) = @_;
1008
1009   @_ == 1 and $flag = 1;
1010
1011   $self->{custom_style}{features}{graph_outline} = $flag;
1012
1013   return 1;
1014 }
1015
1016 =item set_graph_outline_style(color => ...)
1017
1018 =item set_graph_outline_style(style => ..., color => ...)
1019
1020 Style: graph.outline
1021 X<graph.outline>X<style parameters, graph.outline>
1022
1023 Sets the style of the graph outline.
1024
1025 Default: the style C<fg>.
1026
1027 =cut
1028
1029 sub set_graph_outline_style {
1030   my ($self, %opts) = @_;
1031
1032   $self->{custom_style}{graph}{outline} = \%opts;
1033
1034   return 1;
1035 }
1036
1037 =item set_graph_fill_style(I<fill parameters>)
1038
1039 Style: graph.fill
1040 X<graph.fill>X<style parameters, graph.fill>
1041
1042 Set the fill used to fill the graph data area.
1043
1044 Default: the style C<bg>.
1045
1046 eg.
1047
1048   $graph->set_graph_fill_style(solid => "FF000020", combine => "normal");
1049
1050 =cut
1051
1052 sub set_graph_fill_style {
1053   my ($self, %opts) = @_;
1054
1055   $self->{custom_style}{graph}{fill} = \%opts;
1056
1057   return 1;
1058 }
1059
1060 =item show_area_markers()
1061
1062 =item show_area_markers($value)
1063
1064 Feature: areamarkers.
1065
1066 If $value is missing or true, draw markers along the top of area data
1067 series.
1068
1069 eg.
1070
1071   $chart->show_area_markers();
1072
1073 =cut
1074
1075 sub show_area_markers {
1076   my ($self, $value) = @_;
1077
1078   @_ > 1 or $value = 1;
1079
1080   $self->{custom_style}{features}{areamarkers} = $value;
1081
1082   return 1;
1083 }
1084
1085 =item show_line_markers()
1086
1087 =item show_line_markers($value)
1088
1089 Feature: linemarkers.
1090
1091 If $value is missing or true, draw markers on a line data series.
1092
1093 Note: line markers are drawn by default.
1094
1095 =cut
1096
1097 sub show_line_markers {
1098   my ($self, $value) = @_;
1099
1100   @_ > 1 or $value = 1;
1101
1102   $self->{custom_style}{features}{linemarkers} = $value;
1103
1104   return 1;
1105 }
1106
1107 =item use_automatic_axis()
1108
1109 Automatically scale the Y axis, based on L<Chart::Math::Axis>.  If
1110 Chart::Math::Axis isn't installed, this sets an error and returns
1111 undef.  Returns 1 if it is installed.
1112
1113 =cut
1114
1115 sub use_automatic_axis {
1116   eval { require Chart::Math::Axis; };
1117   if ($@) {
1118     return $_[0]->_error("use_automatic_axis - $@\nCalled from ".join(' ', caller)."\n");
1119   }
1120   $_[0]->{'custom_style'}->{'automatic_axis'} = 1;
1121   return 1;
1122 }
1123
1124 =item set_y_tics($count)
1125
1126 Set the number of Y tics to use.  Their value and position will be
1127 determined by the data range.
1128
1129 =cut
1130
1131 sub set_y_tics {
1132   $_[0]->{'y_tics'} = $_[1];
1133 }
1134
1135 sub _get_y_tics {
1136   return $_[0]->{'y_tics'} || 0;
1137 }
1138
1139 sub _remove_tics_from_chart_box {
1140   my ($self, $chart_box, $opts) = @_;
1141
1142   # XXX - bad default
1143   my $tic_width = $self->_get_y_tic_width() || 10;
1144   my @y_tic_box = ($chart_box->[0], $chart_box->[1], $chart_box->[0] + $tic_width, $chart_box->[3]);
1145
1146   # XXX - bad default
1147   my $tic_height = $self->_get_x_tic_height($opts) || 10;
1148   my @x_tic_box = ($chart_box->[0], $chart_box->[3] - $tic_height, $chart_box->[2], $chart_box->[3]);
1149
1150   $self->_remove_box($chart_box, \@y_tic_box);
1151   $self->_remove_box($chart_box, \@x_tic_box);
1152
1153   # If there's no title, the y-tics will be part off-screen.  Half of the x-tic height should be more than sufficient.
1154   my @y_tic_tops = ($chart_box->[0], $chart_box->[1], $chart_box->[2], $chart_box->[1] + int($tic_height / 2));
1155   $self->_remove_box($chart_box, \@y_tic_tops);
1156
1157   # Make sure that the first and last label fit
1158   if (my $labels = $self->_get_labels($opts)) {
1159     if (my @box = $self->_text_bbox($labels->[0], 'legend')) {
1160       my @remove_box = ($chart_box->[0],
1161                         $chart_box->[1],
1162                         $chart_box->[0] + int($box[2] / 2) + 1,
1163                         $chart_box->[3]
1164                         );
1165
1166       $self->_remove_box($chart_box, \@remove_box);
1167     }
1168     if (my @box = $self->_text_bbox($labels->[-1], 'legend')) {
1169       my @remove_box = ($chart_box->[2] - int($box[2] / 2) - 1,
1170                         $chart_box->[1],
1171                         $chart_box->[2],
1172                         $chart_box->[3]
1173                         );
1174
1175       $self->_remove_box($chart_box, \@remove_box);
1176     }
1177   }
1178 }
1179
1180 sub _get_y_tic_width {
1181   my $self = shift;
1182   my $min = $self->_get_min_value();
1183   my $max = $self->_get_max_value();
1184   my $tic_count = $self->_get_y_tics();
1185
1186   my $interval = ($max - $min) / ($tic_count - 1);
1187
1188   my %text_info = $self->_text_style('legend')
1189     or return;
1190
1191   my $max_width = 0;
1192   for my $count (0 .. $tic_count - 1) {
1193     my $value = ($count*$interval)+$min;
1194
1195     if ($interval < 1 || ($value != int($value))) {
1196       $value = sprintf("%.2f", $value);
1197     }
1198     my @box = $self->_text_bbox($value, 'legend');
1199     my $width = $box[2] - $box[0];
1200
1201     # For the tic width
1202     $width += 10;
1203     if ($width > $max_width) {
1204       $max_width = $width;
1205     }
1206   }
1207
1208   return $max_width;
1209 }
1210
1211 sub _get_x_tic_height {
1212   my ($self, $opts) = @_;
1213
1214   my $labels = $self->_get_labels($opts);
1215
1216   if (!$labels) {
1217         return;
1218   }
1219
1220   my $tic_count = (scalar @$labels) - 1;
1221
1222   my %text_info = $self->_text_style('legend')
1223     or return;
1224
1225   my $max_height = 0;
1226   for my $count (0 .. $tic_count) {
1227     my $label = $labels->[$count];
1228
1229     my @box = $self->_text_bbox($label, 'legend');
1230
1231     my $height = $box[3] - $box[1];
1232
1233     # Padding + the tic
1234     $height += 10;
1235     if ($height > $max_height) {
1236       $max_height = $height;
1237     }
1238   }
1239
1240   return $max_height;
1241 }
1242
1243 sub _draw_y_tics {
1244   my $self = shift;
1245   my $min = $self->_get_min_value();
1246   my $max = $self->_get_max_value();
1247   my $tic_count = $self->_get_y_tics();
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 $interval = ($max - $min) / ($tic_count - 1);
1254
1255   my %text_info = $self->_text_style('legend')
1256     or return;
1257
1258   my $line_style = $self->_get_color('outline.line');
1259   my $show_gridlines = $self->{_style}{features}{'horizontal_gridlines'};
1260   my @grid_line = $self->_get_line("hgrid");
1261   my $tic_distance = ($graph_box->[3] - $graph_box->[1]) / ($tic_count - 1);
1262   for my $count (0 .. $tic_count - 1) {
1263     my $x1 = $graph_box->[0] - 5;
1264     my $x2 = $graph_box->[0] + 5;
1265     my $y1 = int($graph_box->[3] - ($count * $tic_distance));
1266
1267     my $value = ($count*$interval)+$min;
1268     if ($interval < 1 || ($value != int($value))) {
1269         $value = sprintf("%.2f", $value);
1270     }
1271
1272     my @box = $self->_text_bbox($value, 'legend')
1273       or return;
1274
1275     $img->line(x1 => $x1, x2 => $x2, y1 => $y1, y2 => $y1, aa => 1, color => $line_style);
1276
1277     my $width = $box[2];
1278     my $height = $box[3];
1279
1280     $img->string(%text_info,
1281                  x    => ($x1 - $width - 3),
1282                  y    => ($y1 + ($height / 2)),
1283                  text => $value
1284                 );
1285
1286     if ($show_gridlines && $y1 != $graph_box->[1] && $y1 != $graph_box->[3]) {
1287       $self->_line(x1 => $graph_box->[0], y1 => $y1,
1288                    x2 => $graph_box->[2], y2 => $y1,
1289                    img => $img,
1290                    @grid_line);
1291     }
1292   }
1293
1294 }
1295
1296 sub _draw_x_tics {
1297   my ($self, $opts) = @_;
1298
1299   my $img = $self->_get_image();
1300   my $graph_box = $self->_get_graph_box();
1301   my $image_box = $self->_get_image_box();
1302
1303   my $labels = $self->_get_labels($opts);
1304
1305   my $tic_count = (scalar @$labels) - 1;
1306
1307   my $has_columns = (defined $self->_get_data_series()->{'column'} || defined $self->_get_data_series()->{'stacked_column'});
1308
1309   # If we have columns, we want the x-ticks to show up in the middle of the column, not on the left edge
1310   my $denominator = $tic_count;
1311   if ($has_columns) {
1312     $denominator ++;
1313   }
1314   my $tic_distance = ($graph_box->[2] - $graph_box->[0]) / ($denominator);
1315   my %text_info = $self->_text_style('legend')
1316     or return;
1317
1318   # If automatic axis is turned on, let's be selective about what labels we draw.
1319   my $max_size = 0;
1320   my $tic_skip = 0;
1321   if ($self->_get_number('automatic_axis')) {
1322     foreach my $label (@$labels) {
1323       my @box = $self->_text_bbox($label, 'legend');
1324       if ($box[2] > $max_size) {
1325         $max_size = $box[2];
1326       }
1327     }
1328
1329     # Give the max_size some padding...
1330     $max_size *= 1.2;
1331
1332     $tic_skip = int($max_size / $tic_distance) + 1;
1333   }
1334
1335   my $line_style = $self->_get_color('outline.line');
1336
1337   for my $count (0 .. $tic_count) {
1338     next if ($count % ($tic_skip + 1));
1339     my $label = $labels->[$count];
1340     my $x1 = $graph_box->[0] + ($tic_distance * $count);
1341
1342     if ($has_columns) {
1343       $x1 += $tic_distance / 2;
1344     }
1345
1346     $x1 = int($x1);
1347
1348     my $y1 = $graph_box->[3] + 5;
1349     my $y2 = $graph_box->[3] - 5;
1350
1351     $img->line(x1 => $x1, x2 => $x1, y1 => $y1, y2 => $y2, aa => 1, color => $line_style);
1352
1353     my @box = $self->_text_bbox($label, 'legend')
1354       or return;
1355
1356     my $width = $box[2];
1357     my $height = $box[3];
1358
1359     $img->string(%text_info,
1360                  x    => ($x1 - ($width / 2)),
1361                  y    => ($y1 + ($height + 5)),
1362                  text => $label
1363                 );
1364
1365   }
1366 }
1367
1368 sub _valid_input {
1369   my $self = shift;
1370
1371   if (!defined $self->_get_data_series() || !keys %{$self->_get_data_series()}) {
1372     return $self->_error("No data supplied");
1373   }
1374
1375   my $data = $self->_get_data_series();
1376   if (defined $data->{'line'} && !scalar @{$data->{'line'}->[0]->{'data'}}) {
1377     return $self->_error("No values in data series");
1378   }
1379   if (defined $data->{'column'} && !scalar @{$data->{'column'}->[0]->{'data'}}) {
1380     return $self->_error("No values in data series");
1381   }
1382   if (defined $data->{'stacked_column'} && !scalar @{$data->{'stacked_column'}->[0]->{'data'}}) {
1383     return $self->_error("No values in data series");
1384   }
1385
1386   return 1;
1387 }
1388
1389 sub _set_column_count   { $_[0]->{'column_count'} = $_[1]; }
1390 sub _set_min_value      { $_[0]->{'min_value'} = $_[1]; }
1391 sub _set_max_value      { $_[0]->{'max_value'} = $_[1]; }
1392 sub _set_image_box      { $_[0]->{'image_box'} = $_[1]; }
1393 sub _set_graph_box      { $_[0]->{'graph_box'} = $_[1]; }
1394 sub _set_series_counter { $_[0]->{'series_counter'} = $_[1]; }
1395 sub _get_column_count   { return $_[0]->{'column_count'} }
1396 sub _get_min_value      { return $_[0]->{'min_value'} }
1397 sub _get_max_value      { return $_[0]->{'max_value'} }
1398 sub _get_image_box      { return $_[0]->{'image_box'} }
1399 sub _get_graph_box      { return $_[0]->{'graph_box'} }
1400 sub _reset_series_counter { $_[0]->{series_counter} = 0 }
1401 sub _get_series_counter { return $_[0]->{'series_counter'} }
1402
1403 sub _style_defs {
1404   my ($self) = @_;
1405
1406   my %work = %{$self->SUPER::_style_defs()};
1407   $work{area} =
1408     {
1409      opacity => 0.5,
1410     };
1411   push @{$work{features}}, qw/graph_outline graph_fill linemarkers/;
1412   $work{hgrid} =
1413     {
1414      color => "lookup(fg)",
1415      style => "solid",
1416     };
1417
1418   return \%work;
1419 }
1420
1421 sub _composite {
1422   my ($self) = @_;
1423   return ( $self->SUPER::_composite(), "graph", "hgrid" );
1424 }
1425
1426 1;