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