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