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