don't draw line markers for area charts by default
[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     if ($self->_feature_enabled("areamarkers")) {
748       push @marker_positions, [$x2, $y2];
749       foreach my $position (@marker_positions) {
750         $self->_draw_line_marker($position->[0], $position->[1], $series_counter);
751       }
752     }
753     $series_counter++;
754   }
755
756   $self->_set_series_counter($series_counter);
757   return 1;
758 }
759
760 sub _draw_columns {
761   my $self = shift;
762   my $style = $self->{'_style'};
763
764   my $img = $self->_get_image();
765
766   my $max_value = $self->_get_max_value();
767   my $min_value = $self->_get_min_value();
768   my $column_count = $self->_get_column_count();
769
770   my $value_range = $max_value - $min_value;
771
772   my $width = $self->_get_number('width');
773   my $height = $self->_get_number('height');
774
775   my $graph_width = $self->_get_number('graph_width');
776   my $graph_height = $self->_get_number('graph_height');
777
778
779   my $graph_box = $self->_get_graph_box();
780   my $left = $graph_box->[0] + 1;
781   my $bottom = $graph_box->[1];
782   my $zero_position =  int($bottom + $graph_height - (-1*$min_value / $value_range) * ($graph_height -1));
783
784   my $bar_width = $graph_width / $column_count;
785
786   my $outline_color;
787   if ($style->{'features'}{'outline'}) {
788     $outline_color = $self->_get_color('outline.line');
789   }
790
791   my $series_counter = $self->_get_series_counter() || 0;
792   my $col_series = $self->_get_data_series()->{'column'};
793   my $column_padding_percent = $self->_get_number('column_padding') || 0;
794   my $column_padding = int($column_padding_percent * $bar_width / 100);
795
796   # 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.
797   my $column_series = 0;
798
799   # If there are stacked columns, non-stacked columns need to start one to the right of where they would otherwise
800   my $has_stacked_columns = (defined $self->_get_data_series()->{'stacked_column'} ? 1 : 0);
801
802   for (my $series_pos = 0; $series_pos < scalar @$col_series; $series_pos++) {
803     my $series = $col_series->[$series_pos];
804     my @data = @{$series->{'data'}};
805     my $data_size = scalar @data;
806     for (my $i = 0; $i < $data_size; $i++) {
807       my $part1 = $bar_width * (scalar @$col_series * $i);
808       my $part2 = ($series_pos) * $bar_width;
809       my $x1 = $left + $part1 + $part2;
810       if ($has_stacked_columns) {
811         $x1 += ($bar_width * ($i+1));
812       }
813       $x1 = int($x1);
814
815       my $x2 = int($x1 + $bar_width - $column_padding)-1;
816       # Special case for when bar_width is less than 1.
817       if ($x2 < $x1) {
818         $x2 = $x1;
819       }
820
821       my $y1 = int($bottom + ($value_range - $data[$i] + $min_value)/$value_range * $graph_height);
822
823       my $color = $self->_data_color($series_counter);
824
825       if ($data[$i] > 0) {
826         my @fill = $self->_data_fill($series_counter, [$x1, $y1, $x2, $zero_position-1]);
827         $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position-1, @fill);
828         if ($style->{'features'}{'outline'}) {
829           $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position, color => $outline_color);
830         }
831       }
832       else {
833         my @fill = $self->_data_fill($series_counter, [$x1, $zero_position+1, $x2, $y1]);
834         $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position+1, ymax => $y1, @fill);
835         if ($style->{'features'}{'outline'}) {
836           $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position+1, ymax => $y1+1, color => $outline_color);
837         }
838       }
839     }
840
841     $series_counter++;
842     $column_series++;
843   }
844   $self->_set_series_counter($series_counter);
845   return 1;
846 }
847
848 sub _draw_stacked_columns {
849   my $self = shift;
850   my $style = $self->{'_style'};
851
852   my $img = $self->_get_image();
853
854   my $max_value = $self->_get_max_value();
855   my $min_value = $self->_get_min_value();
856   my $column_count = $self->_get_column_count();
857   my $value_range = $max_value - $min_value;
858
859   my $graph_box = $self->_get_graph_box();
860   my $left = $graph_box->[0] + 1;
861   my $bottom = $graph_box->[1];
862
863   my $graph_width = $self->_get_number('graph_width');
864   my $graph_height = $self->_get_number('graph_height');
865
866   my $bar_width = $graph_width / $column_count;
867   my $column_series = 0;
868   if (my $column_series_data = $self->_get_data_series()->{'column'}) {
869     $column_series = (scalar @$column_series_data);
870   }
871   $column_series++;
872
873   my $column_padding_percent = $self->_get_number('column_padding') || 0;
874   if ($column_padding_percent < 0) {
875     return $self->_error("Column padding less than 0");
876   }
877   if ($column_padding_percent > 100) {
878     return $self->_error("Column padding greater than 0");
879   }
880   my $column_padding = int($column_padding_percent * $bar_width / 100);
881
882   my $outline_color;
883   if ($style->{'features'}{'outline'}) {
884     $outline_color = $self->_get_color('outline.line');
885   }
886
887   my $zero_position =  $bottom + $graph_height - (-1*$min_value / $value_range) * ($graph_height -1);
888   my $col_series = $self->_get_data_series()->{'stacked_column'};
889   my $series_counter = $self->_get_series_counter() || 0;
890
891   foreach my $series (@$col_series) {
892     my @data = @{$series->{'data'}};
893     my $data_size = scalar @data;
894     for (my $i = 0; $i < $data_size; $i++) {
895       my $part1 = $bar_width * $i * $column_series;
896       my $part2 = 0;
897       my $x1 = int($left + $part1 + $part2);
898       my $x2 = int($x1 + $bar_width - $column_padding) - 1;
899       # Special case for when bar_width is less than 1.
900       if ($x2 < $x1) {
901         $x2 = $x1;
902       }
903
904       my $y1 = int($bottom + ($value_range - $data[$i] + $min_value)/$value_range * $graph_height);
905
906       if ($data[$i] > 0) {
907         my @fill = $self->_data_fill($series_counter, [$x1, $y1, $x2, $zero_position-1]);
908         $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position-1, @fill);
909         if ($style->{'features'}{'outline'}) {
910           $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position, color => $outline_color);
911         }
912       }
913       else {
914         my @fill = $self->_data_fill($series_counter, [$x1, $zero_position+1, $x2, $y1]);
915         $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position+1, ymax => $y1, @fill);
916         if ($style->{'features'}{'outline'}) {
917           $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position+1, ymax => $y1+1, color => $outline_color);
918         }
919       }
920     }
921
922     $series_counter++;
923   }
924   $self->_set_series_counter($series_counter);
925   return 1;
926 }
927
928 sub _add_data_series {
929   my $self = shift;
930   my $series_type = shift;
931   my $data_ref = shift;
932   my $series_name = shift;
933
934   my $graph_data = $self->{'graph_data'} || {};
935
936   my $series = $graph_data->{$series_type} || [];
937
938   push @$series, { data => $data_ref, series_name => $series_name };
939
940   $graph_data->{$series_type} = $series;
941
942   $self->{'graph_data'} = $graph_data;
943   return;
944 }
945
946 =back
947
948 =head1 FEATURES
949
950 =over
951
952 =item show_horizontal_gridlines()
953
954 Feature: horizontal_gridlines
955 X<horizontal_gridlines>X<features, horizontal_gridlines>
956
957 Enables the C<horizontal_gridlines> feature, which shows horizontal
958 gridlines at the y-tics.
959
960 The style of the gridlines can be controlled with the
961 set_horizontal_gridline_style() method (or by setting the hgrid
962 style).
963
964 =cut
965
966 sub show_horizontal_gridlines {
967     $_[0]->{'custom_style'}{features}{'horizontal_gridlines'} = 1;
968 }
969
970 =item set_horizontal_gridline_style(style => $style, color => $color)
971
972 Style: hgrid.
973 X<hgrid>X<style parameters, hgrid>
974
975 Set the style and color of horizonal gridlines.
976
977 See: L<Imager::Graph/"Line styles">
978
979 =cut
980
981 sub set_horizontal_gridline_style {
982   my ($self, %opts) = @_;
983
984   $self->{custom_style}{hgrid} ||= {};
985   @{$self->{custom_style}{hgrid}}{keys %opts} = values %opts;
986
987   return 1;
988 }
989
990 =item show_graph_outline($flag)
991
992 Feature: graph_outline
993 X<graph_outline>X<features, graph_outline>
994
995 If no flag is supplied, unconditionally enable the graph outline.
996
997 If $flag is supplied, enable/disable the graph_outline feature based
998 on that.
999
1000 Enabled by default.
1001
1002 =cut
1003
1004 sub show_graph_outline {
1005   my ($self, $flag) = @_;
1006
1007   @_ == 1 and $flag = 1;
1008
1009   $self->{custom_style}{features}{graph_outline} = $flag;
1010
1011   return 1;
1012 }
1013
1014 =item set_graph_outline_style(color => ...)
1015
1016 =item set_graph_outline_style(style => ..., color => ...)
1017
1018 Style: graph.outline
1019 X<graph.outline>X<style parameters, graph.outline>
1020
1021 Sets the style of the graph outline.
1022
1023 Default: the style C<fg>.
1024
1025 =cut
1026
1027 sub set_graph_outline_style {
1028   my ($self, %opts) = @_;
1029
1030   $self->{custom_style}{graph}{outline} = \%opts;
1031
1032   return 1;
1033 }
1034
1035 =item set_graph_fill_style(I<fill parameters>)
1036
1037 Style: graph.fill
1038 X<graph.fill>X<style parameters, graph.fill>
1039
1040 Set the fill used to fill the graph data area.
1041
1042 Default: the style C<bg>.
1043
1044 eg.
1045
1046   $graph->set_graph_fill_style(solid => "FF000020", combine => "normal");
1047
1048 =cut
1049
1050 sub set_graph_fill_style {
1051   my ($self, %opts) = @_;
1052
1053   $self->{custom_style}{graph}{fill} = \%opts;
1054
1055   return 1;
1056 }
1057
1058 =item show_area_markers()
1059
1060 Feature: areamarkers.
1061
1062 Draw line markers along the top of area data series.
1063
1064 =cut
1065
1066 sub show_area_markers {
1067   my ($self) = @_;
1068
1069   $self->{custom_style}{features}{areamarkers} = 1;
1070
1071   return 1;
1072 }
1073
1074
1075 =item use_automatic_axis()
1076
1077 Automatically scale the Y axis, based on L<Chart::Math::Axis>.  If
1078 Chart::Math::Axis isn't installed, this sets an error and returns
1079 undef.  Returns 1 if it is installed.
1080
1081 =cut
1082
1083 sub use_automatic_axis {
1084   eval { require Chart::Math::Axis; };
1085   if ($@) {
1086     return $_[0]->_error("use_automatic_axis - $@\nCalled from ".join(' ', caller)."\n");
1087   }
1088   $_[0]->{'custom_style'}->{'automatic_axis'} = 1;
1089   return 1;
1090 }
1091
1092 =item set_y_tics($count)
1093
1094 Set the number of Y tics to use.  Their value and position will be
1095 determined by the data range.
1096
1097 =cut
1098
1099 sub set_y_tics {
1100   $_[0]->{'y_tics'} = $_[1];
1101 }
1102
1103 sub _get_y_tics {
1104   return $_[0]->{'y_tics'} || 0;
1105 }
1106
1107 sub _remove_tics_from_chart_box {
1108   my ($self, $chart_box, $opts) = @_;
1109
1110   # XXX - bad default
1111   my $tic_width = $self->_get_y_tic_width() || 10;
1112   my @y_tic_box = ($chart_box->[0], $chart_box->[1], $chart_box->[0] + $tic_width, $chart_box->[3]);
1113
1114   # XXX - bad default
1115   my $tic_height = $self->_get_x_tic_height($opts) || 10;
1116   my @x_tic_box = ($chart_box->[0], $chart_box->[3] - $tic_height, $chart_box->[2], $chart_box->[3]);
1117
1118   $self->_remove_box($chart_box, \@y_tic_box);
1119   $self->_remove_box($chart_box, \@x_tic_box);
1120
1121   # If there's no title, the y-tics will be part off-screen.  Half of the x-tic height should be more than sufficient.
1122   my @y_tic_tops = ($chart_box->[0], $chart_box->[1], $chart_box->[2], $chart_box->[1] + int($tic_height / 2));
1123   $self->_remove_box($chart_box, \@y_tic_tops);
1124
1125   # Make sure that the first and last label fit
1126   if (my $labels = $self->_get_labels($opts)) {
1127     if (my @box = $self->_text_bbox($labels->[0], 'legend')) {
1128       my @remove_box = ($chart_box->[0],
1129                         $chart_box->[1],
1130                         $chart_box->[0] + int($box[2] / 2) + 1,
1131                         $chart_box->[3]
1132                         );
1133
1134       $self->_remove_box($chart_box, \@remove_box);
1135     }
1136     if (my @box = $self->_text_bbox($labels->[-1], 'legend')) {
1137       my @remove_box = ($chart_box->[2] - int($box[2] / 2) - 1,
1138                         $chart_box->[1],
1139                         $chart_box->[2],
1140                         $chart_box->[3]
1141                         );
1142
1143       $self->_remove_box($chart_box, \@remove_box);
1144     }
1145   }
1146 }
1147
1148 sub _get_y_tic_width {
1149   my $self = shift;
1150   my $min = $self->_get_min_value();
1151   my $max = $self->_get_max_value();
1152   my $tic_count = $self->_get_y_tics();
1153
1154   my $interval = ($max - $min) / ($tic_count - 1);
1155
1156   my %text_info = $self->_text_style('legend')
1157     or return;
1158
1159   my $max_width = 0;
1160   for my $count (0 .. $tic_count - 1) {
1161     my $value = ($count*$interval)+$min;
1162
1163     if ($interval < 1 || ($value != int($value))) {
1164       $value = sprintf("%.2f", $value);
1165     }
1166     my @box = $self->_text_bbox($value, 'legend');
1167     my $width = $box[2] - $box[0];
1168
1169     # For the tic width
1170     $width += 10;
1171     if ($width > $max_width) {
1172       $max_width = $width;
1173     }
1174   }
1175
1176   return $max_width;
1177 }
1178
1179 sub _get_x_tic_height {
1180   my ($self, $opts) = @_;
1181
1182   my $labels = $self->_get_labels($opts);
1183
1184   if (!$labels) {
1185         return;
1186   }
1187
1188   my $tic_count = (scalar @$labels) - 1;
1189
1190   my %text_info = $self->_text_style('legend')
1191     or return;
1192
1193   my $max_height = 0;
1194   for my $count (0 .. $tic_count) {
1195     my $label = $labels->[$count];
1196
1197     my @box = $self->_text_bbox($label, 'legend');
1198
1199     my $height = $box[3] - $box[1];
1200
1201     # Padding + the tic
1202     $height += 10;
1203     if ($height > $max_height) {
1204       $max_height = $height;
1205     }
1206   }
1207
1208   return $max_height;
1209 }
1210
1211 sub _draw_y_tics {
1212   my $self = shift;
1213   my $min = $self->_get_min_value();
1214   my $max = $self->_get_max_value();
1215   my $tic_count = $self->_get_y_tics();
1216
1217   my $img = $self->_get_image();
1218   my $graph_box = $self->_get_graph_box();
1219   my $image_box = $self->_get_image_box();
1220
1221   my $interval = ($max - $min) / ($tic_count - 1);
1222
1223   my %text_info = $self->_text_style('legend')
1224     or return;
1225
1226   my $line_style = $self->_get_color('outline.line');
1227   my $show_gridlines = $self->{_style}{features}{'horizontal_gridlines'};
1228   my @grid_line = $self->_get_line("hgrid");
1229   my $tic_distance = ($graph_box->[3] - $graph_box->[1]) / ($tic_count - 1);
1230   for my $count (0 .. $tic_count - 1) {
1231     my $x1 = $graph_box->[0] - 5;
1232     my $x2 = $graph_box->[0] + 5;
1233     my $y1 = int($graph_box->[3] - ($count * $tic_distance));
1234
1235     my $value = ($count*$interval)+$min;
1236     if ($interval < 1 || ($value != int($value))) {
1237         $value = sprintf("%.2f", $value);
1238     }
1239
1240     my @box = $self->_text_bbox($value, 'legend')
1241       or return;
1242
1243     $img->line(x1 => $x1, x2 => $x2, y1 => $y1, y2 => $y1, aa => 1, color => $line_style);
1244
1245     my $width = $box[2];
1246     my $height = $box[3];
1247
1248     $img->string(%text_info,
1249                  x    => ($x1 - $width - 3),
1250                  y    => ($y1 + ($height / 2)),
1251                  text => $value
1252                 );
1253
1254     if ($show_gridlines && $y1 != $graph_box->[1] && $y1 != $graph_box->[3]) {
1255       $self->_line(x1 => $graph_box->[0], y1 => $y1,
1256                    x2 => $graph_box->[2], y2 => $y1,
1257                    img => $img,
1258                    @grid_line);
1259     }
1260   }
1261
1262 }
1263
1264 sub _draw_x_tics {
1265   my ($self, $opts) = @_;
1266
1267   my $img = $self->_get_image();
1268   my $graph_box = $self->_get_graph_box();
1269   my $image_box = $self->_get_image_box();
1270
1271   my $labels = $self->_get_labels($opts);
1272
1273   my $tic_count = (scalar @$labels) - 1;
1274
1275   my $has_columns = (defined $self->_get_data_series()->{'column'} || defined $self->_get_data_series()->{'stacked_column'});
1276
1277   # If we have columns, we want the x-ticks to show up in the middle of the column, not on the left edge
1278   my $denominator = $tic_count;
1279   if ($has_columns) {
1280     $denominator ++;
1281   }
1282   my $tic_distance = ($graph_box->[2] - $graph_box->[0]) / ($denominator);
1283   my %text_info = $self->_text_style('legend')
1284     or return;
1285
1286   # If automatic axis is turned on, let's be selective about what labels we draw.
1287   my $max_size = 0;
1288   my $tic_skip = 0;
1289   if ($self->_get_number('automatic_axis')) {
1290     foreach my $label (@$labels) {
1291       my @box = $self->_text_bbox($label, 'legend');
1292       if ($box[2] > $max_size) {
1293         $max_size = $box[2];
1294       }
1295     }
1296
1297     # Give the max_size some padding...
1298     $max_size *= 1.2;
1299
1300     $tic_skip = int($max_size / $tic_distance) + 1;
1301   }
1302
1303   my $line_style = $self->_get_color('outline.line');
1304
1305   for my $count (0 .. $tic_count) {
1306     next if ($count % ($tic_skip + 1));
1307     my $label = $labels->[$count];
1308     my $x1 = $graph_box->[0] + ($tic_distance * $count);
1309
1310     if ($has_columns) {
1311       $x1 += $tic_distance / 2;
1312     }
1313
1314     $x1 = int($x1);
1315
1316     my $y1 = $graph_box->[3] + 5;
1317     my $y2 = $graph_box->[3] - 5;
1318
1319     $img->line(x1 => $x1, x2 => $x1, y1 => $y1, y2 => $y2, aa => 1, color => $line_style);
1320
1321     my @box = $self->_text_bbox($label, 'legend')
1322       or return;
1323
1324     my $width = $box[2];
1325     my $height = $box[3];
1326
1327     $img->string(%text_info,
1328                  x    => ($x1 - ($width / 2)),
1329                  y    => ($y1 + ($height + 5)),
1330                  text => $label
1331                 );
1332
1333   }
1334 }
1335
1336 sub _valid_input {
1337   my $self = shift;
1338
1339   if (!defined $self->_get_data_series() || !keys %{$self->_get_data_series()}) {
1340     return $self->_error("No data supplied");
1341   }
1342
1343   my $data = $self->_get_data_series();
1344   if (defined $data->{'line'} && !scalar @{$data->{'line'}->[0]->{'data'}}) {
1345     return $self->_error("No values in data series");
1346   }
1347   if (defined $data->{'column'} && !scalar @{$data->{'column'}->[0]->{'data'}}) {
1348     return $self->_error("No values in data series");
1349   }
1350   if (defined $data->{'stacked_column'} && !scalar @{$data->{'stacked_column'}->[0]->{'data'}}) {
1351     return $self->_error("No values in data series");
1352   }
1353
1354   return 1;
1355 }
1356
1357 sub _set_column_count   { $_[0]->{'column_count'} = $_[1]; }
1358 sub _set_min_value      { $_[0]->{'min_value'} = $_[1]; }
1359 sub _set_max_value      { $_[0]->{'max_value'} = $_[1]; }
1360 sub _set_image_box      { $_[0]->{'image_box'} = $_[1]; }
1361 sub _set_graph_box      { $_[0]->{'graph_box'} = $_[1]; }
1362 sub _set_series_counter { $_[0]->{'series_counter'} = $_[1]; }
1363 sub _get_column_count   { return $_[0]->{'column_count'} }
1364 sub _get_min_value      { return $_[0]->{'min_value'} }
1365 sub _get_max_value      { return $_[0]->{'max_value'} }
1366 sub _get_image_box      { return $_[0]->{'image_box'} }
1367 sub _get_graph_box      { return $_[0]->{'graph_box'} }
1368 sub _reset_series_counter { $_[0]->{series_counter} = 0 }
1369 sub _get_series_counter { return $_[0]->{'series_counter'} }
1370
1371 sub _style_defs {
1372   my ($self) = @_;
1373
1374   my %work = %{$self->SUPER::_style_defs()};
1375   $work{area} =
1376     {
1377      opacity => 0.5,
1378     };
1379   push @{$work{features}}, qw/graph_outline graph_fill/;
1380   $work{hgrid} =
1381     {
1382      color => "lookup(fg)",
1383      style => "solid",
1384     };
1385
1386   return \%work;
1387 }
1388
1389 sub _composite {
1390   my ($self) = @_;
1391   return ( $self->SUPER::_composite(), "graph", "hgrid" );
1392 }
1393
1394 1;