File Coverage

blib/lib/Imager/Graph/Horizontal.pm
Criterion Covered Total %
statement 372 458 81.2
branch 84 142 59.1
condition 20 59 33.9
subroutine 39 47 82.9
pod 11 11 100.0
total 526 717 73.3


line stmt bran cond sub pod time code
1             package Imager::Graph::Horizontal;
2              
3             =head1 NAME
4              
5             Imager::Graph::Horizontal - A super class for line/bar charts
6              
7             =head1 DESCRIPTION
8              
9             This is a base class that implements base functionality for line and
10             bar charts.
11              
12             The sub-classes, Imager::Graph::Bar and Imager::Graph::Line simply
13             provide default data series types.
14              
15             =cut
16              
17 3     3   13 use strict;
  3         2  
  3         113  
18 3     3   13 use vars qw(@ISA);
  3         5  
  3         124  
19 3     3   2123 use Imager::Graph;
  3         9  
  3         203  
20             @ISA = qw(Imager::Graph);
21              
22 3     3   25 use constant STARTING_MIN_VALUE => 99999;
  3         2  
  3         13914  
23              
24             our $VERSION = "0.11";
25              
26             =head1 METHODS
27              
28             =over
29              
30             =item add_data_series(\@data, $series_name)
31              
32             Add a data series to the graph, of the default type.
33              
34             =cut
35              
36             sub add_data_series {
37 4     4 1 2740 my $self = shift;
38 4         9 my $data_ref = shift;
39 4         12 my $series_name = shift;
40              
41 4         18 my $series_type = $self->_get_default_series_type();
42 4         27 $self->_add_data_series($series_type, $data_ref, $series_name);
43              
44 4         9 return;
45             }
46              
47             =item add_bar_data_series(\@data, $series_name)
48              
49             Add a bar data series to the graph.
50              
51             =cut
52              
53             sub add_bar_data_series {
54 1     1 1 349 my $self = shift;
55 1         2 my $data_ref = shift;
56 1         1 my $series_name = shift;
57              
58 1         4 $self->_add_data_series('bar', $data_ref, $series_name);
59              
60 1         2 return;
61             }
62              
63             =item add_line_data_series(\@data, $series_name)
64              
65             Add a line data series to the graph.
66              
67             =cut
68              
69             sub add_line_data_series {
70 1     1 1 500 my $self = shift;
71 1         3 my $data_ref = shift;
72 1         2 my $series_name = shift;
73              
74 1         7 $self->_add_data_series('line', $data_ref, $series_name);
75              
76 1         1 return;
77             }
78              
79             =item set_column_padding($int)
80              
81             Sets the number of pixels that should go between columns of data.
82              
83             =cut
84              
85             sub set_column_padding {
86 0     0 1 0 $_[0]->{'custom_style'}->{'column_padding'} = $_[1];
87             }
88              
89             =item set_negative_background($color)
90              
91             Sets the background color or fill used below the y axis.
92              
93             =cut
94              
95             sub set_negative_background {
96 1     1 1 140 $_[0]->{'custom_style'}->{'negative_bg'} = $_[1];
97             }
98              
99             =item draw()
100              
101             Draw the graph
102              
103             =cut
104              
105             sub draw {
106 6     6 1 46 my ($self, %opts) = @_;
107              
108 6 50       31 if (!$self->_valid_input()) {
109 0         0 return;
110             }
111              
112 6         34 $self->_style_setup(\%opts);
113              
114 6         15 my $style = $self->{_style};
115              
116 6 50       43 $self->_make_img
117             or return;
118              
119 6 50       74 my $img = $self->_get_image()
120             or return;
121              
122 6         39 my @image_box = ( 0, 0, $img->getwidth-1, $img->getheight-1 );
123 6         273 $self->_set_image_box(\@image_box);
124              
125 6         128 my @chart_box = ( 0, 0, $img->getwidth-1, $img->getheight-1 );
126 6         130 $self->_draw_legend(\@chart_box);
127 6 50       29 if ($style->{title}{text}) {
128 0 0       0 $self->_draw_title($img, \@chart_box)
129             or return;
130             }
131              
132             # Scale the graph box down to the widest graph that can cleanly hold the # of columns.
133 6 50       38 return unless $self->_get_data_range();
134 6         42 $self->_remove_tics_from_chart_box(\@chart_box, \%opts);
135 6         33 my $column_count = $self->_get_column_count();
136              
137 6         18 my $width = $self->_get_number('width');
138 6         19 my $height = $self->_get_number('height');
139              
140 6         13 my $graph_width = $chart_box[2] - $chart_box[0];
141 6         10 my $graph_height = $chart_box[3] - $chart_box[1];
142              
143 6         15 my $col_height = ($graph_height - 1) / $column_count;
144 6 100       15 if ($col_height > 1) {
145 5         10 $graph_height = int($col_height) * $column_count + 1;
146             }
147             else {
148 1         2 $graph_height = $col_height * $column_count + 1;
149             }
150              
151 6         18 my $tic_count = $self->_get_x_tics();
152 6         18 my $tic_distance = int(($graph_width -1) / ($tic_count - 1));
153 6         10 $graph_width = $tic_distance * ($tic_count - 1);
154              
155 6         8 my $top = $chart_box[1];
156 6         7 my $left = $chart_box[0];
157              
158 6         13 $self->{'_style'}{'graph_width'} = $graph_width;
159 6         14 $self->{'_style'}{'graph_height'} = $graph_height;
160              
161 6         14 my @graph_box = ($left, $top, $left + $graph_width, $top + $graph_height);
162              
163 6         32 $self->_set_graph_box(\@graph_box);
164              
165 6         12 my @fill_box = @graph_box;
166              
167 6 50       37 if ($self->_feature_enabled("graph_outline")) {
168 6 50       40 my @line = $self->_get_line("graph.outline")
169             or return;
170              
171 6         38 $self->_box(
172             @line,
173             box => \@fill_box,
174             img => $img,
175             );
176 6         591 ++$fill_box[0];
177 6         9 ++$fill_box[1];
178 6         8 --$fill_box[2];
179 6         28 --$fill_box[3];
180             }
181              
182             {
183 6 50       9 my @back_fill = $self->_get_fill("graph.fill", \@fill_box)
  6         26  
184             or return;
185 6         131 $img->box(
186             @back_fill,
187             box => \@fill_box,
188             );
189             }
190              
191 6         3215 my $min_value = $self->_get_min_value();
192 6         14 my $max_value = $self->_get_max_value();
193 6         12 my $value_range = $max_value - $min_value;
194              
195 6         6 my $zero_position;
196 6 50       19 if ($value_range) {
197 6         22 $zero_position = $left + (-1*$min_value / $value_range) * ($graph_width-1);
198             }
199              
200 6 100       27 if ($min_value < 0) {
201 2         7 my @neg_box = ( $left+1, $top+1, $zero_position, $top+$graph_height - 1 );
202 2 50       6 my @neg_fill = $self->_get_fill('negative_bg', \@neg_box)
203             or return;
204              
205 2         20 $img->box(
206             @neg_fill,
207             box => \@neg_box,
208             );
209 2         976 $img->line(
210             x1 => $zero_position,
211             y1 => $top,
212             x2 => $zero_position,
213             y2 => $top + $graph_height,
214             color => $self->_get_color('outline.line'),
215             );
216             }
217              
218 6         185 $self->_reset_series_counter();
219              
220 6 100       22 if ($self->_get_data_series()->{'bar'}) {
221 5         19 $self->_draw_bars();
222             }
223 6 100       59 if ($self->_get_data_series()->{'line'}) {
224 1         8 $self->_draw_lines();
225             }
226              
227 6 50       22 if ($self->_get_x_tics()) {
228 0         0 $self->_draw_x_tics();
229             }
230 6 100       27 if ($self->_get_labels(\%opts)) {
231 5         23 $self->_draw_y_tics(\%opts);
232             }
233              
234 6         454 return $self->_get_image();
235             }
236              
237             sub _get_data_range {
238 6     6   11 my $self = shift;
239              
240 6         10 my $max_value = 0;
241 6         11 my $min_value = 0;
242 6         10 my $column_count = 0;
243              
244 6         34 my ($b_min, $b_max, $b_cols) = $self->_get_bar_range();
245 6         42 my ($l_min, $l_max, $l_cols) = $self->_get_line_range();
246              
247 6         35 $min_value = $self->_min(STARTING_MIN_VALUE, $b_min, $l_min);
248 6         44 $max_value = $self->_max(0, $b_max, $l_max);
249 6         27 $column_count = $self->_max(0, $b_cols, $l_cols);
250              
251 6         26 my $config_min = $self->_get_number('x_min');
252 6         20 my $config_max = $self->_get_number('x_max');
253              
254 6 50 33     23 if (defined $config_max && $config_max < $max_value) {
255 0         0 $config_max = undef;
256             }
257 6 50 33     21 if (defined $config_min && $config_min > $min_value) {
258 0         0 $config_min = undef;
259             }
260              
261 6         17 my $range_padding = $self->_get_number('range_padding');
262 6 50       22 if (defined $config_min) {
263 0         0 $min_value = $config_min;
264             }
265             else {
266 6 100       23 if ($min_value > 0) {
267 4         8 $min_value = 0;
268             }
269 6 50 33     28 if ($range_padding && $min_value < 0) {
270 0         0 my $difference = $min_value * $range_padding / 100;
271 0 0 0     0 if ($min_value < -1 && $difference > -1) {
272 0         0 $difference = -1;
273             }
274 0         0 $min_value += $difference;
275             }
276             }
277 6 50       15 if (defined $config_max) {
278 0         0 $max_value = $config_max;
279             }
280             else {
281 6 50 33     24 if ($range_padding && $max_value > 0) {
282 0         0 my $difference = $max_value * $range_padding / 100;
283 0 0 0     0 if ($max_value > 1 && $difference < 1) {
284 0         0 $difference = 1;
285             }
286 0         0 $max_value += $difference;
287             }
288             }
289              
290 6 50       20 if ($self->_get_number('automatic_axis')) {
291             # In case this was set via a style, and not by the api method
292 0         0 eval { require Chart::Math::Axis; };
  0         0  
293 0 0       0 if ($@) {
294 0         0 return $self->_error("Can't use automatic_axis - $@");
295             }
296              
297 0         0 my $axis = Chart::Math::Axis->new();
298 0         0 $axis->include_zero();
299 0         0 $axis->add_data($min_value, $max_value);
300 0         0 $max_value = $axis->top;
301 0         0 $min_value = $axis->bottom;
302 0         0 my $ticks = $axis->ticks;
303             # The +1 is there because we have the bottom tick as well
304 0         0 $self->set_x_tics($ticks+1);
305             }
306              
307 6         34 $self->_set_max_value($max_value);
308 6         29 $self->_set_min_value($min_value);
309 6         34 $self->_set_column_count($column_count);
310              
311 6         34 return 1;
312             }
313              
314             sub _min {
315 6     6   9 my $self = shift;
316 6         10 my $min = shift;
317              
318 6         16 foreach my $value (@_) {
319 12 100       31 next unless defined $value;
320 6 50       19 if ($value < $min) { $min = $value; }
  6         11  
321             }
322 6         14 return $min;
323             }
324              
325             sub _max {
326 12     12   14 my $self = shift;
327 12         17 my $min = shift;
328              
329 12         16 foreach my $value (@_) {
330 24 100       45 next unless defined $value;
331 18 100       39 if ($value > $min) { $min = $value; }
  12         18  
332             }
333 12         19 return $min;
334             }
335              
336             sub _get_line_range {
337 6     6   11 my $self = shift;
338 6         18 my $series = $self->_get_data_series()->{'line'};
339 6 100       26 return (undef, undef, 0) unless $series;
340              
341 1         1 my $max_value = 0;
342 1         2 my $min_value = STARTING_MIN_VALUE;
343 1         1 my $column_count = 0;
344              
345 1         2 my @series = @{$series};
  1         2  
346 1         2 foreach my $series (@series) {
347 1         2 my @data = @{$series->{'data'}};
  1         5  
348              
349 1 50       4 if (scalar @data > $column_count) {
350 1         1 $column_count = scalar @data;
351             }
352              
353 1         2 foreach my $value (@data) {
354 7 100       11 if ($value > $max_value) { $max_value = $value; }
  2         2  
355 7 100       13 if ($value < $min_value) { $min_value = $value; }
  6         10  
356             }
357             }
358              
359 1         3 return ($min_value, $max_value, $column_count);
360             }
361              
362              
363              
364             sub _get_bar_range {
365 6     6   14 my $self = shift;
366              
367 6         21 my $series = $self->_get_data_series()->{'bar'};
368 6 100       21 return (undef, undef, 0) unless $series;
369              
370 5         7 my $max_value = 0;
371 5         7 my $min_value = STARTING_MIN_VALUE;
372 5         6 my $column_count = 0;
373              
374 5         8 my @series = @{$series};
  5         13  
375 5         13 foreach my $series (@series) {
376 5         8 my @data = @{$series->{'data'}};
  5         95  
377              
378 5         11 foreach my $value (@data) {
379 1030         551 $column_count++;
380 1030 100       1143 if ($value > $max_value) { $max_value = $value; }
  1008         699  
381 1030 100       1230 if ($value < $min_value) { $min_value = $value; }
  27         41  
382             }
383             }
384              
385 5         19 return ($min_value, $max_value, $column_count);
386             }
387              
388              
389             sub _draw_legend {
390 6     6   10 my $self = shift;
391 6         8 my $chart_box = shift;
392 6         18 my $style = $self->{'_style'};
393              
394 6         6 my @labels;
395 6         20 my $img = $self->_get_image();
396 6 100       28 if (my $series = $self->_get_data_series()->{'bar'}) {
397 5         13 push @labels, map { $_->{'series_name'} } @$series;
  5         19  
398             }
399              
400 6 0 50     32 if ($style->{features}{legend} && (scalar @labels)) {
401 0 0       0 $self->SUPER::_draw_legend($self->_get_image(), \@labels, $chart_box)
402             or return;
403             }
404 6         12 return;
405             }
406              
407             sub _draw_flat_legend {
408 0     0   0 return 1;
409             }
410              
411             sub _draw_lines {
412 1     1   3 my $self = shift;
413 1         3 my $style = $self->{'_style'};
414              
415 1         4 my $img = $self->_get_image();
416              
417 1         3 my $max_value = $self->_get_max_value();
418 1         3 my $min_value = $self->_get_min_value();
419 1         3 my $column_count = $self->_get_column_count();
420              
421 1         2 my $value_range = $max_value - $min_value;
422              
423 1         5 my $width = $self->_get_number('width');
424 1         4 my $height = $self->_get_number('height');
425              
426 1         4 my $graph_width = $self->_get_number('graph_width');
427 1         4 my $graph_height = $self->_get_number('graph_height');
428              
429 1         5 my $line_series = $self->_get_data_series()->{'line'};
430 1   50     8 my $series_counter = $self->_get_series_counter() || 0;
431              
432 1 50 33     3 my $has_columns = (defined $self->_get_data_series()->{'column'} || $self->_get_data_series->{'stacked_column'}) ? 1 : 0;
433              
434 1         4 my $col_height = int($graph_height / $column_count) -1;
435              
436 1         5 my $graph_box = $self->_get_graph_box();
437 1         2 my $left = $graph_box->[0] + 1;
438 1         2 my $bottom = $graph_box->[1];
439              
440 1         3 my $zero_position = $left + $graph_width - (-1*$min_value / $value_range) * ($graph_width - 1);
441              
442 1         3 my $line_aa = $self->_get_number("lineaa");
443 1         3 foreach my $series (@$line_series) {
444 1         2 my @data = @{$series->{'data'}};
  1         4  
445 1         1 my $data_size = scalar @data;
446              
447 1         2 my $interval;
448 1 50       3 if ($has_columns) {
449 0         0 $interval = $graph_height / ($data_size);
450             }
451             else {
452 1         2 $interval = $graph_height / ($data_size - 1);
453             }
454 1         8 my $color = $self->_data_color($series_counter);
455              
456             # We need to add these last, otherwise the next line segment will overwrite half of the marker
457 1         2 my @marker_positions;
458 1         4 for (my $i = 0; $i < $data_size - 1; $i++) {
459 6         416 my $y1 = $bottom + $i * $interval;
460 6         8 my $y2 = $bottom + ($i + 1) * $interval;
461              
462 6         11 $y1 += $has_columns * $interval / 2;
463 6         6 $y2 += $has_columns * $interval / 2;
464              
465 6         10 my $x1 = $left + ($value_range - $data[$i] + $min_value)/$value_range * $graph_width;
466 6         14 my $x2 = $left + ($value_range - $data[$i + 1] + $min_value)/$value_range * $graph_width;
467              
468 6         19 push @marker_positions, [$x1, $y1];
469 6 50       19 $img->line(x1 => $x1, y1 => $y1, x2 => $x2, y2 => $y2, aa => $line_aa, color => $color) || die $img->errstr;
470             }
471              
472              
473 1         69 my $y2 = $bottom + ($data_size - 1) * $interval;
474 1         3 $y2 += $has_columns * $interval / 2;
475              
476 1         4 my $x2 = $left + ($value_range - $data[$data_size - 1] + $min_value)/$value_range * $graph_width;
477              
478 1 50       15 if ($self->_feature_enabled("linemarkers")) {
479 1         54 push @marker_positions, [$x2, $y2];
480 1         3 foreach my $position (@marker_positions) {
481 7         1137 $self->_draw_line_marker($position->[0], $position->[1], $series_counter);
482             }
483             }
484 1         186 $series_counter++;
485             }
486              
487 1         11 $self->_set_series_counter($series_counter);
488 1         3 return;
489             }
490              
491             sub _draw_bars {
492 5     5   8 my $self = shift;
493 5         9 my $style = $self->{'_style'};
494              
495 5         16 my $img = $self->_get_image();
496              
497 5         16 my $max_value = $self->_get_max_value();
498 5         10 my $min_value = $self->_get_min_value();
499 5         13 my $column_count = $self->_get_column_count();
500              
501 5         8 my $value_range = $max_value - $min_value;
502              
503 5         16 my $width = $self->_get_number('width');
504 5         17 my $height = $self->_get_number('height');
505              
506 5         15 my $graph_width = $self->_get_number('graph_width');
507 5         15 my $graph_height = $self->_get_number('graph_height');
508              
509              
510 5         104 my $graph_box = $self->_get_graph_box();
511 5         12 my $bottom = $graph_box->[1] + 1;
512 5         9 my $left = $graph_box->[0];
513              
514 5         16 my $zero_position = int($left + (-1*$min_value / $value_range) * ($graph_width-1));
515              
516 5         9 my $bar_height = $graph_height / $column_count;
517              
518 5         6 my $outline_color;
519 5 50       17 if ($style->{'features'}{'outline'}) {
520 0         0 $outline_color = $self->_get_color('outline.line');
521             }
522              
523 5   50     22 my $series_counter = $self->_get_series_counter() || 0;
524 5         16 my $col_series = $self->_get_data_series()->{'bar'};
525 5   50     14 my $column_padding = $self->_get_number('column_padding') || 0;
526              
527             # 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.
528 5         7 my $column_series = 0;
529              
530 5         17 for (my $series_pos = 0; $series_pos < scalar @$col_series; $series_pos++) {
531 5         15 my $series = $col_series->[$series_pos];
532 5         7 my @data = @{$series->{'data'}};
  5         91  
533 5         8 my $data_size = scalar @data;
534 5         18 for (my $i = 0; $i < $data_size; $i++) {
535              
536 1030         1628 my $part1 = $bar_height * (scalar @$col_series * $i);
537 1030         947 my $part2 = ($series_pos) * $bar_height;
538 1030         1454 my $y1 = int($bottom + $part1 + $part2);
539              
540 1030         1215 my $y2 = int($y1 + $bar_height - $column_padding)-1;
541             # Special case for when bar_height is less than 1.
542 1030 100       1375 if ($y2 < $y1) {
543 1000         897 $y2 = $y1;
544             }
545              
546 1030         1535 my $x1 = int($left - ($min_value - $data[$i]) / $value_range * $graph_width);
547              
548 1030         2338 my $color = $self->_data_color($series_counter);
549              
550 1030 100       1690 if ($data[$i] > 0) {
    50          
551 1028         3177 my @fill = $self->_data_fill($series_counter, [$zero_position+1, $y1, $x1, $y2]);
552 1028         3677 $img->box(xmax => $x1, xmin => $zero_position+1, ymin => $y1, ymax => $y2, @fill);
553 1028 50       153670 if ($style->{'features'}{'outline'}) {
554 0         0 $img->box(xmax => $x1, xmin => $zero_position, ymin => $y1, ymax => $y2, color => $outline_color);
555             }
556             }
557             elsif ($data[$i] == 0) {
558             }
559             else {
560 2         10 my @fill = $self->_data_fill($series_counter, [$x1, $y1, $zero_position, $y2]);
561 2         12 $img->box(xmax => $zero_position , xmin => $x1, ymin => $y1, ymax => $y2, @fill);
562 2 50       448 if ($style->{'features'}{'outline'}) {
563 0         0 $img->box(xmax => $zero_position, xmin => $x1, ymin => $y1, ymax => $y2, color => $outline_color);
564             }
565             }
566             }
567              
568 5         9 $series_counter++;
569 5         40 $column_series++;
570             }
571 5         31 $self->_set_series_counter($series_counter);
572 5         14 return;
573             }
574              
575             sub _add_data_series {
576 6     6   32 my $self = shift;
577 6         49 my $series_type = shift;
578 6         11 my $data_ref = shift;
579 6         28 my $series_name = shift;
580              
581 6   50     46 my $graph_data = $self->{'graph_data'} || {};
582              
583 6   50     44 my $series = $graph_data->{$series_type} || [];
584              
585 6         35 push @$series, { data => $data_ref, series_name => $series_name };
586              
587 6         16 $graph_data->{$series_type} = $series;
588              
589 6         14 $self->{'graph_data'} = $graph_data;
590 6         11 return;
591             }
592              
593             =item show_vertical_gridlines()
594              
595             Shows vertical gridlines at the y-tics.
596              
597             Feature: vertical_gridlines
598              
599             =cut
600              
601             sub show_vertical_gridlines {
602 0     0 1 0 $_[0]->{'custom_style'}{features}{'vertical_gridlines'} = 1;
603             }
604              
605             =item set_vertical_gridline_style(color => ..., style => ...)
606              
607             Set the color and style of the lines drawn for gridlines.
608              
609             Style equivalent: vgrid
610              
611             =cut
612              
613             sub set_vertical_gridline_style {
614 0     0 1 0 my ($self, %opts) = @_;
615              
616 0   0     0 $self->{custom_style}{vgrid} ||= {};
617 0         0 @{$self->{custom_style}{vgrid}}{keys %opts} = values %opts;
  0         0  
618              
619 0         0 return 1;
620             }
621              
622             =item show_line_markers()
623              
624             =item show_line_markers($value)
625              
626             Feature: linemarkers.
627              
628             If $value is missing or true, draw markers on a line data series.
629              
630             Note: line markers are drawn by default.
631              
632             =cut
633              
634             sub show_line_markers {
635 0     0 1 0 my ($self, $value) = @_;
636              
637 0 0       0 @_ > 1 or $value = 1;
638              
639 0         0 $self->{custom_style}{features}{linemarkers} = $value;
640              
641 0         0 return 1;
642             }
643              
644             =item use_automatic_axis()
645              
646             Automatically scale the Y axis, based on L. If Chart::Math::Axis isn't installed, this sets an error and returns undef. Returns 1 if it is installed.
647              
648             =cut
649              
650             sub use_automatic_axis {
651 0     0 1 0 eval { require Chart::Math::Axis; };
  0         0  
652 0 0       0 if ($@) {
653 0         0 return $_[0]->_error("use_automatic_axis - $@\nCalled from ".join(' ', caller)."\n");
654             }
655 0         0 $_[0]->{'custom_style'}->{'automatic_axis'} = 1;
656 0         0 return 1;
657             }
658              
659              
660             =item set_x_tics($count)
661              
662             Set the number of X tics to use. Their value and position will be determined by the data range.
663              
664             =cut
665              
666             sub set_x_tics {
667 0     0 1 0 $_[0]->{'x_tics'} = $_[1];
668             }
669              
670             sub _get_x_tics {
671 18   50 18   103 return $_[0]->{'x_tics'} || 0;
672             }
673              
674             sub _remove_tics_from_chart_box {
675 6     6   14 my ($self, $chart_box, $opts) = @_;
676              
677             # XXX - bad default
678 6   100     29 my $tic_width = $self->_get_y_tic_width($opts) || 10;
679 6         24 my @y_tic_box = ($chart_box->[0], $chart_box->[1], $chart_box->[0] + $tic_width, $chart_box->[3]);
680              
681             # XXX - bad default
682 6   50     34 my $tic_height = $self->_get_x_tic_height() || 10;
683 6         21 my @x_tic_box = ($chart_box->[0], $chart_box->[3] - $tic_height, $chart_box->[2], $chart_box->[3]);
684              
685 6         44 $self->_remove_box($chart_box, \@y_tic_box);
686 6         16 $self->_remove_box($chart_box, \@x_tic_box);
687              
688             # If there's no title, the y-tics will be part off-screen. Half of the x-tic height should be more than sufficient.
689 6         24 my @y_tic_tops = ($chart_box->[0], $chart_box->[1], $chart_box->[2], $chart_box->[1] + int($tic_height / 2));
690 6         24 $self->_remove_box($chart_box, \@y_tic_tops);
691              
692 6 100       14 if (my @box = $self->_text_bbox($self->_get_max_value(), 'legend')) {
693 4         20 my @remove_box = ($chart_box->[2] - int($box[2] / 2) - 1,
694             $chart_box->[1],
695             $chart_box->[2],
696             $chart_box->[3]
697             );
698              
699 4         11 $self->_remove_box($chart_box, \@remove_box);
700             }
701              
702              
703             }
704              
705             sub _get_y_tic_width {
706 6     6   9 my ($self, $opts) = @_;
707              
708 6         35 my $labels = $self->_get_labels($opts);
709              
710 6 100       15 if (!$labels) {
711 1         7 return;
712             }
713              
714 5 100       25 my %text_info = $self->_text_style('legend')
715             or return;
716              
717 4         8 my $max_width = 0;
718 4         11 foreach my $label (@$labels) {
719 30         74 my @box = $self->_text_bbox($label, 'legend');
720 30         39 my $width = $box[2] + 5;
721             # For the tic itself...
722 30         22 $width += 10;
723 30 100       69 if ($width > $max_width) {
724 8         15 $max_width = $width;
725             }
726             }
727 4         26 return $max_width;
728             }
729              
730             sub _get_x_tic_height {
731 6     6   10 my $self = shift;
732              
733 6         25 my $min = $self->_get_min_value();
734 6         24 my $max = $self->_get_max_value();
735 6         29 my $tic_count = $self->_get_x_tics();
736              
737 6         16 my $interval = ($max - $min) / ($tic_count - 1);
738              
739 6 100       24 my %text_info = $self->_text_style('legend')
740             or return;
741              
742 4         10 my $max_height = 0;
743 4         12 for my $count (0 .. $tic_count - 1) {
744 0         0 my $value = sprintf("%.2f", ($count*$interval)+$min);
745              
746 0         0 my @box = $self->_text_bbox($value, 'legend');
747 0         0 my $height = $box[3] - $box[1];
748              
749             # For the tic width
750 0         0 $height += 10;
751 0 0       0 if ($height > $max_height) {
752 0         0 $max_height = $height;
753             }
754             }
755              
756              
757 4         33 return $max_height;
758             }
759              
760             sub _draw_y_tics {
761 5     5   7 my ($self, $opts) = @_;
762              
763 5         15 my $img = $self->_get_image();
764 5         16 my $graph_box = $self->_get_graph_box();
765 5         21 my $image_box = $self->_get_image_box();
766              
767 5         16 my $labels = $self->_get_labels($opts);
768              
769 5         11 my $tic_count = (scalar @$labels) - 1;
770              
771 5         12 my $has_columns = defined $self->_get_data_series()->{'bar'};
772              
773             # If we have columns, we want the x-ticks to show up in the middle of the column, not on the left edge
774 5         6 my $denominator = $tic_count;
775 5 100       12 if ($has_columns) {
776 4         4 $denominator ++;
777             }
778 5         14 my $tic_distance = ($graph_box->[3] - $graph_box->[1]) / ($denominator);
779 5 100       17 my %text_info = $self->_text_style('legend')
780             or return;
781              
782 4         15 for my $count (0 .. $tic_count) {
783 30         3397 my $label = $labels->[$count];
784              
785 30         41 my $x1 = $graph_box->[0] - 5;
786 30         34 my $x2 = $graph_box->[0] + 5;
787              
788 30         53 my $y1 = $graph_box->[1] + ($tic_distance * $count);
789              
790 30 50       50 if ($has_columns) {
791 30         38 $y1 += $tic_distance / 2;
792             }
793              
794 30         80 $img->line(x1 => $x1, x2 => $x2, y1 => $y1, y2 => $y1, aa => 1, color => '000000');
795              
796 30 50       1995 my @box = $self->_text_bbox($label, 'legend')
797             or return;
798              
799 30         35 my $width = $box[2];
800 30         21 my $height = $box[3];
801              
802 30         163 $img->string(%text_info,
803             x => ($x1 - ($width + 5)),
804             y => ($y1 + ($height / 2)),
805             text => $label
806             );
807              
808             }
809              
810             }
811              
812             sub _draw_x_tics {
813 0     0   0 my $self = shift;
814              
815 0         0 my $img = $self->_get_image();
816 0         0 my $graph_box = $self->_get_graph_box();
817 0         0 my $image_box = $self->_get_image_box();
818              
819 0         0 my $tic_count = $self->_get_x_tics();
820 0         0 my $min = $self->_get_min_value();
821 0         0 my $max = $self->_get_max_value();
822 0         0 my $interval = ($max - $min) / ($tic_count - 1);
823              
824             # If we have columns, we want the x-ticks to show up in the middle of the column, not on the left edge
825 0         0 my $tic_distance = ($graph_box->[2] - $graph_box->[0]) / ($tic_count -1);
826              
827 0 0       0 my %text_info = $self->_text_style('legend')
828             or return;
829              
830 0         0 my $show_gridlines = $self->{_style}{features}{'vertical_gridlines'};
831 0         0 my @grid_line = $self->_get_line("vgrid");
832 0         0 for my $count (0 .. $tic_count-1) {
833 0         0 my $x1 = $graph_box->[0] + ($tic_distance * $count);
834              
835 0         0 my $y1 = $graph_box->[3] + 5;
836 0         0 my $y2 = $graph_box->[3] - 5;
837              
838 0         0 my $value = ($count*$interval)+$min;
839              
840 0         0 $img->line(x1 => $x1, x2 => $x1, y1 => $y1, y2 => $y2, aa => 1, color => '000000');
841              
842 0 0       0 my @box = $self->_text_bbox($value, 'legend')
843             or return;
844              
845 0         0 my $width = $box[2];
846 0         0 my $height = $box[3];
847              
848 0         0 $img->string(%text_info,
849             x => ($x1 - ($width / 2)),
850             y => ($y1 + $height + 5),
851             text => $value
852             );
853              
854 0 0 0     0 if ($show_gridlines && $x1 != $graph_box->[0] && $x1 != $graph_box->[2]) {
      0        
855 0         0 $self->_line(x1 => $x1, x2 => $x1,
856             y1 => $graph_box->[1], y2 => $graph_box->[3],
857             img => $img,
858             @grid_line);
859             }
860             }
861             }
862              
863             sub _valid_input {
864 6     6   20 my $self = shift;
865              
866 6 50 33     35 if (!defined $self->_get_data_series() || !keys %{$self->_get_data_series()}) {
  6         16  
867 0         0 return $self->_error("No data supplied");
868             }
869              
870 6         12 my $data = $self->_get_data_series();
871 6 50 66     25 if (defined $data->{'line'} && !scalar @{$data->{'line'}->[0]->{'data'}}) {
  1         5  
872 0         0 return $self->_error("No values in data series");
873             }
874 6 50 33     23 if (defined $data->{'column'} && !scalar @{$data->{'column'}->[0]->{'data'}}) {
  0         0  
875 0         0 return $self->_error("No values in data series");
876             }
877 6 50 33     24 if (defined $data->{'stacked_column'} && !scalar @{$data->{'stacked_column'}->[0]->{'data'}}) {
  0         0  
878 0         0 return $self->_error("No values in data series");
879             }
880              
881 6         23 return 1;
882             }
883              
884 6     6   20 sub _set_column_count { $_[0]->{'column_count'} = $_[1]; }
885 6     6   14 sub _set_min_value { $_[0]->{'min_value'} = $_[1]; }
886 6     6   24 sub _set_max_value { $_[0]->{'max_value'} = $_[1]; }
887 6     6   23 sub _set_image_box { $_[0]->{'image_box'} = $_[1]; }
888 6     6   22 sub _set_graph_box { $_[0]->{'graph_box'} = $_[1]; }
889 6     6   16 sub _set_series_counter { $_[0]->{'series_counter'} = $_[1]; }
890 12     12   28 sub _get_column_count { return $_[0]->{'column_count'} }
891 18     18   42 sub _get_min_value { return $_[0]->{'min_value'} }
892 24     24   68 sub _get_max_value { return $_[0]->{'max_value'} }
893 5     5   12 sub _get_image_box { return $_[0]->{'image_box'} }
894 11     11   28 sub _get_graph_box { return $_[0]->{'graph_box'} }
895 6     6   18 sub _reset_series_counter { $_[0]->{series_counter} = 0 }
896 6     6   35 sub _get_series_counter { return $_[0]->{'series_counter'} }
897              
898             sub _style_defs {
899 6     6   7 my ($self) = @_;
900              
901 6         7 my %work = %{$self->SUPER::_style_defs()};
  6         36  
902 6         17 push @{$work{features}}, qw/graph_outline graph_fill linemarkers/;
  6         21  
903 6         19 $work{vgrid} =
904             {
905             color => "lookup(fg)",
906             style => "solid",
907             };
908              
909 6         15 return \%work;
910             }
911              
912             sub _composite {
913 6     6   46 my ($self) = @_;
914 6         35 return ( $self->SUPER::_composite(), "graph", "vgrid" );
915             }
916              
917             1;
918              
919             =back
920              
921             =head1 AUTHOR
922              
923             Patrick Michaud, Tony Cook
924              
925             =cut