hoist line marker drawing into the base class
[imager-graph.git] / lib / Imager / Graph / Vertical.pm
CommitLineData
2eac77fc 1package Imager::Graph::Vertical;
2
3=head1 NAME
4
5057a68f
TC
5Imager::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
25This is a base class that implements the functionality for column,
26stacked column, line and area charts where the dependent variable is
27represented in changes in the vertical position.
28
29The subclasses, L<Imager::Graph::Column>,
30L<Imager::Graph::StackedColumn>, L<Imager::Graph::Line> and
31L<Imager::Graph::Area> simply provide default data series types.
32
33=head1 METHODS
2eac77fc 34
35=cut
36
37use strict;
38use vars qw(@ISA);
39use Imager::Graph;
40@ISA = qw(Imager::Graph);
41
23a3585a 42use constant STARTING_MIN_VALUE => 99999;
f94f373e 43
5057a68f 44=over
2eac77fc 45
46=item add_data_series(\@data, $series_name)
47
5057a68f
TC
48Add a data series to the graph, of the default type. This requires
49that the graph object be one of the derived graph classes.
2eac77fc 50
51=cut
52
53sub add_data_series {
54 my $self = shift;
55 my $data_ref = shift;
56 my $series_name = shift;
57
58 my $series_type = $self->_get_default_series_type();
59 $self->_add_data_series($series_type, $data_ref, $series_name);
60
61 return;
62}
63
64=item add_column_data_series(\@data, $series_name)
65
66Add a column data series to the graph.
67
68=cut
69
70sub add_column_data_series {
71 my $self = shift;
72 my $data_ref = shift;
73 my $series_name = shift;
74
75 $self->_add_data_series('column', $data_ref, $series_name);
76
77 return;
78}
79
80=item add_stacked_column_data_series(\@data, $series_name)
81
82Add a stacked column data series to the graph.
83
84=cut
85
86sub add_stacked_column_data_series {
87 my $self = shift;
88 my $data_ref = shift;
89 my $series_name = shift;
90
91 $self->_add_data_series('stacked_column', $data_ref, $series_name);
92
93 return;
94}
95
96=item add_line_data_series(\@data, $series_name)
97
98Add a line data series to the graph.
99
100=cut
101
102sub add_line_data_series {
103 my $self = shift;
104 my $data_ref = shift;
105 my $series_name = shift;
106
107 $self->_add_data_series('line', $data_ref, $series_name);
108
109 return;
110}
111
e2c4cb9a 112=item add_area_data_series(\@data, $series_name)
113
114Add a area data series to the graph.
115
116=cut
117
118sub add_area_data_series {
119 my $self = shift;
120 my $data_ref = shift;
121 my $series_name = shift;
122
123 $self->_add_data_series('area', $data_ref, $series_name);
124
125 return;
126}
127
23a3585a
TC
128=item set_y_max($value)
129
5057a68f
TC
130Sets the maximum y value to be displayed. This will be ignored if the
131y_max is lower than the highest value.
23a3585a
TC
132
133=cut
134
135sub set_y_max {
136 $_[0]->{'custom_style'}->{'y_max'} = $_[1];
137}
138
139=item set_y_min($value)
140
5057a68f
TC
141Sets the minimum y value to be displayed. This will be ignored if the
142y_min is higher than the lowest value.
23a3585a
TC
143
144=cut
145
146sub set_y_min {
147 $_[0]->{'custom_style'}->{'y_min'} = $_[1];
148}
149
488bc70c 150=item set_column_padding($int)
151
5057a68f
TC
152Sets the padding between columns. This is a percentage of the column
153width. Defaults to 0.
488bc70c 154
155=cut
156
157sub set_column_padding {
158 $_[0]->{'custom_style'}->{'column_padding'} = $_[1];
159}
160
2eac77fc 161=item set_range_padding($percentage)
162
5057a68f
TC
163Sets the padding to be used, as a percentage. For example, if your
164data ranges from 0 to 10, and you have a 20 percent padding, the y
165axis will go to 12.
2eac77fc 166
5057a68f
TC
167Defaults to 10. This attribute is ignored for positive numbers if
168set_y_max() has been called, and ignored for negative numbers if
169set_y_min() has been called.
2eac77fc 170
171=cut
172
173sub set_range_padding {
174 $_[0]->{'custom_style'}->{'range_padding'} = $_[1];
175}
176
23a3585a
TC
177=item set_negative_background($color)
178
179Sets the background color used below the x axis.
180
181=cut
182
183sub set_negative_background {
184 $_[0]->{'custom_style'}->{'negative_bg'} = $_[1];
185}
186
2eac77fc 187=item draw()
188
189Draw the graph
190
191=cut
192
193sub draw {
194 my ($self, %opts) = @_;
195
196 if (!$self->_valid_input()) {
197 return;
198 }
199
200 $self->_style_setup(\%opts);
201
202 my $style = $self->{_style};
203
56b495c0
TC
204 $self->_make_img
205 or return;
206
2eac77fc 207 my $img = $self->_get_image()
208 or return;
209
210 my @image_box = ( 0, 0, $img->getwidth-1, $img->getheight-1 );
211 $self->_set_image_box(\@image_box);
212
c2c2cb9e 213 my @chart_box = ( 0, 0, $img->getwidth-1, $img->getheight-1 );
214 $self->_draw_legend(\@chart_box);
215 if ($style->{title}{text}) {
216 $self->_draw_title($img, \@chart_box)
217 or return;
218 }
219
2eac77fc 220 # Scale the graph box down to the widest graph that can cleanly hold the # of columns.
e554917f 221 return unless $self->_get_data_range();
56b495c0 222 $self->_remove_tics_from_chart_box(\@chart_box, \%opts);
2eac77fc 223 my $column_count = $self->_get_column_count();
224
225 my $width = $self->_get_number('width');
226 my $height = $self->_get_number('height');
2eac77fc 227
c2c2cb9e 228 my $graph_width = $chart_box[2] - $chart_box[0];
229 my $graph_height = $chart_box[3] - $chart_box[1];
2eac77fc 230
1509eee7 231 my $col_width = ($graph_width - 1) / $column_count;
267997be 232 if ($col_width > 1) {
233 $graph_width = int($col_width) * $column_count + 1;
234 }
235 else {
236 $graph_width = $col_width * $column_count + 1;
237 }
2eac77fc 238
c2c2cb9e 239 my $tic_count = $self->_get_y_tics();
1509eee7 240 my $tic_distance = ($graph_height-1) / ($tic_count - 1);
241 $graph_height = int($tic_distance * ($tic_count - 1));
c2c2cb9e 242
1a36ef75
TC
243 my $top = $chart_box[1];
244 my $left = $chart_box[0];
2eac77fc 245
c2c2cb9e 246 $self->{'_style'}{'graph_width'} = $graph_width;
247 $self->{'_style'}{'graph_height'} = $graph_height;
248
1a36ef75 249 my @graph_box = ($left, $top, $left + $graph_width, $top + $graph_height);
c2c2cb9e 250 $self->_set_graph_box(\@graph_box);
2eac77fc 251
1a36ef75 252 my @fill_box = ( $left, $top, $left+$graph_width, $top+$graph_height );
86f73dc2 253 if ($self->_feature_enabled("graph_outline")) {
56b495c0
TC
254 my @line = $self->_get_line("graph.outline")
255 or return;
256
257 $self->_box(
258 @line,
86f73dc2
TC
259 box => \@fill_box,
260 img => $img,
56b495c0 261 );
1a36ef75
TC
262 ++$fill_box[0];
263 ++$fill_box[1];
264 --$fill_box[2];
265 --$fill_box[3];
266 }
2eac77fc 267
268 $img->box(
1a36ef75
TC
269 $self->_get_fill('graph.fill'),
270 box => \@fill_box,
86f73dc2 271 );
2eac77fc 272
273 my $min_value = $self->_get_min_value();
274 my $max_value = $self->_get_max_value();
275 my $value_range = $max_value - $min_value;
276
277 my $zero_position;
278 if ($value_range) {
1a36ef75 279 $zero_position = $top + $graph_height - (-1*$min_value / $value_range) * ($graph_height-1);
2eac77fc 280 }
281
282 if ($min_value < 0) {
283 $img->box(
284 color => $self->_get_color('negative_bg'),
285 xmin => $left + 1,
286 xmax => $left+$graph_width- 1,
287 ymin => $zero_position,
1a36ef75 288 ymax => $top+$graph_height - 1,
2eac77fc 289 filled => 1,
290 );
291 $img->line(
292 x1 => $left+1,
293 y1 => $zero_position,
294 x2 => $left + $graph_width,
295 y2 => $zero_position,
296 color => $self->_get_color('outline.line'),
297 );
298 }
299
56b495c0
TC
300 $self->_reset_series_counter();
301
2eac77fc 302 if ($self->_get_data_series()->{'stacked_column'}) {
488bc70c 303 return unless $self->_draw_stacked_columns();
2eac77fc 304 }
305 if ($self->_get_data_series()->{'column'}) {
488bc70c 306 return unless $self->_draw_columns();
2eac77fc 307 }
308 if ($self->_get_data_series()->{'line'}) {
488bc70c 309 return unless $self->_draw_lines();
2eac77fc 310 }
e2c4cb9a 311 if ($self->_get_data_series()->{'area'}) {
312 return unless $self->_draw_area();
313 }
c2c2cb9e 314
315 if ($self->_get_y_tics()) {
316 $self->_draw_y_tics();
317 }
56b495c0
TC
318 if ($self->_get_labels(\%opts)) {
319 $self->_draw_x_tics(\%opts);
c2c2cb9e 320 }
321
2eac77fc 322 return $self->_get_image();
323}
324
325sub _get_data_range {
326 my $self = shift;
327
328 my $max_value = 0;
329 my $min_value = 0;
330 my $column_count = 0;
331
332 my ($sc_min, $sc_max, $sc_cols) = $self->_get_stacked_column_range();
333 my ($c_min, $c_max, $c_cols) = $self->_get_column_range();
334 my ($l_min, $l_max, $l_cols) = $self->_get_line_range();
e2c4cb9a 335 my ($a_min, $a_max, $a_cols) = $self->_get_area_range();
2eac77fc 336
337 # These are side by side...
338 $sc_cols += $c_cols;
339
e2c4cb9a 340 $min_value = $self->_min(STARTING_MIN_VALUE, $sc_min, $c_min, $l_min, $a_min);
341 $max_value = $self->_max(0, $sc_max, $c_max, $l_max, $a_max);
2eac77fc 342
23a3585a
TC
343 my $config_min = $self->_get_number('y_min');
344 my $config_max = $self->_get_number('y_max');
345
346 if (defined $config_max && $config_max < $max_value) {
347 $config_max = undef;
348 }
349 if (defined $config_min && $config_min > $min_value) {
350 $config_min = undef;
351 }
352
2eac77fc 353 my $range_padding = $self->_get_number('range_padding');
23a3585a
TC
354 if (defined $config_min) {
355 $min_value = $config_min;
356 }
357 else {
358 if ($min_value > 0) {
359 $min_value = 0;
360 }
361 if ($range_padding && $min_value < 0) {
362 my $difference = $min_value * $range_padding / 100;
363 if ($min_value < -1 && $difference > -1) {
364 $difference = -1;
365 }
366 $min_value += $difference;
2eac77fc 367 }
2eac77fc 368 }
23a3585a
TC
369 if (defined $config_max) {
370 $max_value = $config_max;
371 }
372 else {
373 if ($range_padding && $max_value > 0) {
374 my $difference = $max_value * $range_padding / 100;
375 if ($max_value > 1 && $difference < 1) {
376 $difference = 1;
377 }
378 $max_value += $difference;
2eac77fc 379 }
2eac77fc 380 }
e2c4cb9a 381 $column_count = $self->_max(0, $sc_cols, $l_cols, $a_cols);
2eac77fc 382
c2c2cb9e 383 if ($self->_get_number('automatic_axis')) {
384 # In case this was set via a style, and not by the api method
e554917f 385 eval { require Chart::Math::Axis; };
c2c2cb9e 386 if ($@) {
e554917f 387 return $self->_error("Can't use automatic_axis - $@");
c2c2cb9e 388 }
389
390 my $axis = Chart::Math::Axis->new();
f0b01a81 391 $axis->include_zero();
c2c2cb9e 392 $axis->add_data($min_value, $max_value);
393 $max_value = $axis->top;
394 $min_value = $axis->bottom;
395 my $ticks = $axis->ticks;
396 # The +1 is there because we have the bottom tick as well
397 $self->set_y_tics($ticks+1);
398 }
399
2eac77fc 400 $self->_set_max_value($max_value);
401 $self->_set_min_value($min_value);
402 $self->_set_column_count($column_count);
e554917f 403
404 return 1;
2eac77fc 405}
406
407sub _min {
408 my $self = shift;
409 my $min = shift;
410
411 foreach my $value (@_) {
23a3585a 412 next unless defined $value;
2eac77fc 413 if ($value < $min) { $min = $value; }
414 }
415 return $min;
416}
417
418sub _max {
419 my $self = shift;
420 my $min = shift;
421
422 foreach my $value (@_) {
23a3585a 423 next unless defined $value;
2eac77fc 424 if ($value > $min) { $min = $value; }
425 }
426 return $min;
427}
428
429sub _get_line_range {
430 my $self = shift;
431 my $series = $self->_get_data_series()->{'line'};
23a3585a 432 return (undef, undef, 0) unless $series;
2eac77fc 433
434 my $max_value = 0;
23a3585a 435 my $min_value = STARTING_MIN_VALUE;
2eac77fc 436 my $column_count = 0;
437
438 my @series = @{$series};
439 foreach my $series (@series) {
440 my @data = @{$series->{'data'}};
441
442 if (scalar @data > $column_count) {
443 $column_count = scalar @data;
444 }
445
446 foreach my $value (@data) {
447 if ($value > $max_value) { $max_value = $value; }
448 if ($value < $min_value) { $min_value = $value; }
449 }
450 }
451
452 return ($min_value, $max_value, $column_count);
453}
454
e2c4cb9a 455sub _get_area_range {
456 my $self = shift;
457 my $series = $self->_get_data_series()->{'area'};
458 return (undef, undef, 0) unless $series;
459
460 my $max_value = 0;
461 my $min_value = STARTING_MIN_VALUE;
462 my $column_count = 0;
463
464 my @series = @{$series};
465 foreach my $series (@series) {
466 my @data = @{$series->{'data'}};
467
468 if (scalar @data > $column_count) {
469 $column_count = scalar @data;
470 }
471
472 foreach my $value (@data) {
473 if ($value > $max_value) { $max_value = $value; }
474 if ($value < $min_value) { $min_value = $value; }
475 }
476 }
477
478 return ($min_value, $max_value, $column_count);
479}
480
481
2eac77fc 482sub _get_column_range {
483 my $self = shift;
484
485 my $series = $self->_get_data_series()->{'column'};
23a3585a 486 return (undef, undef, 0) unless $series;
2eac77fc 487
488 my $max_value = 0;
23a3585a 489 my $min_value = STARTING_MIN_VALUE;
2eac77fc 490 my $column_count = 0;
491
492 my @series = @{$series};
493 foreach my $series (@series) {
494 my @data = @{$series->{'data'}};
495
496 foreach my $value (@data) {
497 $column_count++;
498 if ($value > $max_value) { $max_value = $value; }
499 if ($value < $min_value) { $min_value = $value; }
500 }
501 }
502
503 return ($min_value, $max_value, $column_count);
504}
505
506sub _get_stacked_column_range {
507 my $self = shift;
508
509 my $max_value = 0;
23a3585a 510 my $min_value = STARTING_MIN_VALUE;
2eac77fc 511 my $column_count = 0;
512
23a3585a 513 return (undef, undef, 0) unless $self->_get_data_series()->{'stacked_column'};
2eac77fc 514 my @series = @{$self->_get_data_series()->{'stacked_column'}};
515
516 my @max_entries;
517 my @min_entries;
518 for (my $i = scalar @series - 1; $i >= 0; $i--) {
519 my $series = $series[$i];
520 my $data = $series->{'data'};
521
522 for (my $i = 0; $i < scalar @$data; $i++) {
523 my $value = 0;
524 if ($data->[$i] > 0) {
525 $value = $data->[$i] + ($max_entries[$i] || 0);
526 $data->[$i] = $value;
527 $max_entries[$i] = $value;
528 }
529 elsif ($data->[$i] < 0) {
530 $value = $data->[$i] + ($min_entries[$i] || 0);
531 $data->[$i] = $value;
532 $min_entries[$i] = $value;
533 }
534 if ($value > $max_value) { $max_value = $value; }
535 if ($value < $min_value) { $min_value = $value; }
536 }
537 if (scalar @$data > $column_count) {
538 $column_count = scalar @$data;
539 }
540 }
541
542 return ($min_value, $max_value, $column_count);
543}
544
545sub _draw_legend {
546 my $self = shift;
c2c2cb9e 547 my $chart_box = shift;
2eac77fc 548 my $style = $self->{'_style'};
549
550 my @labels;
551 my $img = $self->_get_image();
552 if (my $series = $self->_get_data_series()->{'stacked_column'}) {
553 push @labels, map { $_->{'series_name'} } @$series;
554 }
555 if (my $series = $self->_get_data_series()->{'column'}) {
556 push @labels, map { $_->{'series_name'} } @$series;
557 }
558 if (my $series = $self->_get_data_series()->{'line'}) {
559 push @labels, map { $_->{'series_name'} } @$series;
560 }
f94f373e 561 if (my $series = $self->_get_data_series()->{'area'}) {
562 push @labels, map { $_->{'series_name'} } @$series;
563 }
2eac77fc 564
565 if ($style->{features}{legend} && (scalar @labels)) {
c2c2cb9e 566 $self->SUPER::_draw_legend($self->_get_image(), \@labels, $chart_box)
2eac77fc 567 or return;
568 }
569 return;
570}
571
572sub _draw_flat_legend {
573 return 1;
574}
575
576sub _draw_lines {
577 my $self = shift;
578 my $style = $self->{'_style'};
579
580 my $img = $self->_get_image();
581
582 my $max_value = $self->_get_max_value();
583 my $min_value = $self->_get_min_value();
584 my $column_count = $self->_get_column_count();
585
586 my $value_range = $max_value - $min_value;
587
588 my $width = $self->_get_number('width');
589 my $height = $self->_get_number('height');
2eac77fc 590
c2c2cb9e 591 my $graph_width = $self->_get_number('graph_width');
592 my $graph_height = $self->_get_number('graph_height');
2eac77fc 593
594 my $line_series = $self->_get_data_series()->{'line'};
595 my $series_counter = $self->_get_series_counter() || 0;
596
597 my $has_columns = (defined $self->_get_data_series()->{'column'} || $self->_get_data_series->{'stacked_column'}) ? 1 : 0;
598
c2c2cb9e 599 my $col_width = int($graph_width / $column_count) -1;
600
601 my $graph_box = $self->_get_graph_box();
602 my $left = $graph_box->[0] + 1;
603 my $bottom = $graph_box->[1];
604
605 my $zero_position = $bottom + $graph_height - (-1*$min_value / $value_range) * ($graph_height - 1);
606
49a35584 607 my $line_aa = $self->_get_number("lineaa");
2eac77fc 608 foreach my $series (@$line_series) {
609 my @data = @{$series->{'data'}};
610 my $data_size = scalar @data;
611
612 my $interval;
613 if ($has_columns) {
614 $interval = $graph_width / ($data_size);
615 }
616 else {
617 $interval = $graph_width / ($data_size - 1);
618 }
2eac77fc 619 my $color = $self->_data_color($series_counter);
8e140388
TC
620
621 # We need to add these last, otherwise the next line segment will overwrite half of the marker
622 my @marker_positions;
2eac77fc 623 for (my $i = 0; $i < $data_size - 1; $i++) {
624 my $x1 = $left + $i * $interval;
625 my $x2 = $left + ($i + 1) * $interval;
626
627 $x1 += $has_columns * $interval / 2;
628 $x2 += $has_columns * $interval / 2;
629
c2c2cb9e 630 my $y1 = $bottom + ($value_range - $data[$i] + $min_value)/$value_range * $graph_height;
631 my $y2 = $bottom + ($value_range - $data[$i + 1] + $min_value)/$value_range * $graph_height;
2eac77fc 632
8e140388 633 push @marker_positions, [$x1, $y1];
49a35584 634 $img->line(x1 => $x1, y1 => $y1, x2 => $x2, y2 => $y2, aa => $line_aa, color => $color) || die $img->errstr;
2eac77fc 635 }
636
637 my $x2 = $left + ($data_size - 1) * $interval;
638 $x2 += $has_columns * $interval / 2;
639
c2c2cb9e 640 my $y2 = $bottom + ($value_range - $data[$data_size - 1] + $min_value)/$value_range * $graph_height;
2eac77fc 641
8e140388
TC
642 push @marker_positions, [$x2, $y2];
643 foreach my $position (@marker_positions) {
644 $self->_draw_line_marker($position->[0], $position->[1], $series_counter);
645 }
2eac77fc 646 $series_counter++;
647 }
648
649 $self->_set_series_counter($series_counter);
488bc70c 650 return 1;
2eac77fc 651}
652
f94f373e 653sub _area_data_fill {
654 my ($self, $index, $box) = @_;
655
656 my %fill = $self->_data_fill($index, $box);
657
658 my $opacity = $self->_get_number("area.opacity");
659 $opacity == 1
660 and return %fill;
661
662 my $orig_fill = $fill{fill};
663 unless ($orig_fill) {
664 $orig_fill = Imager::Fill->new
665 (
666 solid => $fill{color},
667 combine => "normal",
668 );
669 }
670 return
671 (
672 fill => Imager::Fill->new
673 (
674 type => "opacity",
675 other => $orig_fill,
676 opacity => $opacity,
677 ),
678 );
679}
680
e2c4cb9a 681sub _draw_area {
682 my $self = shift;
683 my $style = $self->{'_style'};
684
685 my $img = $self->_get_image();
686
687 my $max_value = $self->_get_max_value();
688 my $min_value = $self->_get_min_value();
689 my $column_count = $self->_get_column_count();
690
691 my $value_range = $max_value - $min_value;
692
693 my $width = $self->_get_number('width');
694 my $height = $self->_get_number('height');
695
696 my $graph_width = $self->_get_number('graph_width');
697 my $graph_height = $self->_get_number('graph_height');
698
699 my $area_series = $self->_get_data_series()->{'area'};
700 my $series_counter = $self->_get_series_counter() || 0;
701
e2c4cb9a 702 my $col_width = int($graph_width / $column_count) -1;
703
704 my $graph_box = $self->_get_graph_box();
705 my $left = $graph_box->[0] + 1;
706 my $bottom = $graph_box->[1];
707 my $right = $graph_box->[2];
708 my $top = $graph_box->[3];
709
710 my $zero_position = $bottom + $graph_height - (-1*$min_value / $value_range) * ($graph_height - 1);
711
712 my $line_aa = $self->_get_number("lineaa");
713 foreach my $series (@$area_series) {
714 my @data = @{$series->{'data'}};
715 my $data_size = scalar @data;
716
45de5577 717 my $interval = $graph_width / ($data_size - 1);
718
e2c4cb9a 719 my $color = $self->_data_color($series_counter);
720
721 # We need to add these last, otherwise the next line segment will overwrite half of the marker
722 my @marker_positions;
723 my @polygon_points;
724 for (my $i = 0; $i < $data_size - 1; $i++) {
725 my $x1 = $left + $i * $interval;
726
e2c4cb9a 727 my $y1 = $bottom + ($value_range - $data[$i] + $min_value)/$value_range * $graph_height;
728
729 if ($i == 0) {
730 push @polygon_points, [$x1, $top];
731 }
732 push @polygon_points, [$x1, $y1];
733
734 push @marker_positions, [$x1, $y1];
735 }
736
737 my $x2 = $left + ($data_size - 1) * $interval;
e2c4cb9a 738
739 my $y2 = $bottom + ($value_range - $data[$data_size - 1] + $min_value)/$value_range * $graph_height;
740 push @polygon_points, [$x2, $y2];
741 push @polygon_points, [$x2, $top];
742 push @polygon_points, $polygon_points[0];
743
f94f373e 744 my @fill = $self->_area_data_fill($series_counter, [$left, $bottom, $right, $top]);
e2c4cb9a 745 $img->polygon(points => [@polygon_points], @fill);
746
747 push @marker_positions, [$x2, $y2];
748 foreach my $position (@marker_positions) {
749 $self->_draw_line_marker($position->[0], $position->[1], $series_counter);
750 }
751 $series_counter++;
752 }
753
754 $self->_set_series_counter($series_counter);
755 return 1;
756}
757
2eac77fc 758sub _draw_columns {
759 my $self = shift;
760 my $style = $self->{'_style'};
761
762 my $img = $self->_get_image();
763
764 my $max_value = $self->_get_max_value();
765 my $min_value = $self->_get_min_value();
766 my $column_count = $self->_get_column_count();
767
768 my $value_range = $max_value - $min_value;
769
770 my $width = $self->_get_number('width');
771 my $height = $self->_get_number('height');
2eac77fc 772
c2c2cb9e 773 my $graph_width = $self->_get_number('graph_width');
774 my $graph_height = $self->_get_number('graph_height');
2eac77fc 775
2eac77fc 776
c2c2cb9e 777 my $graph_box = $self->_get_graph_box();
778 my $left = $graph_box->[0] + 1;
779 my $bottom = $graph_box->[1];
780 my $zero_position = int($bottom + $graph_height - (-1*$min_value / $value_range) * ($graph_height -1));
2eac77fc 781
413ce87a 782 my $bar_width = $graph_width / $column_count;
2eac77fc 783
784 my $outline_color;
785 if ($style->{'features'}{'outline'}) {
786 $outline_color = $self->_get_color('outline.line');
787 }
788
789 my $series_counter = $self->_get_series_counter() || 0;
790 my $col_series = $self->_get_data_series()->{'column'};
488bc70c 791 my $column_padding_percent = $self->_get_number('column_padding') || 0;
792 my $column_padding = int($column_padding_percent * $bar_width / 100);
2eac77fc 793
794 # 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.
795 my $column_series = 0;
796
797 # If there are stacked columns, non-stacked columns need to start one to the right of where they would otherwise
798 my $has_stacked_columns = (defined $self->_get_data_series()->{'stacked_column'} ? 1 : 0);
799
800 for (my $series_pos = 0; $series_pos < scalar @$col_series; $series_pos++) {
801 my $series = $col_series->[$series_pos];
802 my @data = @{$series->{'data'}};
803 my $data_size = scalar @data;
2eac77fc 804 for (my $i = 0; $i < $data_size; $i++) {
413ce87a 805 my $part1 = $bar_width * (scalar @$col_series * $i);
806 my $part2 = ($series_pos) * $bar_width;
807 my $x1 = $left + $part1 + $part2;
2eac77fc 808 if ($has_stacked_columns) {
413ce87a 809 $x1 += ($bar_width * ($i+1));
810 }
811 $x1 = int($x1);
812
813 my $x2 = int($x1 + $bar_width - $column_padding)-1;
814 # Special case for when bar_width is less than 1.
815 if ($x2 < $x1) {
816 $x2 = $x1;
2eac77fc 817 }
2eac77fc 818
c2c2cb9e 819 my $y1 = int($bottom + ($value_range - $data[$i] + $min_value)/$value_range * $graph_height);
2eac77fc 820
821 my $color = $self->_data_color($series_counter);
822
2eac77fc 823 if ($data[$i] > 0) {
7422650e 824 my @fill = $self->_data_fill($series_counter, [$x1, $y1, $x2, $zero_position-1]);
825 $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position-1, @fill);
2eac77fc 826 if ($style->{'features'}{'outline'}) {
827 $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position, color => $outline_color);
828 }
829 }
830 else {
7422650e 831 my @fill = $self->_data_fill($series_counter, [$x1, $zero_position+1, $x2, $y1]);
832 $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position+1, ymax => $y1, @fill);
2eac77fc 833 if ($style->{'features'}{'outline'}) {
834 $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position+1, ymax => $y1+1, color => $outline_color);
835 }
836 }
837 }
838
839 $series_counter++;
840 $column_series++;
841 }
842 $self->_set_series_counter($series_counter);
488bc70c 843 return 1;
2eac77fc 844}
845
846sub _draw_stacked_columns {
847 my $self = shift;
848 my $style = $self->{'_style'};
849
850 my $img = $self->_get_image();
851
852 my $max_value = $self->_get_max_value();
853 my $min_value = $self->_get_min_value();
854 my $column_count = $self->_get_column_count();
855 my $value_range = $max_value - $min_value;
856
857 my $graph_box = $self->_get_graph_box();
858 my $left = $graph_box->[0] + 1;
859 my $bottom = $graph_box->[1];
2eac77fc 860
c2c2cb9e 861 my $graph_width = $self->_get_number('graph_width');
862 my $graph_height = $self->_get_number('graph_height');
2eac77fc 863
413ce87a 864 my $bar_width = $graph_width / $column_count;
2eac77fc 865 my $column_series = 0;
866 if (my $column_series_data = $self->_get_data_series()->{'column'}) {
867 $column_series = (scalar @$column_series_data);
868 }
869 $column_series++;
870
488bc70c 871 my $column_padding_percent = $self->_get_number('column_padding') || 0;
872 if ($column_padding_percent < 0) {
873 return $self->_error("Column padding less than 0");
874 }
875 if ($column_padding_percent > 100) {
876 return $self->_error("Column padding greater than 0");
877 }
878 my $column_padding = int($column_padding_percent * $bar_width / 100);
879
2eac77fc 880 my $outline_color;
881 if ($style->{'features'}{'outline'}) {
882 $outline_color = $self->_get_color('outline.line');
883 }
884
c2c2cb9e 885 my $zero_position = $bottom + $graph_height - (-1*$min_value / $value_range) * ($graph_height -1);
2eac77fc 886 my $col_series = $self->_get_data_series()->{'stacked_column'};
887 my $series_counter = $self->_get_series_counter() || 0;
488bc70c 888
2eac77fc 889 foreach my $series (@$col_series) {
890 my @data = @{$series->{'data'}};
891 my $data_size = scalar @data;
2eac77fc 892 for (my $i = 0; $i < $data_size; $i++) {
413ce87a 893 my $part1 = $bar_width * $i * $column_series;
894 my $part2 = 0;
895 my $x1 = int($left + $part1 + $part2);
896 my $x2 = int($x1 + $bar_width - $column_padding) - 1;
897 # Special case for when bar_width is less than 1.
898 if ($x2 < $x1) {
899 $x2 = $x1;
900 }
2eac77fc 901
488bc70c 902 my $y1 = int($bottom + ($value_range - $data[$i] + $min_value)/$value_range * $graph_height);
2eac77fc 903
904 if ($data[$i] > 0) {
7422650e 905 my @fill = $self->_data_fill($series_counter, [$x1, $y1, $x2, $zero_position-1]);
906 $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position-1, @fill);
2eac77fc 907 if ($style->{'features'}{'outline'}) {
908 $img->box(xmin => $x1, xmax => $x2, ymin => $y1, ymax => $zero_position, color => $outline_color);
909 }
910 }
911 else {
7422650e 912 my @fill = $self->_data_fill($series_counter, [$x1, $zero_position+1, $x2, $y1]);
913 $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position+1, ymax => $y1, @fill);
2eac77fc 914 if ($style->{'features'}{'outline'}) {
915 $img->box(xmin => $x1, xmax => $x2, ymin => $zero_position+1, ymax => $y1+1, color => $outline_color);
916 }
917 }
918 }
919
920 $series_counter++;
921 }
922 $self->_set_series_counter($series_counter);
488bc70c 923 return 1;
2eac77fc 924}
925
926sub _add_data_series {
927 my $self = shift;
928 my $series_type = shift;
929 my $data_ref = shift;
930 my $series_name = shift;
931
932 my $graph_data = $self->{'graph_data'} || {};
933
934 my $series = $graph_data->{$series_type} || [];
935
936 push @$series, { data => $data_ref, series_name => $series_name };
937
938 $graph_data->{$series_type} = $series;
939
940 $self->{'graph_data'} = $graph_data;
941 return;
942}
943
5057a68f
TC
944=back
945
946=head1 FEATURES
947
2eac77fc 948=over
949
c2c2cb9e 950=item show_horizontal_gridlines()
951
5057a68f
TC
952Feature: horizontal_gridlines
953X<horizontal_gridlines>X<features, horizontal_gridlines>
954
56b495c0
TC
955Enables the C<horizontal_gridlines> feature, which shows horizontal
956gridlines at the y-tics.
957
958The style of the gridlines can be controlled with the
959set_horizontal_gridline_style() method (or by setting the hgrid
960style).
c2c2cb9e 961
962=cut
963
964sub show_horizontal_gridlines {
56b495c0
TC
965 $_[0]->{'custom_style'}{features}{'horizontal_gridlines'} = 1;
966}
967
968=item set_horizontal_gridline_style(style => $style, color => $color)
969
5057a68f
TC
970Style: hgrid.
971X<hgrid>X<style parameters, hgrid>
972
56b495c0
TC
973Set the style and color of horizonal gridlines.
974
975See: L<Imager::Graph/"Line styles">
976
977=cut
978
979sub set_horizontal_gridline_style {
980 my ($self, %opts) = @_;
981
982 $self->{custom_style}{hgrid} ||= {};
983 @{$self->{custom_style}{hgrid}}{keys %opts} = values %opts;
984
985 return 1;
c2c2cb9e 986}
987
5057a68f
TC
988=item show_graph_outline($flag)
989
990Feature: graph_outline
991X<graph_outline>X<features, graph_outline>
992
993If no flag is supplied, unconditionally enable the graph outline.
994
995If $flag is supplied, enable/disable the graph_outline feature based
996on that.
997
998Enabled by default.
999
1000=cut
1001
1002sub show_graph_outline {
1003 my ($self, $flag) = @_;
1004
1005 @_ == 1 and $flag = 1;
1006
1007 $self->{custom_style}{features}{graph_outline} = $flag;
1008
1009 return 1;
1010}
1011
1012=item set_graph_outline_style(color => ...)
1013
1014=item set_graph_outline_style(style => ..., color => ...)
1015
1016Style: graph.outline
1017X<graph.outline>X<style parameters, graph.outline>
1018
1019Sets the style of the graph outline.
1020
1021Default: the style C<fg>.
1022
1023=cut
1024
1025sub set_graph_outline_style {
1026 my ($self, %opts) = @_;
1027
1028 $self->{custom_style}{graph}{outline} = \%opts;
1029
1030 return 1;
1031}
1032
1033=item set_graph_fill_style(I<fill parameters>)
1034
1035Style: graph.fill
1036X<graph.fill>X<style parameters, graph.fill>
1037
1038Set the fill used to fill the graph data area.
1039
1040Default: the style C<bg>.
1041
1042eg.
1043
1044 $graph->set_graph_fill_style(solid => "FF000020", combine => "normal");
1045
1046=cut
1047
1048sub set_graph_fill_style {
1049 my ($self, %opts) = @_;
1050
1051 $self->{custom_style}{graph}{fill} = \%opts;
1052
1053 return 1;
1054}
1055
c2c2cb9e 1056=item use_automatic_axis()
1057
5057a68f
TC
1058Automatically scale the Y axis, based on L<Chart::Math::Axis>. If
1059Chart::Math::Axis isn't installed, this sets an error and returns
1060undef. Returns 1 if it is installed.
c2c2cb9e 1061
1062=cut
1063
1064sub use_automatic_axis {
e554917f 1065 eval { require Chart::Math::Axis; };
c2c2cb9e 1066 if ($@) {
e554917f 1067 return $_[0]->_error("use_automatic_axis - $@\nCalled from ".join(' ', caller)."\n");
c2c2cb9e 1068 }
1069 $_[0]->{'custom_style'}->{'automatic_axis'} = 1;
e554917f 1070 return 1;
c2c2cb9e 1071}
1072
1073
2eac77fc 1074=item set_y_tics($count)
1075
5057a68f
TC
1076Set the number of Y tics to use. Their value and position will be
1077determined by the data range.
2eac77fc 1078
1079=cut
1080
1081sub set_y_tics {
1082 $_[0]->{'y_tics'} = $_[1];
1083}
1084
1085sub _get_y_tics {
28acfd43 1086 return $_[0]->{'y_tics'} || 0;
2eac77fc 1087}
1088
c2c2cb9e 1089sub _remove_tics_from_chart_box {
56b495c0 1090 my ($self, $chart_box, $opts) = @_;
c2c2cb9e 1091
1092 # XXX - bad default
1093 my $tic_width = $self->_get_y_tic_width() || 10;
1094 my @y_tic_box = ($chart_box->[0], $chart_box->[1], $chart_box->[0] + $tic_width, $chart_box->[3]);
1095
1096 # XXX - bad default
56b495c0 1097 my $tic_height = $self->_get_x_tic_height($opts) || 10;
c2c2cb9e 1098 my @x_tic_box = ($chart_box->[0], $chart_box->[3] - $tic_height, $chart_box->[2], $chart_box->[3]);
1099
1100 $self->_remove_box($chart_box, \@y_tic_box);
1101 $self->_remove_box($chart_box, \@x_tic_box);
b748d4ed 1102
1103 # If there's no title, the y-tics will be part off-screen. Half of the x-tic height should be more than sufficient.
1104 my @y_tic_tops = ($chart_box->[0], $chart_box->[1], $chart_box->[2], $chart_box->[1] + int($tic_height / 2));
1105 $self->_remove_box($chart_box, \@y_tic_tops);
1106
267997be 1107 # Make sure that the first and last label fit
56b495c0 1108 if (my $labels = $self->_get_labels($opts)) {
267997be 1109 if (my @box = $self->_text_bbox($labels->[0], 'legend')) {
1110 my @remove_box = ($chart_box->[0],
1111 $chart_box->[1],
1112 $chart_box->[0] + int($box[2] / 2) + 1,
1113 $chart_box->[3]
1114 );
1115
1116 $self->_remove_box($chart_box, \@remove_box);
1117 }
1118 if (my @box = $self->_text_bbox($labels->[-1], 'legend')) {
1119 my @remove_box = ($chart_box->[2] - int($box[2] / 2) - 1,
1120 $chart_box->[1],
1121 $chart_box->[2],
1122 $chart_box->[3]
1123 );
1124
1125 $self->_remove_box($chart_box, \@remove_box);
1126 }
1127 }
c2c2cb9e 1128}
1129
56b495c0 1130sub _get_y_tic_width {
c2c2cb9e 1131 my $self = shift;
1132 my $min = $self->_get_min_value();
1133 my $max = $self->_get_max_value();
1134 my $tic_count = $self->_get_y_tics();
1135
c2c2cb9e 1136 my $interval = ($max - $min) / ($tic_count - 1);
1137
1138 my %text_info = $self->_text_style('legend')
1139 or return;
1140
1141 my $max_width = 0;
1142 for my $count (0 .. $tic_count - 1) {
ed9425ea 1143 my $value = ($count*$interval)+$min;
c2c2cb9e 1144
ed9425ea
TC
1145 if ($interval < 1 || ($value != int($value))) {
1146 $value = sprintf("%.2f", $value);
1147 }
c2c2cb9e 1148 my @box = $self->_text_bbox($value, 'legend');
1149 my $width = $box[2] - $box[0];
1150
1151 # For the tic width
1152 $width += 10;
1153 if ($width > $max_width) {
1154 $max_width = $width;
1155 }
1156 }
1157
1158 return $max_width;
1159}
1160
1161sub _get_x_tic_height {
56b495c0 1162 my ($self, $opts) = @_;
c2c2cb9e 1163
56b495c0 1164 my $labels = $self->_get_labels($opts);
c2c2cb9e 1165
488bc70c 1166 if (!$labels) {
1167 return;
1168 }
1169
c2c2cb9e 1170 my $tic_count = (scalar @$labels) - 1;
1171
1172 my %text_info = $self->_text_style('legend')
1173 or return;
1174
1175 my $max_height = 0;
1176 for my $count (0 .. $tic_count) {
1177 my $label = $labels->[$count];
1178
1179 my @box = $self->_text_bbox($label, 'legend');
1180
1181 my $height = $box[3] - $box[1];
1182
1183 # Padding + the tic
1184 $height += 10;
1185 if ($height > $max_height) {
1186 $max_height = $height;
1187 }
1188 }
1189
1190 return $max_height;
1191}
1192
2eac77fc 1193sub _draw_y_tics {
1194 my $self = shift;
1195 my $min = $self->_get_min_value();
1196 my $max = $self->_get_max_value();
1197 my $tic_count = $self->_get_y_tics();
1198
1199 my $img = $self->_get_image();
1200 my $graph_box = $self->_get_graph_box();
1201 my $image_box = $self->_get_image_box();
1202
1203 my $interval = ($max - $min) / ($tic_count - 1);
1204
1205 my %text_info = $self->_text_style('legend')
1206 or return;
1207
1509eee7 1208 my $line_style = $self->_get_color('outline.line');
56b495c0
TC
1209 my $show_gridlines = $self->{_style}{features}{'horizontal_gridlines'};
1210 my @grid_line = $self->_get_line("hgrid");
1509eee7 1211 my $tic_distance = ($graph_box->[3] - $graph_box->[1]) / ($tic_count - 1);
2eac77fc 1212 for my $count (0 .. $tic_count - 1) {
1213 my $x1 = $graph_box->[0] - 5;
1214 my $x2 = $graph_box->[0] + 5;
1509eee7 1215 my $y1 = int($graph_box->[3] - ($count * $tic_distance));
2eac77fc 1216
c2c2cb9e 1217 my $value = ($count*$interval)+$min;
1218 if ($interval < 1 || ($value != int($value))) {
1219 $value = sprintf("%.2f", $value);
1220 }
23a3585a 1221
2eac77fc 1222 my @box = $self->_text_bbox($value, 'legend')
1223 or return;
1224
1509eee7 1225 $img->line(x1 => $x1, x2 => $x2, y1 => $y1, y2 => $y1, aa => 1, color => $line_style);
2eac77fc 1226
1227 my $width = $box[2];
1228 my $height = $box[3];
1229
1230 $img->string(%text_info,
1231 x => ($x1 - $width - 3),
1232 y => ($y1 + ($height / 2)),
1233 text => $value
1234 );
c2c2cb9e 1235
56b495c0
TC
1236 if ($show_gridlines && $y1 != $graph_box->[1] && $y1 != $graph_box->[3]) {
1237 $self->_line(x1 => $graph_box->[0], y1 => $y1,
1238 x2 => $graph_box->[2], y2 => $y1,
1239 img => $img,
1240 @grid_line);
c2c2cb9e 1241 }
2eac77fc 1242 }
1243
1244}
1245
1246sub _draw_x_tics {
56b495c0 1247 my ($self, $opts) = @_;
2eac77fc 1248
1249 my $img = $self->_get_image();
1250 my $graph_box = $self->_get_graph_box();
1251 my $image_box = $self->_get_image_box();
1252
56b495c0 1253 my $labels = $self->_get_labels($opts);
2eac77fc 1254
1255 my $tic_count = (scalar @$labels) - 1;
1256
1257 my $has_columns = (defined $self->_get_data_series()->{'column'} || defined $self->_get_data_series()->{'stacked_column'});
1258
1259 # If we have columns, we want the x-ticks to show up in the middle of the column, not on the left edge
1260 my $denominator = $tic_count;
1261 if ($has_columns) {
1262 $denominator ++;
1263 }
1264 my $tic_distance = ($graph_box->[2] - $graph_box->[0]) / ($denominator);
1265 my %text_info = $self->_text_style('legend')
1266 or return;
1267
1509eee7 1268 # If automatic axis is turned on, let's be selective about what labels we draw.
1269 my $max_size = 0;
1270 my $tic_skip = 0;
1271 if ($self->_get_number('automatic_axis')) {
1272 foreach my $label (@$labels) {
1273 my @box = $self->_text_bbox($label, 'legend');
1274 if ($box[2] > $max_size) {
1275 $max_size = $box[2];
1276 }
1277 }
1278
1279 # Give the max_size some padding...
1280 $max_size *= 1.2;
1281
1282 $tic_skip = int($max_size / $tic_distance) + 1;
1283 }
1284
1285 my $line_style = $self->_get_color('outline.line');
1286
2eac77fc 1287 for my $count (0 .. $tic_count) {
1509eee7 1288 next if ($count % ($tic_skip + 1));
2eac77fc 1289 my $label = $labels->[$count];
1290 my $x1 = $graph_box->[0] + ($tic_distance * $count);
1291
1292 if ($has_columns) {
1293 $x1 += $tic_distance / 2;
1294 }
1509eee7 1295
1296 $x1 = int($x1);
1297
2eac77fc 1298 my $y1 = $graph_box->[3] + 5;
1299 my $y2 = $graph_box->[3] - 5;
1300
1509eee7 1301 $img->line(x1 => $x1, x2 => $x1, y1 => $y1, y2 => $y2, aa => 1, color => $line_style);
2eac77fc 1302
1303 my @box = $self->_text_bbox($label, 'legend')
1304 or return;
1305
1306 my $width = $box[2];
1307 my $height = $box[3];
1308
1309 $img->string(%text_info,
1310 x => ($x1 - ($width / 2)),
1311 y => ($y1 + ($height + 5)),
1312 text => $label
1313 );
1314
1315 }
1316}
1317
1318sub _valid_input {
1319 my $self = shift;
1320
1321 if (!defined $self->_get_data_series() || !keys %{$self->_get_data_series()}) {
1322 return $self->_error("No data supplied");
1323 }
1324
1325 my $data = $self->_get_data_series();
1326 if (defined $data->{'line'} && !scalar @{$data->{'line'}->[0]->{'data'}}) {
1327 return $self->_error("No values in data series");
1328 }
1329 if (defined $data->{'column'} && !scalar @{$data->{'column'}->[0]->{'data'}}) {
1330 return $self->_error("No values in data series");
1331 }
1332 if (defined $data->{'stacked_column'} && !scalar @{$data->{'stacked_column'}->[0]->{'data'}}) {
1333 return $self->_error("No values in data series");
1334 }
1335
1336 return 1;
1337}
1338
1339sub _set_column_count { $_[0]->{'column_count'} = $_[1]; }
1340sub _set_min_value { $_[0]->{'min_value'} = $_[1]; }
1341sub _set_max_value { $_[0]->{'max_value'} = $_[1]; }
1342sub _set_image_box { $_[0]->{'image_box'} = $_[1]; }
1343sub _set_graph_box { $_[0]->{'graph_box'} = $_[1]; }
1344sub _set_series_counter { $_[0]->{'series_counter'} = $_[1]; }
1345sub _get_column_count { return $_[0]->{'column_count'} }
1346sub _get_min_value { return $_[0]->{'min_value'} }
1347sub _get_max_value { return $_[0]->{'max_value'} }
1348sub _get_image_box { return $_[0]->{'image_box'} }
1349sub _get_graph_box { return $_[0]->{'graph_box'} }
56b495c0 1350sub _reset_series_counter { $_[0]->{series_counter} = 0 }
2eac77fc 1351sub _get_series_counter { return $_[0]->{'series_counter'} }
1352
f94f373e 1353sub _style_defs {
1354 my ($self) = @_;
1355
1356 my %work = %{$self->SUPER::_style_defs()};
1357 $work{area} =
1358 {
1359 opacity => 0.5,
1360 };
1a36ef75 1361 push @{$work{features}}, qw/graph_outline graph_fill/;
56b495c0
TC
1362 $work{hgrid} =
1363 {
1364 color => "lookup(fg)",
1365 style => "solid",
1366 };
f94f373e 1367
1368 return \%work;
1369}
1370
1a36ef75
TC
1371sub _composite {
1372 my ($self) = @_;
56b495c0 1373 return ( $self->SUPER::_composite(), "graph", "hgrid" );
1a36ef75
TC
1374}
1375
2eac77fc 13761;