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