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   12 use strict;
  3         5  
  3         78  
18 3     3   13 use vars qw(@ISA);
  3         3  
  3         82  
19 3     3   2355 use Imager::Graph;
  3         11  
  3         204  
20             @ISA = qw(Imager::Graph);
21              
22 3     3   22 use constant STARTING_MIN_VALUE => 99999;
  3         1460  
  3         19083  
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 2325 my $self = shift;
38 4         10 my $data_ref = shift;
39 4         13 my $series_name = shift;
40              
41 4         23 my $series_type = $self->_get_default_series_type();
42 4         33 $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 403 my $self = shift;
55 1         3 my $data_ref = shift;
56 1         3 my $series_name = shift;
57              
58 1         5 $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 692 my $self = shift;
71 1         13 my $data_ref = shift;
72 1         4 my $series_name = shift;
73              
74 1         14 $self->_add_data_series('line', $data_ref, $series_name);
75              
76 1         2 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 142 $_[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 51 my ($self, %opts) = @_;
107              
108 6 50       35 if (!$self->_valid_input()) {
109 0         0 return;
110             }
111              
112 6         51 $self->_style_setup(\%opts);
113              
114 6         15 my $style = $self->{_style};
115              
116 6 50       49 $self->_make_img
117             or return;
118              
119 6 50       93 my $img = $self->_get_image()
120             or return;
121              
122 6         49 my @image_box = ( 0, 0, $img->getwidth-1, $img->getheight-1 );
123 6         313 $self->_set_image_box(\@image_box);
124              
125 6         116 my @chart_box = ( 0, 0, $img->getwidth-1, $img->getheight-1 );
126 6         158 $self->_draw_legend(\@chart_box);
127 6 50       30 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       41 return unless $self->_get_data_range();
134 6         41 $self->_remove_tics_from_chart_box(\@chart_box, \%opts);
135 6         37 my $column_count = $self->_get_column_count();
136              
137 6         18 my $width = $self->_get_number('width');
138 6         28 my $height = $self->_get_number('height');
139              
140 6         12 my $graph_width = $chart_box[2] - $chart_box[0];
141 6         13 my $graph_height = $chart_box[3] - $chart_box[1];
142              
143 6         12 my $col_height = ($graph_height - 1) / $column_count;
144 6 100       17 if ($col_height > 1) {
145 5         11 $graph_height = int($col_height) * $column_count + 1;
146             }
147             else {
148 1         3 $graph_height = $col_height * $column_count + 1;
149             }
150              
151 6         16 my $tic_count = $self->_get_x_tics();
152 6         15 my $tic_distance = int(($graph_width -1) / ($tic_count - 1));
153 6         11 $graph_width = $tic_distance * ($tic_count - 1);
154              
155 6         9 my $top = $chart_box[1];
156 6         7 my $left = $chart_box[0];
157              
158 6         18 $self->{'_style'}{'graph_width'} = $graph_width;
159 6         13 $self->{'_style'}{'graph_height'} = $graph_height;
160              
161 6         18 my @graph_box = ($left, $top, $left + $graph_width, $top + $graph_height);
162              
163 6         32 $self->_set_graph_box(\@graph_box);
164              
165 6         16 my @fill_box = @graph_box;
166              
167 6 50       45 if ($self->_feature_enabled("graph_outline")) {
168 6 50       54 my @line = $self->_get_line("graph.outline")
169             or return;
170              
171 6         46 $self->_box(
172             @line,
173             box => \@fill_box,
174             img => $img,
175             );
176 6         691 ++$fill_box[0];
177 6         9 ++$fill_box[1];
178 6         15 --$fill_box[2];
179 6         36 --$fill_box[3];
180             }
181              
182             {
183 6 50       9 my @back_fill = $self->_get_fill("graph.fill", \@fill_box)
  6         32  
184             or return;
185 6         161 $img->box(
186             @back_fill,
187             box => \@fill_box,
188             );
189             }
190              
191 6         3240 my $min_value = $self->_get_min_value();
192 6         17 my $max_value = $self->_get_max_value();
193 6         11 my $value_range = $max_value - $min_value;
194              
195 6         9 my $zero_position;
196 6 50       20 if ($value_range) {
197 6         23 $zero_position = $left + (-1*$min_value / $value_range) * ($graph_width-1);
198             }
199              
200 6 100       19 if ($min_value < 0) {
201 2         8 my @neg_box = ( $left+1, $top+1, $zero_position, $top+$graph_height - 1 );
202 2 50       8 my @neg_fill = $self->_get_fill('negative_bg', \@neg_box)
203             or return;
204              
205 2         26 $img->box(
206             @neg_fill,
207             box => \@neg_box,
208             );
209 2         891 $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         168 $self->_reset_series_counter();
219              
220 6 100       26 if ($self->_get_data_series()->{'bar'}) {
221 5         44 $self->_draw_bars();
222             }
223 6 100       61 if ($self->_get_data_series()->{'line'}) {
224 1         7 $self->_draw_lines();
225             }
226              
227 6 50       26 if ($self->_get_x_tics()) {
228 0         0 $self->_draw_x_tics();
229             }
230 6 100       35 if ($self->_get_labels(\%opts)) {
231 5         27 $self->_draw_y_tics(\%opts);
232             }
233              
234 6         630 return $self->_get_image();
235             }
236              
237             sub _get_data_range {
238 6     6   12 my $self = shift;
239              
240 6         11 my $max_value = 0;
241 6         12 my $min_value = 0;
242 6         13 my $column_count = 0;
243              
244 6         100 my ($b_min, $b_max, $b_cols) = $self->_get_bar_range();
245 6         50 my ($l_min, $l_max, $l_cols) = $self->_get_line_range();
246              
247 6         42 $min_value = $self->_min(STARTING_MIN_VALUE, $b_min, $l_min);
248 6         49 $max_value = $self->_max(0, $b_max, $l_max);
249 6         24 $column_count = $self->_max(0, $b_cols, $l_cols);
250              
251 6         31 my $config_min = $self->_get_number('x_min');
252 6         22 my $config_max = $self->_get_number('x_max');
253              
254 6 50 33     24 if (defined $config_max && $config_max < $max_value) {
255 0         0 $config_max = undef;
256             }
257 6 50 33     33 if (defined $config_min && $config_min > $min_value) {
258 0         0 $config_min = undef;
259             }
260              
261 6         24 my $range_padding = $self->_get_number('range_padding');
262 6 50       17 if (defined $config_min) {
263 0         0 $min_value = $config_min;
264             }
265             else {
266 6 100       21 if ($min_value > 0) {
267 4         7 $min_value = 0;
268             }
269 6 50 33     32 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       23 if (defined $config_max) {
278 0         0 $max_value = $config_max;
279             }
280             else {
281 6 50 33     18 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       19 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         36 $self->_set_max_value($max_value);
308 6         29 $self->_set_min_value($min_value);
309 6         30 $self->_set_column_count($column_count);
310              
311 6         22 return 1;
312             }
313              
314             sub _min {
315 6     6   12 my $self = shift;
316 6         11 my $min = shift;
317              
318 6         16 foreach my $value (@_) {
319 12 100       58 next unless defined $value;
320 6 50       31 if ($value < $min) { $min = $value; }
  6         13  
321             }
322 6         14 return $min;
323             }
324              
325             sub _max {
326 12     12   20 my $self = shift;
327 12         14 my $min = shift;
328              
329 12         21 foreach my $value (@_) {
330 24 100       51 next unless defined $value;
331 18 100       43 if ($value > $min) { $min = $value; }
  12         18  
332             }
333 12         24 return $min;
334             }
335              
336             sub _get_line_range {
337 6     6   13 my $self = shift;
338 6         25 my $series = $self->_get_data_series()->{'line'};
339 6 100       26 return (undef, undef, 0) unless $series;
340              
341 1         2 my $max_value = 0;
342 1         3 my $min_value = STARTING_MIN_VALUE;
343 1         1 my $column_count = 0;
344              
345 1         2 my @series = @{$series};
  1         2  
346 1         3 foreach my $series (@series) {
347 1         2 my @data = @{$series->{'data'}};
  1         6  
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       15 if ($value > $max_value) { $max_value = $value; }
  2         3  
355 7 100       15 if ($value < $min_value) { $min_value = $value; }
  6         12  
356             }
357             }
358              
359 1         4 return ($min_value, $max_value, $column_count);
360             }
361              
362              
363              
364             sub _get_bar_range {
365 6     6   12 my $self = shift;
366              
367 6         24 my $series = $self->_get_data_series()->{'bar'};
368 6 100       22 return (undef, undef, 0) unless $series;
369              
370 5         10 my $max_value = 0;
371 5         12 my $min_value = STARTING_MIN_VALUE;
372 5         6 my $column_count = 0;
373              
374 5         10 my @series = @{$series};
  5         14  
375 5         14 foreach my $series (@series) {
376 5         9 my @data = @{$series->{'data'}};
  5         121  
377              
378 5         12 foreach my $value (@data) {
379 1030         949 $column_count++;
380 1030 100       1609 if ($value > $max_value) { $max_value = $value; }
  1008         952  
381 1030 100       1780 if ($value < $min_value) { $min_value = $value; }
  27         43  
382             }
383             }
384              
385 5         20 return ($min_value, $max_value, $column_count);
386             }
387              
388              
389             sub _draw_legend {
390 6     6   13 my $self = shift;
391 6         9 my $chart_box = shift;
392 6         18 my $style = $self->{'_style'};
393              
394 6         12 my @labels;
395 6         20 my $img = $self->_get_image();
396 6 100       38 if (my $series = $self->_get_data_series()->{'bar'}) {
397 5         16 push @labels, map { $_->{'series_name'} } @$series;
  5         24  
398             }
399              
400 6 0 50     30 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         19 return;
405             }
406              
407             sub _draw_flat_legend {
408 0     0   0 return 1;
409             }
410              
411             sub _draw_lines {
412 1     1   2 my $self = shift;
413 1         3 my $style = $self->{'_style'};
414              
415 1         3 my $img = $self->_get_image();
416              
417 1         4 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         4 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         3 my $line_series = $self->_get_data_series()->{'line'};
430 1   50     6 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         2 my $col_height = int($graph_height / $column_count) -1;
435              
436 1         11 my $graph_box = $self->_get_graph_box();
437 1         8 my $left = $graph_box->[0] + 1;
438 1         1 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         4 my $line_aa = $self->_get_number("lineaa");
443 1         3 foreach my $series (@$line_series) {
444 1         1 my @data = @{$series->{'data'}};
  1         3  
445 1         2 my $data_size = scalar @data;
446              
447 1         1 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         7 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         3 for (my $i = 0; $i < $data_size - 1; $i++) {
459 6         437 my $y1 = $bottom + $i * $interval;
460 6         11 my $y2 = $bottom + ($i + 1) * $interval;
461              
462 6         14 $y1 += $has_columns * $interval / 2;
463 6         8 $y2 += $has_columns * $interval / 2;
464              
465 6         12 my $x1 = $left + ($value_range - $data[$i] + $min_value)/$value_range * $graph_width;
466 6         12 my $x2 = $left + ($value_range - $data[$i + 1] + $min_value)/$value_range * $graph_width;
467              
468 6         12 push @marker_positions, [$x1, $y1];
469 6 50       22 $img->line(x1 => $x1, y1 => $y1, x2 => $x2, y2 => $y2, aa => $line_aa, color => $color) || die $img->errstr;
470             }
471              
472              
473 1         68 my $y2 = $bottom + ($data_size - 1) * $interval;
474 1         3 $y2 += $has_columns * $interval / 2;
475              
476 1         5 my $x2 = $left + ($value_range - $data[$data_size - 1] + $min_value)/$value_range * $graph_width;
477              
478 1 50       21 if ($self->_feature_enabled("linemarkers")) {
479 1         75 push @marker_positions, [$x2, $y2];
480 1         4 foreach my $position (@marker_positions) {
481 7         1440 $self->_draw_line_marker($position->[0], $position->[1], $series_counter);
482             }
483             }
484 1         181 $series_counter++;
485             }
486              
487 1         7 $self->_set_series_counter($series_counter);
488 1         3 return;
489             }
490              
491             sub _draw_bars {
492 5     5   11 my $self = shift;
493 5         14 my $style = $self->{'_style'};
494              
495 5         18 my $img = $self->_get_image();
496              
497 5         13 my $max_value = $self->_get_max_value();
498 5         14 my $min_value = $self->_get_min_value();
499 5         12 my $column_count = $self->_get_column_count();
500              
501 5         11 my $value_range = $max_value - $min_value;
502              
503 5         19 my $width = $self->_get_number('width');
504 5         20 my $height = $self->_get_number('height');
505              
506 5         18 my $graph_width = $self->_get_number('graph_width');
507 5         16 my $graph_height = $self->_get_number('graph_height');
508              
509              
510 5         119 my $graph_box = $self->_get_graph_box();
511 5         13 my $bottom = $graph_box->[1] + 1;
512 5         8 my $left = $graph_box->[0];
513              
514 5         28 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         5 my $outline_color;
519 5 50       18 if ($style->{'features'}{'outline'}) {
520 0         0 $outline_color = $self->_get_color('outline.line');
521             }
522              
523 5   50     21 my $series_counter = $self->_get_series_counter() || 0;
524 5         16 my $col_series = $self->_get_data_series()->{'bar'};
525 5   50     18 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         10 my $column_series = 0;
529              
530 5         19 for (my $series_pos = 0; $series_pos < scalar @$col_series; $series_pos++) {
531 5         10 my $series = $col_series->[$series_pos];
532 5         8 my @data = @{$series->{'data'}};
  5         113  
533 5         21 my $data_size = scalar @data;
534 5         17 for (my $i = 0; $i < $data_size; $i++) {
535              
536 1030         1724 my $part1 = $bar_height * (scalar @$col_series * $i);
537 1030         1181 my $part2 = ($series_pos) * $bar_height;
538 1030         1793 my $y1 = int($bottom + $part1 + $part2);
539              
540 1030         1593 my $y2 = int($y1 + $bar_height - $column_padding)-1;
541             # Special case for when bar_height is less than 1.
542 1030 100       1829 if ($y2 < $y1) {
543 1000         1106 $y2 = $y1;
544             }
545              
546 1030         1917 my $x1 = int($left - ($min_value - $data[$i]) / $value_range * $graph_width);
547              
548 1030         2845 my $color = $self->_data_color($series_counter);
549              
550 1030 100       2049 if ($data[$i] > 0) {
    50          
551 1028         4124 my @fill = $self->_data_fill($series_counter, [$zero_position+1, $y1, $x1, $y2]);
552 1028         4841 $img->box(xmax => $x1, xmin => $zero_position+1, ymin => $y1, ymax => $y2, @fill);
553 1028 50       179700 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         11 my @fill = $self->_data_fill($series_counter, [$x1, $y1, $zero_position, $y2]);
561 2         10 $img->box(xmax => $zero_position , xmin => $x1, ymin => $y1, ymax => $y2, @fill);
562 2 50       444 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         10 $series_counter++;
569 5         48 $column_series++;
570             }
571 5         36 $self->_set_series_counter($series_counter);
572 5         17 return;
573             }
574              
575             sub _add_data_series {
576 6     6   40 my $self = shift;
577 6         39 my $series_type = shift;
578 6         12 my $data_ref = shift;
579 6         46 my $series_name = shift;
580              
581 6   50     56 my $graph_data = $self->{'graph_data'} || {};
582              
583 6   50     38 my $series = $graph_data->{$series_type} || [];
584              
585 6         27 push @$series, { data => $data_ref, series_name => $series_name };
586              
587 6         17 $graph_data->{$series_type} = $series;
588              
589 6         13 $self->{'graph_data'} = $graph_data;
590 6         16 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   125 return $_[0]->{'x_tics'} || 0;
672             }
673              
674             sub _remove_tics_from_chart_box {
675 6     6   17 my ($self, $chart_box, $opts) = @_;
676              
677             # XXX - bad default
678 6   100     31 my $tic_width = $self->_get_y_tic_width($opts) || 10;
679 6         22 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     36 my $tic_height = $self->_get_x_tic_height() || 10;
683 6         23 my @x_tic_box = ($chart_box->[0], $chart_box->[3] - $tic_height, $chart_box->[2], $chart_box->[3]);
684              
685 6         51 $self->_remove_box($chart_box, \@y_tic_box);
686 6         23 $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         25 my @y_tic_tops = ($chart_box->[0], $chart_box->[1], $chart_box->[2], $chart_box->[1] + int($tic_height / 2));
690 6         22 $self->_remove_box($chart_box, \@y_tic_tops);
691              
692 6 100       29 if (my @box = $self->_text_bbox($self->_get_max_value(), 'legend')) {
693 4         18 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         14 $self->_remove_box($chart_box, \@remove_box);
700             }
701              
702              
703             }
704              
705             sub _get_y_tic_width {
706 6     6   21 my ($self, $opts) = @_;
707              
708 6         57 my $labels = $self->_get_labels($opts);
709              
710 6 100       21 if (!$labels) {
711 1         7 return;
712             }
713              
714 5 100       30 my %text_info = $self->_text_style('legend')
715             or return;
716              
717 4         9 my $max_width = 0;
718 4         10 foreach my $label (@$labels) {
719 30         89 my @box = $self->_text_bbox($label, 'legend');
720 30         51 my $width = $box[2] + 5;
721             # For the tic itself...
722 30         36 $width += 10;
723 30 100       81 if ($width > $max_width) {
724 8         14 $max_width = $width;
725             }
726             }
727 4         26 return $max_width;
728             }
729              
730             sub _get_x_tic_height {
731 6     6   22 my $self = shift;
732              
733 6         58 my $min = $self->_get_min_value();
734 6         55 my $max = $self->_get_max_value();
735 6         28 my $tic_count = $self->_get_x_tics();
736              
737 6         35 my $interval = ($max - $min) / ($tic_count - 1);
738              
739 6 100       29 my %text_info = $self->_text_style('legend')
740             or return;
741              
742 4         15 my $max_height = 0;
743 4         16 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         31 return $max_height;
758             }
759              
760             sub _draw_y_tics {
761 5     5   8 my ($self, $opts) = @_;
762              
763 5         21 my $img = $self->_get_image();
764 5         18 my $graph_box = $self->_get_graph_box();
765 5         23 my $image_box = $self->_get_image_box();
766              
767 5         18 my $labels = $self->_get_labels($opts);
768              
769 5         12 my $tic_count = (scalar @$labels) - 1;
770              
771 5         15 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         11 my $denominator = $tic_count;
775 5 100       16 if ($has_columns) {
776 4         4 $denominator ++;
777             }
778 5         15 my $tic_distance = ($graph_box->[3] - $graph_box->[1]) / ($denominator);
779 5 100       22 my %text_info = $self->_text_style('legend')
780             or return;
781              
782 4         16 for my $count (0 .. $tic_count) {
783 30         4114 my $label = $labels->[$count];
784              
785 30         50 my $x1 = $graph_box->[0] - 5;
786 30         37 my $x2 = $graph_box->[0] + 5;
787              
788 30         49 my $y1 = $graph_box->[1] + ($tic_distance * $count);
789              
790 30 50       65 if ($has_columns) {
791 30         50 $y1 += $tic_distance / 2;
792             }
793              
794 30         96 $img->line(x1 => $x1, x2 => $x2, y1 => $y1, y2 => $y1, aa => 1, color => '000000');
795              
796 30 50       2122 my @box = $self->_text_bbox($label, 'legend')
797             or return;
798              
799 30         45 my $width = $box[2];
800 30         32 my $height = $box[3];
801              
802 30         190 $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   12 my $self = shift;
865              
866 6 50 33     46 if (!defined $self->_get_data_series() || !keys %{$self->_get_data_series()}) {
  6         27  
867 0         0 return $self->_error("No data supplied");
868             }
869              
870 6         21 my $data = $self->_get_data_series();
871 6 50 66     37 if (defined $data->{'line'} && !scalar @{$data->{'line'}->[0]->{'data'}}) {
  1         7  
872 0         0 return $self->_error("No values in data series");
873             }
874 6 50 33     38 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     47 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         27 return 1;
882             }
883              
884 6     6   17 sub _set_column_count { $_[0]->{'column_count'} = $_[1]; }
885 6     6   16 sub _set_min_value { $_[0]->{'min_value'} = $_[1]; }
886 6     6   23 sub _set_max_value { $_[0]->{'max_value'} = $_[1]; }
887 6     6   31 sub _set_image_box { $_[0]->{'image_box'} = $_[1]; }
888 6     6   18 sub _set_graph_box { $_[0]->{'graph_box'} = $_[1]; }
889 6     6   20 sub _set_series_counter { $_[0]->{'series_counter'} = $_[1]; }
890 12     12   28 sub _get_column_count { return $_[0]->{'column_count'} }
891 18     18   50 sub _get_min_value { return $_[0]->{'min_value'} }
892 24     24   78 sub _get_max_value { return $_[0]->{'max_value'} }
893 5     5   11 sub _get_image_box { return $_[0]->{'image_box'} }
894 11     11   31 sub _get_graph_box { return $_[0]->{'graph_box'} }
895 6     6   20 sub _reset_series_counter { $_[0]->{series_counter} = 0 }
896 6     6   36 sub _get_series_counter { return $_[0]->{'series_counter'} }
897              
898             sub _style_defs {
899 6     6   15 my ($self) = @_;
900              
901 6         160 my %work = %{$self->SUPER::_style_defs()};
  6         43  
902 6         19 push @{$work{features}}, qw/graph_outline graph_fill linemarkers/;
  6         27  
903 6         30 $work{vgrid} =
904             {
905             color => "lookup(fg)",
906             style => "solid",
907             };
908              
909 6         20 return \%work;
910             }
911              
912             sub _composite {
913 6     6   11 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