]>
Commit | Line | Data |
---|---|---|
35574351 | 1 | package Imager::Graph; |
54ada35d | 2 | require 5.005; |
35574351 TC |
3 | |
4 | =head1 NAME | |
5 | ||
6 | Imager::Graph - Perl extension for producing Graphs using the Imager library. | |
7 | ||
8 | =head1 SYNOPSIS | |
9 | ||
2eac77fc | 10 | use Imager::Graph::Sub_class; |
11 | my $chart = Imager::Graph::Sub_class->new; | |
81453d28 | 12 | my $img = $chart->draw(data=> \@data, ...) |
35574351 | 13 | or die $chart->error; |
1509eee7 | 14 | $img->write(file => 'image.png'); |
35574351 TC |
15 | |
16 | =head1 DESCRIPTION | |
17 | ||
18 | Imager::Graph provides style information to its base classes. It | |
19 | defines the colors, text display information and fills based on both | |
20 | built-in styles and modifications supplied by the user to the draw() | |
21 | method. | |
22 | ||
35574351 TC |
23 | =over |
24 | ||
25 | =cut | |
26 | ||
27 | use strict; | |
28 | use vars qw($VERSION); | |
29 | use Imager qw(:handy); | |
bb0de914 | 30 | use Imager::Fountain; |
35574351 | 31 | |
851c8918 | 32 | $VERSION = '0.08'; |
35574351 | 33 | |
35574351 TC |
34 | # the maximum recursion depth in determining a color, fill or number |
35 | use constant MAX_DEPTH => 10; | |
36 | ||
37 | my $NUM_RE = '(?:[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:[eE][+-]\d+?)?)'; | |
38 | ||
39 | =item new | |
40 | ||
41 | This is a simple constructor. No parameters required. | |
42 | ||
43 | =cut | |
44 | ||
45 | sub new { | |
46 | bless {}, $_[0]; | |
47 | } | |
48 | ||
2eac77fc | 49 | =item set_graph_size($size) |
dfd889da | 50 | |
51 | Sets the size of the graph (in pixels) within the image. The size of the image defaults to 1.5 * $graph_size. | |
52 | ||
53 | =cut | |
54 | ||
2eac77fc | 55 | sub set_graph_size { |
56 | $_[0]->{'custom_style'}->{'size'} = $_[1]; | |
dfd889da | 57 | } |
58 | ||
2eac77fc | 59 | =item set_image_width($width) |
dfd889da | 60 | |
61 | Sets the width of the image in pixels. | |
62 | ||
63 | =cut | |
64 | ||
2eac77fc | 65 | sub set_image_width { |
66 | $_[0]->{'custom_style'}->{'width'} = $_[1]; | |
dfd889da | 67 | } |
68 | ||
2eac77fc | 69 | =item set_image_height($height) |
dfd889da | 70 | |
71 | Sets the height of the image in pixels. | |
72 | ||
73 | =cut | |
74 | ||
2eac77fc | 75 | sub set_image_height { |
76 | $_[0]->{'custom_style'}->{'height'} = $_[1]; | |
dfd889da | 77 | } |
78 | ||
2eac77fc | 79 | =item add_data_series([8, 6, 7, 5, 3, 0, 9], 'Series Name'); |
dfd889da | 80 | |
81 | Adds a data series to the graph. For L<Imager::Graph::Pie>, only one data series can be added. | |
82 | ||
83 | =cut | |
84 | ||
2eac77fc | 85 | sub add_data_series { |
dfd889da | 86 | my $self = shift; |
87 | my $data_ref = shift; | |
88 | my $series_name = shift; | |
89 | ||
90 | my $graph_data = $self->{'graph_data'} || []; | |
91 | ||
92 | push @$graph_data, { data => $data_ref, series_name => $series_name }; | |
1509eee7 | 93 | if (defined $series_name) { |
94 | push @{$self->{'labels'}}, $series_name; | |
95 | } | |
dfd889da | 96 | |
97 | $self->{'graph_data'} = $graph_data; | |
98 | return; | |
99 | } | |
100 | ||
2eac77fc | 101 | sub _get_data_series { |
a17e870a TC |
102 | my ($self, $opts) = @_; |
103 | ||
104 | # return the data supplied to draw() if any. | |
105 | if ($opts->{data}) { | |
106 | # one or multiple series? | |
107 | my $data = $opts->{data}; | |
108 | if (@$data && ref $data->[0] && ref $data->[0] =~ /ARRAY/) { | |
109 | return $data; | |
110 | } | |
111 | else { | |
112 | return [ { data => $data } ]; | |
113 | } | |
114 | } | |
115 | ||
116 | return $self->{'graph_data'}; | |
dfd889da | 117 | } |
118 | ||
2eac77fc | 119 | =item set_labels(['label1', 'label2' ... ]) |
dfd889da | 120 | |
121 | Labels the specific data points. For line/bar graphs, this is the x-axis. For pie graphs, it is the label for the wedges. | |
122 | ||
123 | =cut | |
124 | ||
2eac77fc | 125 | sub set_labels { |
dfd889da | 126 | $_[0]->{'labels'} = $_[1]; |
127 | } | |
128 | ||
2eac77fc | 129 | sub _get_labels { |
a17e870a TC |
130 | my ($self, $opts) = @_; |
131 | ||
132 | $opts->{labels} | |
133 | and return $opts->{labels}; | |
134 | ||
dfd889da | 135 | return $_[0]->{'labels'} |
136 | } | |
137 | ||
2eac77fc | 138 | =item set_title($title) |
dfd889da | 139 | |
140 | Sets the title of the graph. Requires setting a font. | |
141 | ||
142 | =cut | |
143 | ||
2eac77fc | 144 | sub set_title { |
145 | $_[0]->{'custom_style'}->{'title'}->{'text'} = $_[1]; | |
dfd889da | 146 | } |
147 | ||
2eac77fc | 148 | =item set_font($font) |
dfd889da | 149 | |
150 | Sets the font to use for text. Takes an L<Imager::Font> object. | |
151 | ||
152 | =cut | |
153 | ||
2eac77fc | 154 | sub set_font { |
155 | $_[0]->{'custom_style'}->{'font'} = $_[1]; | |
dfd889da | 156 | } |
157 | ||
2eac77fc | 158 | =item set_style($style_name) |
dfd889da | 159 | |
160 | Sets the style to be used for the graph. Imager::Graph comes with several pre-defined styles: fount_lin (default), fount_rad, mono, primary_red, and primary. | |
161 | ||
162 | =cut | |
163 | ||
2eac77fc | 164 | sub set_style { |
dfd889da | 165 | $_[0]->{'style'} = $_[1]; |
166 | } | |
167 | ||
2eac77fc | 168 | sub _get_style { |
a17e870a TC |
169 | my ($self, $opts) = @_; |
170 | ||
171 | $opts->{style} | |
172 | and return $opts->{style}; | |
173 | ||
174 | return $self->{'style'}; | |
dfd889da | 175 | } |
176 | ||
35574351 TC |
177 | =item error |
178 | ||
a22672ea | 179 | Returns an error message. Only valid if the draw() method returns false. |
35574351 TC |
180 | |
181 | =cut | |
182 | ||
183 | sub error { | |
184 | $_[0]->{_errstr}; | |
185 | } | |
186 | ||
187 | =item draw | |
188 | ||
189 | Creates a new image, draws the chart onto that image and returns it. | |
190 | ||
2eac77fc | 191 | Optionally, instead of using the api methods to configure your chart, |
192 | you can supply a C<data> parameter in the format | |
35574351 TC |
193 | required by that particular graph, and if your graph will use any |
194 | text, a C<font> parameter | |
195 | ||
196 | You can also supply many different parameters which control the way | |
197 | the graph looks. These are supplied as keyword, value pairs, where | |
198 | the value can be a hashref containing sub values. | |
199 | ||
200 | The C<style> parameter will selects a basic color set, and possibly | |
201 | sets other related parameters. See L</"STYLES">. | |
202 | ||
aaaa03e1 | 203 | my $font = Imager::Font->new(file => 'ImUgly.ttf'); |
81453d28 | 204 | my $img = $chart->draw( |
205 | data => \@data, | |
206 | font => $font, | |
207 | title => { | |
208 | text => "Hello, World!", | |
209 | size => 36, | |
210 | color => 'FF0000' | |
211 | } | |
212 | ); | |
35574351 TC |
213 | |
214 | When referring to a single sub-value this documentation will refer to | |
215 | 'title.color' rather than 'the color element of title'. | |
216 | ||
217 | Returns the graph image on success, or false on failure. | |
218 | ||
219 | =back | |
220 | ||
221 | =head1 STYLES | |
222 | ||
223 | The currently defined styles are: | |
224 | ||
225 | =over | |
226 | ||
7b94e723 TC |
227 | =item primary |
228 | ||
229 | a light grey background with no outlines. Uses primary colors for the | |
230 | data fills. | |
231 | ||
35574351 TC |
232 | =item primary_red |
233 | ||
234 | a light red background with no outlines. Uses primary colors for the | |
7b94e723 | 235 | data fills. |
35574351 TC |
236 | |
237 | Graphs drawn using this style should save well as a gif, even though | |
238 | some graphs may perform a slight blur. | |
239 | ||
7b94e723 | 240 | This was the default style, but the red was too loud. |
35574351 TC |
241 | |
242 | =item mono | |
243 | ||
244 | designed for monochrome output, such as most laser printers, this uses | |
245 | hatched fills for the data, and no colors. The returned image is a | |
246 | one channel image (which can be overridden with the C<channels> | |
247 | parameter.) | |
248 | ||
249 | You can also override the colors used by all components for background | |
250 | or drawing by supplying C<fg> and/or C<bg> parameters. ie. if you | |
251 | supply C<<fg=>'FF0000', channels=>3>> then the hash fills and anything | |
252 | else will be drawn in red. Another use might be to set a transparent | |
253 | background, by supplying C<<bg=>'00000000', channels=>4>>. | |
254 | ||
255 | This style outlines the legend if present and outlines the hashed fills. | |
256 | ||
35574351 TC |
257 | =item fount_lin |
258 | ||
259 | designed as a "pretty" style this uses linear fountain fills for the | |
260 | background and data fills, and adds a drop shadow. | |
261 | ||
262 | You can override the value used for text and outlines by setting the | |
263 | C<fg> parameter. | |
264 | ||
81453d28 | 265 | This is the default style. |
266 | ||
35574351 TC |
267 | =item fount_rad |
268 | ||
269 | also designed as a "pretty" style this uses radial fountain fills for | |
270 | the data and a linear blue to green fill for the background. | |
271 | ||
272 | =back | |
273 | ||
2eac77fc | 274 | =head1 Style API |
275 | ||
276 | To set or override styles, you can use the following methods: | |
277 | ||
278 | =over 4 | |
279 | ||
280 | =item set_image_background | |
281 | ||
282 | =cut | |
283 | ||
284 | sub set_image_background { | |
285 | $_[0]->{'custom_style'}->{'back'} = $_[1]; | |
286 | } | |
287 | ||
288 | =item set_channels | |
289 | ||
290 | =cut | |
291 | ||
292 | sub set_channels { | |
293 | $_[0]->{'custom_style'}->{'channels'} = $_[1]; | |
294 | } | |
295 | ||
296 | =item set_line_color | |
297 | ||
298 | =cut | |
299 | ||
300 | sub set_line_color { | |
301 | $_[0]->{'custom_style'}->{'line'} = $_[1]; | |
302 | } | |
303 | ||
304 | =item set_title_font_size | |
305 | ||
306 | =cut | |
307 | ||
308 | sub set_title_font_size { | |
309 | $_[0]->{'custom_style'}->{'title'}->{'size'} = $_[1]; | |
310 | } | |
311 | ||
312 | =item set_title_font_color | |
313 | ||
314 | =cut | |
315 | ||
316 | sub set_title_font_color { | |
317 | $_[0]->{'custom_style'}->{'title'}->{'color'} = $_[1]; | |
318 | } | |
319 | ||
320 | =item set_title_horizontal_align | |
321 | ||
322 | =cut | |
323 | ||
324 | sub set_title_horizontal_align { | |
325 | $_[0]->{'custom_style'}->{'title'}->{'halign'} = $_[1]; | |
326 | } | |
327 | ||
328 | =item set_title_vertical_align | |
329 | ||
330 | =cut | |
331 | ||
332 | sub set_title_vertical_align { | |
333 | $_[0]->{'custom_style'}->{'title'}->{'valign'} = $_[1]; | |
334 | } | |
335 | ||
336 | =item set_text_font_color | |
337 | ||
338 | =cut | |
339 | ||
340 | sub set_text_font_color { | |
341 | $_[0]->{'custom_style'}->{'text'}->{'color'} = $_[1]; | |
342 | } | |
343 | ||
344 | =item set_text_font_size | |
345 | ||
346 | =cut | |
347 | ||
348 | sub set_text_font_size { | |
349 | $_[0]->{'custom_style'}->{'text'}->{'size'} = $_[1]; | |
350 | } | |
351 | ||
352 | =item set_graph_background_color | |
353 | ||
354 | =cut | |
355 | ||
356 | sub set_graph_background_color { | |
357 | $_[0]->{'custom_style'}->{'bg'} = $_[1]; | |
358 | } | |
359 | ||
360 | =item set_graph_foreground_color | |
361 | ||
362 | =cut | |
363 | ||
364 | sub set_graph_foreground_color { | |
365 | $_[0]->{'custom_style'}->{'fg'} = $_[1]; | |
366 | } | |
367 | ||
368 | =item set_legend_font_color | |
369 | ||
370 | =cut | |
371 | ||
372 | sub set_legend_font_color { | |
373 | $_[0]->{'custom_style'}->{'legend'}->{'color'} = $_[1]; | |
374 | } | |
375 | ||
376 | =item set_legend_font | |
377 | ||
378 | =cut | |
379 | ||
380 | sub set_legend_font { | |
381 | $_[0]->{'custom_style'}->{'legend'}->{'font'} = $_[1]; | |
382 | } | |
383 | ||
384 | =item set_legend_font_size | |
385 | ||
386 | =cut | |
387 | ||
388 | sub set_legend_font_size { | |
389 | $_[0]->{'custom_style'}->{'legend'}->{'size'} = $_[1]; | |
390 | } | |
391 | ||
392 | =item set_legend_patch_size | |
393 | ||
394 | =cut | |
395 | ||
396 | sub set_legend_patch_size { | |
397 | $_[0]->{'custom_style'}->{'legend'}->{'patchsize'} = $_[1]; | |
398 | } | |
399 | ||
400 | =item set_legend_patch_gap | |
401 | ||
402 | =cut | |
403 | ||
404 | sub set_legend_patch_gap { | |
405 | $_[0]->{'custom_style'}->{'legend'}->{'patchgap'} = $_[1]; | |
406 | } | |
407 | ||
408 | =item set_legend_horizontal_align | |
409 | ||
410 | =cut | |
411 | ||
412 | sub set_legend_horizontal_align { | |
413 | $_[0]->{'custom_style'}->{'legend'}->{'halign'} = $_[1]; | |
414 | } | |
415 | ||
416 | =item set_legend_vertical_align | |
417 | ||
418 | =cut | |
419 | ||
420 | sub set_legend_vertical_align { | |
421 | $_[0]->{'custom_style'}->{'legend'}->{'valign'} = $_[1]; | |
422 | } | |
423 | ||
424 | =item set_legend_padding | |
425 | ||
426 | =cut | |
427 | ||
428 | sub set_legend_padding { | |
429 | $_[0]->{'custom_style'}->{'legend'}->{'padding'} = $_[1]; | |
430 | } | |
431 | ||
432 | =item set_legend_outside_padding | |
433 | ||
434 | =cut | |
435 | ||
436 | sub set_legend_outside_padding { | |
437 | $_[0]->{'custom_style'}->{'legend'}->{'outsidepadding'} = $_[1]; | |
438 | } | |
439 | ||
440 | =item set_legend_fill | |
441 | ||
442 | =cut | |
443 | ||
444 | sub set_legend_fill { | |
445 | $_[0]->{'custom_style'}->{'legend'}->{'fill'} = $_[1]; | |
446 | } | |
447 | ||
448 | =item set_legend_border | |
449 | ||
450 | =cut | |
451 | ||
452 | sub set_legend_border { | |
453 | $_[0]->{'custom_style'}->{'legend'}->{'border'} = $_[1]; | |
454 | } | |
455 | ||
456 | =item set_legend_orientation | |
457 | ||
458 | =cut | |
459 | ||
460 | sub set_legend_orientation { | |
461 | $_[0]->{'custom_style'}->{'legend'}->{'orientation'} = $_[1]; | |
462 | } | |
463 | ||
464 | =item set_callout_font_color | |
465 | ||
466 | =cut | |
467 | ||
468 | sub set_callout_font_color { | |
469 | $_[0]->{'custom_style'}->{'callout'}->{'color'} = $_[1]; | |
470 | } | |
471 | ||
472 | =item set_callout_font | |
473 | ||
474 | =cut | |
475 | ||
476 | sub set_callout_font { | |
477 | $_[0]->{'custom_style'}->{'callout'}->{'font'} = $_[1]; | |
478 | } | |
479 | ||
480 | =item set_callout_font_size | |
481 | ||
482 | =cut | |
483 | ||
484 | sub set_callout_font_size { | |
485 | $_[0]->{'custom_style'}->{'callout'}->{'size'} = $_[1]; | |
486 | } | |
487 | ||
488 | =item set_callout_line_color | |
489 | ||
490 | =cut | |
491 | ||
492 | sub set_callout_line_color { | |
493 | $_[0]->{'custom_style'}->{'callout'}->{'line'} = $_[1]; | |
494 | } | |
495 | ||
496 | =item set_callout_leader_inside_length | |
497 | ||
498 | =cut | |
499 | ||
500 | sub set_callout_leader_inside_length { | |
501 | $_[0]->{'custom_style'}->{'callout'}->{'inside'} = $_[1]; | |
502 | } | |
503 | ||
504 | =item set_callout_leader_outside_length | |
505 | ||
506 | =cut | |
507 | ||
508 | sub set_callout_leader_outside_length { | |
509 | $_[0]->{'custom_style'}->{'callout'}->{'outside'} = $_[1]; | |
510 | } | |
511 | ||
512 | =item set_callout_leader_length | |
513 | ||
514 | =cut | |
515 | ||
516 | sub set_callout_leader_length { | |
517 | $_[0]->{'custom_style'}->{'callout'}->{'leadlen'} = $_[1]; | |
518 | } | |
519 | ||
520 | =item set_callout_gap | |
521 | ||
522 | =cut | |
523 | ||
524 | sub set_callout_gap { | |
525 | $_[0]->{'custom_style'}->{'callout'}->{'gap'} = $_[1]; | |
526 | } | |
527 | ||
528 | =item set_label_font_color | |
529 | ||
530 | =cut | |
531 | ||
532 | sub set_label_font_color { | |
533 | $_[0]->{'custom_style'}->{'label'}->{'color'} = $_[1]; | |
534 | } | |
535 | ||
536 | =item set_label_font | |
537 | ||
538 | =cut | |
539 | ||
540 | sub set_label_font { | |
541 | $_[0]->{'custom_style'}->{'label'}->{'font'} = $_[1]; | |
542 | } | |
543 | ||
544 | =item set_label_font_size | |
545 | ||
546 | =cut | |
547 | ||
548 | sub set_label_font_size { | |
549 | $_[0]->{'custom_style'}->{'label'}->{'size'} = $_[1]; | |
550 | } | |
551 | ||
552 | =item set_drop_shadow_fill_color | |
553 | ||
554 | =cut | |
555 | ||
556 | sub set_drop_shadow_fill_color { | |
557 | $_[0]->{'custom_style'}->{'dropshadow'}->{'fill'} = $_[1]; | |
558 | } | |
559 | ||
560 | =item set_drop_shadow_offset | |
561 | ||
562 | =cut | |
563 | ||
564 | sub set_drop_shadow_offset { | |
565 | $_[0]->{'custom_style'}->{'dropshadow'}->{'off'} = $_[1]; | |
566 | } | |
567 | ||
568 | =item set_drop_shadowXOffset | |
569 | ||
570 | =cut | |
571 | ||
572 | sub set_drop_shadowXOffset { | |
573 | $_[0]->{'custom_style'}->{'dropshadow'}->{'offx'} = $_[1]; | |
574 | } | |
575 | ||
576 | =item set_drop_shadowYOffset | |
577 | ||
578 | =cut | |
579 | ||
580 | sub set_drop_shadowYOffset { | |
581 | $_[0]->{'custom_style'}->{'dropshadow'}->{'offy'} = $_[1]; | |
582 | } | |
583 | ||
584 | =item set_drop_shadow_filter | |
585 | ||
586 | =cut | |
587 | ||
588 | sub set_drop_shadow_filter { | |
589 | $_[0]->{'custom_style'}->{'dropshadow'}->{'filter'} = $_[1]; | |
590 | } | |
591 | ||
592 | =item set_outline_color | |
593 | ||
594 | =cut | |
595 | ||
596 | sub set_outline_color { | |
597 | $_[0]->{'custom_style'}->{'outline'}->{'line'} = $_[1]; | |
598 | } | |
599 | ||
600 | =item set_data_area_fills | |
601 | ||
602 | =cut | |
603 | ||
604 | sub set_data_area_fills { | |
605 | $_[0]->{'custom_style'}->{'fills'} = $_[1]; | |
606 | } | |
607 | ||
608 | =item set_data_line_colors | |
609 | ||
610 | =cut | |
611 | ||
612 | sub set_data_line_colors { | |
613 | $_[0]->{'custom_style'}->{'colors'} = $_[1]; | |
614 | } | |
615 | ||
616 | =back | |
617 | ||
35574351 TC |
618 | =head1 FEATURES |
619 | ||
620 | Each graph type has a number of features. These are used to add | |
5057a68f TC |
621 | various items that are displayed in the graph area. |
622 | ||
623 | Features can be controlled by calling methods on the graph object, or | |
624 | by passing a C<features> parameter to draw(). | |
625 | ||
626 | Some common features are: | |
2eac77fc | 627 | |
628 | =over | |
629 | ||
630 | =item show_legend() | |
631 | ||
5057a68f TC |
632 | Feature: legend |
633 | X<legend><features, legend> | |
634 | ||
635 | adds a box containing boxes filled with the data fills, with | |
2eac77fc | 636 | the labels provided to the draw method. The legend will only be |
637 | displayed if both the legend feature is enabled and labels are | |
638 | supplied. | |
639 | ||
640 | =cut | |
641 | ||
642 | sub show_legend { | |
643 | $_[0]->{'custom_style'}->{'features'}->{'legend'} = 1; | |
644 | } | |
645 | ||
646 | =item show_outline() | |
647 | ||
5057a68f TC |
648 | Feature: outline |
649 | X<outline>X<features, outline> | |
650 | ||
651 | If enabled, draw a border around the elements representing data in the | |
652 | graph, eg. around each pie segments on a pie chart, around each bar on | |
653 | a bar chart. | |
2eac77fc | 654 | |
655 | =cut | |
656 | ||
657 | sub show_outline { | |
658 | $_[0]->{'custom_style'}->{'features'}->{'outline'} = 1; | |
659 | } | |
660 | ||
661 | =item show_labels() | |
662 | ||
5057a68f TC |
663 | Feature: labels |
664 | X<labels>X<features, labels> | |
665 | ||
2eac77fc | 666 | labels each data fill, usually by including text inside the data fill. |
667 | If the text does not fit in the fill, they could be displayed in some | |
5057a68f TC |
668 | other form, eg. as callouts in a pie graph. |
669 | ||
670 | For pie charts there isn't much point in enabling both the C<legend> | |
671 | and C<labels> features. | |
672 | ||
673 | For other charts, the labels label the independent variable, while the | |
674 | legend describes the color used to plot the dependent variables. | |
2eac77fc | 675 | |
676 | =cut | |
677 | ||
678 | sub show_labels { | |
679 | $_[0]->{'custom_style'}->{'features'}->{'labels'} = 1; | |
680 | } | |
681 | ||
682 | =item show_drop_shadow() | |
683 | ||
5057a68f TC |
684 | Feature: dropshadow |
685 | X<dropshadow>X<features, dropshadow> | |
686 | ||
2eac77fc | 687 | a simple drop shadow is shown behind some of the graph elements. |
688 | ||
689 | =cut | |
690 | ||
691 | sub show_drop_shadow { | |
692 | $_[0]->{'custom_style'}->{'features'}->{'dropshadow'} = 1; | |
693 | } | |
694 | ||
695 | =item reset_features() | |
696 | ||
5057a68f TC |
697 | Unsets all of the features. |
698 | ||
699 | Note: this disables all features, even those enabled by default for a | |
700 | style. They can then be enabled by calling feature methods or by | |
701 | supplying a C<feature> parameter to the draw() method. | |
2eac77fc | 702 | |
703 | =cut | |
704 | ||
705 | sub reset_features { | |
706 | $_[0]->{'custom_style'}->{'features'} = {}; | |
707 | $_[0]->{'custom_style'}->{'features'}->{'reset'} = 1; | |
708 | } | |
709 | ||
710 | =back | |
711 | ||
5057a68f TC |
712 | Additionally, features can be set by passing them into the draw() |
713 | method, named as above: | |
35574351 TC |
714 | |
715 | =over | |
716 | ||
5057a68f | 717 | =item * |
35574351 | 718 | |
5057a68f TC |
719 | if supplied as an array reference, then any element C<no>I<featurename> will |
720 | disable that feature, while an element I<featurename> will enable it. | |
35574351 | 721 | |
5057a68f | 722 | =item * |
35574351 | 723 | |
5057a68f TC |
724 | if supplied as a scalar, it is treated as if it were a reference to |
725 | an array containing only that scalar. | |
35574351 | 726 | |
5057a68f | 727 | =item * |
35574351 | 728 | |
5057a68f TC |
729 | if supplied as a hash reference, then a C<reset> key with a true value |
730 | will avoid inheriting any default features, a key I<feature> with a | |
731 | false value will disable that feature and a key I<feature> with a true | |
732 | value will enable that feature. | |
35574351 TC |
733 | |
734 | =back | |
735 | ||
736 | Each graph also has features specific to that graph. | |
737 | ||
738 | =head1 COMMON PARAMETERS | |
739 | ||
740 | When referring to a single sub-value this documentation will refer to | |
741 | 'title.color' rather than 'the color element of title'. | |
742 | ||
743 | Normally, except for the font parameter, these are controlled by | |
744 | styles, but these are the style parameters I'd mostly likely expect | |
745 | you want to use: | |
746 | ||
747 | =over | |
748 | ||
749 | =item font | |
750 | ||
751 | the Imager font object used to draw text on the chart. | |
752 | ||
753 | =item back | |
754 | ||
755 | the background fill for the graph. Default depends on the style. | |
756 | ||
757 | =item size | |
758 | ||
759 | the base size of the graph image. Default: 256 | |
760 | ||
761 | =item width | |
762 | ||
763 | the width of the graph image. Default: 1.5 * size (384) | |
764 | ||
765 | =item height | |
766 | ||
767 | the height of the graph image. Default: size (256) | |
768 | ||
769 | =item channels | |
770 | ||
771 | the number of channels in the image. Default: 3 (the 'mono' style | |
772 | sets this to 1). | |
773 | ||
774 | =item line | |
775 | ||
776 | the color used for drawing lines, such as outlines or callouts. | |
777 | Default depends on the current style. Set to undef to remove the | |
778 | outline from a style. | |
779 | ||
780 | =item title | |
781 | ||
782 | the text used for a graph title. Default: no title. Note: this is | |
783 | the same as the title=>{ text => ... } field. | |
784 | ||
785 | =over | |
786 | ||
787 | =item halign | |
788 | ||
789 | horizontal alignment of the title in the graph, one of 'left', | |
790 | 'center' or 'right'. Default: center | |
791 | ||
792 | =item valign | |
793 | ||
794 | vertical alignment of the title, one of 'top', 'center' or 'right'. | |
795 | Default: top. It's probably a bad idea to set this to 'center' unless | |
796 | you have a very short title. | |
797 | ||
798 | =back | |
799 | ||
800 | =item text | |
801 | ||
802 | This contains basic defaults used in drawing text. | |
803 | ||
804 | =over | |
805 | ||
806 | =item color | |
807 | ||
808 | the default color used for all text, defaults to the fg color. | |
809 | ||
810 | =item size | |
811 | ||
812 | the base size used for text, also used to scale many graph elements. | |
813 | Default: 14. | |
814 | ||
815 | =back | |
816 | ||
817 | =back | |
818 | ||
819 | =head1 BEYOND STYLES | |
820 | ||
821 | In most cases you will want to use just the styles, but you may want | |
822 | to exert more control over the way your chart looks. This section | |
823 | describes the options you can use to control the way your chart looks. | |
824 | ||
825 | Hopefully you don't need to read this. | |
826 | ||
827 | =over | |
828 | ||
829 | =item back | |
830 | ||
831 | The background of the graph. | |
832 | ||
833 | =item bg | |
834 | ||
835 | =item fg | |
836 | ||
837 | Used to define basic background and foreground colors for the graph. | |
838 | The bg color may be used for the background of the graph, and is used | |
5057a68f | 839 | as a default for the background of hatched fills. The fg is used as |
35574351 TC |
840 | the default for line and text colors. |
841 | ||
842 | =item font | |
843 | ||
844 | The default font used by the graph. Normally you should supply this | |
845 | if your graph as any text. | |
846 | ||
847 | =item line | |
848 | ||
849 | The default line color. | |
850 | ||
851 | =item text | |
852 | ||
853 | defaults for drawing text. Other textual graph elements will inherit | |
854 | or modify these values. | |
855 | ||
856 | =over | |
857 | ||
858 | =item color | |
859 | ||
860 | default text color, defaults to the I<fg> color. | |
861 | ||
862 | =item size | |
863 | ||
864 | default text size. Default: 14. This is used to scale many graph | |
865 | elements, including padding and leader sizes. Other text elements | |
866 | will either use or scale this value. | |
867 | ||
868 | =item font | |
869 | ||
870 | default font object. Inherited from I<font>, which should have been | |
871 | supplied by the caller. | |
872 | ||
873 | =back | |
874 | ||
875 | =item title | |
876 | ||
877 | If you supply a scalar value for this element, it will be stored in | |
878 | the I<text> field. | |
879 | ||
880 | Defines the text, font and layout information for the title. | |
881 | ||
882 | =over | |
883 | ||
884 | =item color | |
885 | ||
886 | The color of the title, inherited from I<text.color>. | |
887 | ||
888 | =item font | |
889 | ||
890 | The font object used for the title, inherited from I<text.font>. | |
891 | ||
892 | =item size | |
893 | ||
894 | size of the title text. Default: double I<text.size> | |
895 | ||
896 | =item halign | |
897 | ||
898 | =item valign | |
899 | ||
900 | The horizontal and vertical alignment of the title. | |
901 | ||
902 | =back | |
903 | ||
904 | =item legend | |
905 | ||
906 | defines attributes of the graph legend, if present. | |
907 | ||
908 | =over | |
909 | ||
910 | =item color | |
911 | ||
912 | =item font | |
913 | ||
914 | =item size | |
915 | ||
916 | text attributes for the labels used in the legend. | |
917 | ||
918 | =item patchsize | |
919 | ||
920 | the width and height of the color patch in the legend. Defaults to | |
921 | 90% of the legend text size. | |
922 | ||
923 | =item patchgap | |
924 | ||
925 | the minimum gap between patches in pixels. Defaults to 30% of the | |
926 | patchsize. | |
927 | ||
928 | =item patchborder | |
929 | ||
930 | the color of the border drawn around each patch. Inherited from I<line>. | |
931 | ||
932 | =item halign | |
933 | ||
934 | =item valign | |
935 | ||
936 | the horizontal and vertical alignment of the legend within the graph. | |
937 | Defaults to 'right' and 'top'. | |
938 | ||
939 | =item padding | |
940 | ||
5057a68f | 941 | the gap between the legend patches and text and the outside of its |
35574351 TC |
942 | box, or to the legend border, if any. |
943 | ||
944 | =item outsidepadding | |
945 | ||
946 | the gap between the border and the outside of the legend's box. This | |
947 | is only used if the I<legend.border> attribute is defined. | |
948 | ||
949 | =item fill | |
950 | ||
951 | the background fill for the legend. Default: none | |
952 | ||
953 | =item border | |
954 | ||
955 | the border color of the legend. Default: none (no border is drawn | |
956 | around the legend.) | |
957 | ||
33a928b7 TC |
958 | =item orientation |
959 | ||
960 | The orientation of the legend. If this is C<vertical> the the patches | |
961 | and labels are stacked on top of each other. If this is C<horizontal> | |
962 | the patchs and labels are word wrapped across the image. Default: | |
963 | vertical. | |
964 | ||
35574351 TC |
965 | =back |
966 | ||
33a928b7 TC |
967 | For example to create a horizontal legend with borderless patches, |
968 | darker than the background, you might do: | |
969 | ||
970 | my $im = $chart->draw | |
971 | (..., | |
972 | legend => | |
973 | { | |
974 | patchborder => undef, | |
975 | orientation => 'horizontal', | |
976 | fill => { solid => Imager::Color->new(0, 0, 0, 32), } | |
977 | }, | |
978 | ...); | |
979 | ||
35574351 TC |
980 | =item callout |
981 | ||
982 | defines attributes for graph callouts, if any are present. eg. if the | |
983 | pie graph cannot fit the label into the pie graph segement it will | |
984 | present it as a callout. | |
985 | ||
986 | =over | |
987 | ||
988 | =item color | |
989 | ||
990 | =item font | |
991 | ||
992 | =item size | |
993 | ||
994 | the text attributes of the callout label. Inherited from I<text>. | |
995 | ||
996 | =item line | |
997 | ||
998 | the color of the callout lines. Inherited from I<line> | |
999 | ||
1000 | =item inside | |
1001 | ||
1002 | =item outside | |
1003 | ||
1004 | the length of the leader on the inside and the outside of the fill, | |
1005 | usually at some angle. Both default to the size of the callout text. | |
1006 | ||
1007 | =item leadlen | |
1008 | ||
1009 | the length of the horizontal portion of the leader. Default: | |
1010 | I<callout.size>. | |
1011 | ||
1012 | =item gap | |
1013 | ||
1014 | the gap between the callout leader and the callout text. Defaults to | |
1015 | 30% of the text callout size. | |
1016 | ||
1017 | =back | |
1018 | ||
1019 | =item label | |
1020 | ||
1021 | defines attributes for labels drawn into the data areas of a graph. | |
1022 | ||
1023 | =over | |
1024 | ||
1025 | =item color | |
1026 | ||
1027 | =item font | |
1028 | ||
1029 | =item size | |
1030 | ||
1031 | The text attributes of the labels. Inherited from I<text>. | |
1032 | ||
1033 | =back | |
1034 | ||
1035 | =item dropshadow | |
1036 | ||
1037 | the attributes of the graph's drop shadow | |
1038 | ||
1039 | =over | |
1040 | ||
1041 | =item fill | |
1042 | ||
1043 | the fill used for the drop shadow. Default: '404040' (dark gray) | |
1044 | ||
1045 | =item off | |
1046 | ||
1047 | the offset of the drop shadow. A convenience value inherited by offx | |
1048 | and offy. Default: 40% of I<text.size>. | |
1049 | ||
1050 | =item offx | |
1051 | ||
1052 | =item offy | |
1053 | ||
1054 | the horizontal and vertical offsets of the drop shadow. Both | |
1055 | inherited from I<dropshadow.off>. | |
1056 | ||
1057 | =item filter | |
1058 | ||
1059 | the filter description passed to Imager's filter method to blur the | |
1060 | drop shadow. Default: an 11 element convolution filter. | |
1061 | ||
1062 | =back | |
1063 | ||
1064 | =item outline | |
1065 | ||
1066 | describes the lines drawn around filled data areas, such as the | |
1067 | segments of a pie chart. | |
1068 | ||
1069 | =over | |
1070 | ||
1071 | =item line | |
1072 | ||
1073 | the line color of the outlines, inherited from I<line>. | |
1074 | ||
1075 | =back | |
1076 | ||
1077 | =item fills | |
1078 | ||
1079 | a reference to an array containing fills for each data item. | |
1080 | ||
1081 | You can mix fill types, ie. using a simple color for the first item, a | |
1082 | hatched fill for the second and a fountain fill for the next. | |
1083 | ||
1084 | =back | |
1085 | ||
1086 | =head1 HOW VALUES WORK | |
1087 | ||
1088 | Internally rather than specifying literal color, fill, or font objects | |
1089 | or literal sizes for each element, Imager::Graph uses a number of | |
1090 | special values to inherit or modify values taken from other graph | |
1091 | element names. | |
1092 | ||
1093 | =head2 Specifying colors | |
1094 | ||
1095 | You can specify colors by either supplying an Imager::Color object, by | |
1096 | supplying lookup of another color, or by supplying a single value that | |
1097 | Imager::Color::new can use as an initializer. The most obvious is | |
1098 | just a 6 or 8 digit hex value representing the red, green, blue and | |
1099 | optionally alpha channels of the image. | |
1100 | ||
1101 | You can lookup another color by using the lookup() "function", for | |
1102 | example if you give a color as "lookup(fg)" then Imager::Graph will | |
1103 | look for the fg element in the current style (or as overridden by | |
1104 | you.) This is used internally by Imager::Graph to set up the | |
1105 | relationships between the colors of various elements, for example the | |
1106 | default style information contains: | |
1107 | ||
1108 | text=>{ | |
d7fd5863 | 1109 | color=>'lookup(fg)', |
35574351 TC |
1110 | ... |
1111 | }, | |
1112 | legend =>{ | |
d7fd5863 | 1113 | color=>'lookup(text.color)', |
35574351 TC |
1114 | ... |
1115 | }, | |
1116 | ||
1117 | So by setting the I<fg> color, you also set the default text color, | |
1118 | since each text element uses lookup(text.color) as its value. | |
1119 | ||
1120 | =head2 Specifying fills | |
1121 | ||
1122 | Fills can be used for the graph background color, the background color | |
1123 | for the legend block and for the fills used for each data element. | |
1124 | ||
1125 | You can specify a fill as a L<color value|Specifying colors> or as a | |
33a928b7 | 1126 | general fill, see L<Imager::Fill> for details. |
35574351 TC |
1127 | |
1128 | You don't need (or usually want) to call Imager::Fill::new yourself, | |
1129 | since the various fill functions will call it for you, and | |
1130 | Imager::Graph provides some hooks to make them more useful. | |
1131 | ||
1132 | =over | |
1133 | ||
1134 | =item * | |
1135 | ||
1136 | with hatched fills, if you don't supply a 'fg' or 'bg' parameter, | |
1137 | Imager::Graph will supply the current graph fg and bg colors. | |
1138 | ||
1139 | =item * | |
1140 | ||
1141 | with fountain fill, you can supply the xa_ratio, ya_ratio, xb_ratio | |
1142 | and yb_ratio parameters, and they will be scaled in the fill area to | |
1143 | define the fountain fills xa, ya, xb and yb parameters. | |
1144 | ||
1145 | =back | |
1146 | ||
1147 | As with colors, you can use lookup(name) or lookup(name1.name2) to | |
1148 | have one element to inherit the fill of another. | |
1149 | ||
33a928b7 TC |
1150 | Imager::Graph defaults the fill combine value to C<'normal'>. This |
1151 | doesn't apply to simple color fills. | |
1152 | ||
35574351 TC |
1153 | =head2 Specifying numbers |
1154 | ||
1155 | You can specify various numbers, usually representing the size of | |
1156 | something, commonly text, but sometimes the length of a line or the | |
1157 | size of a gap. | |
1158 | ||
1159 | You can use the same lookup mechanism as with colors and fills, but | |
1160 | you can also scale values. For example, 'scale(0.5,text.size)' will | |
1161 | return half the size of the normal text size. | |
1162 | ||
1163 | As with colors, this is used internally to scale graph elements based | |
1164 | on the base text size. If you change the base text size then other | |
1165 | graph elements will scale as well. | |
1166 | ||
1167 | =head2 Specifying other elements | |
1168 | ||
1169 | Other elements, such as fonts, or parameters for a filter, can also | |
1170 | use the lookup(name) mechanism. | |
1171 | ||
1172 | =head1 INTERNAL METHODS | |
1173 | ||
1174 | Only useful if you need to fix bugs, add features or create a new | |
1175 | graph class. | |
1176 | ||
1177 | =over | |
1178 | ||
1179 | =cut | |
1180 | ||
1181 | my %style_defs = | |
1182 | ( | |
1183 | back=> 'lookup(bg)', | |
1184 | line=> 'lookup(fg)', | |
49a35584 | 1185 | aa => 1, |
35574351 | 1186 | text=>{ |
d7fd5863 | 1187 | color => 'lookup(fg)', |
35574351 | 1188 | font => 'lookup(font)', |
d7fd5863 | 1189 | size => 14, |
49a35584 | 1190 | aa => 'lookup(aa)', |
d7fd5863 | 1191 | }, |
35574351 | 1192 | title=>{ |
d7fd5863 | 1193 | color => 'lookup(text.color)', |
35574351 | 1194 | font => 'lookup(text.font)', |
d7fd5863 TC |
1195 | halign => 'center', |
1196 | valign => 'top', | |
1197 | size => 'scale(text.size,2.0)', | |
49a35584 | 1198 | aa => 'lookup(text.aa)', |
d7fd5863 | 1199 | }, |
35574351 | 1200 | legend =>{ |
d7fd5863 | 1201 | color => 'lookup(text.color)', |
35574351 | 1202 | font => 'lookup(text.font)', |
49a35584 | 1203 | aa => 'lookup(text.aa)', |
d7fd5863 TC |
1204 | size => 'lookup(text.size)', |
1205 | patchsize => 'scale(legend.size,0.9)', | |
1206 | patchgap => 'scale(legend.patchsize,0.3)', | |
1207 | patchborder => 'lookup(line)', | |
1208 | halign => 'right', | |
1209 | valign => 'top', | |
1210 | padding => 'scale(legend.size,0.3)', | |
1211 | outsidepadding => 'scale(legend.padding,0.4)', | |
1212 | }, | |
35574351 | 1213 | callout => { |
d7fd5863 | 1214 | color => 'lookup(text.color)', |
35574351 | 1215 | font => 'lookup(text.font)', |
d7fd5863 TC |
1216 | size => 'lookup(text.size)', |
1217 | line => 'lookup(line)', | |
1218 | inside => 'lookup(callout.size)', | |
1219 | outside => 'lookup(callout.size)', | |
1220 | leadlen => 'scale(0.8,callout.size)', | |
1221 | gap => 'scale(callout.size,0.3)', | |
49a35584 TC |
1222 | aa => 'lookup(text.aa)', |
1223 | lineaa => 'lookup(lineaa)', | |
d7fd5863 | 1224 | }, |
35574351 TC |
1225 | label => { |
1226 | font => 'lookup(text.font)', | |
d7fd5863 TC |
1227 | size => 'lookup(text.size)', |
1228 | color => 'lookup(text.color)', | |
35574351 TC |
1229 | hpad => 'lookup(label.pad)', |
1230 | vpad => 'lookup(label.pad)', | |
1231 | pad => 'scale(label.size,0.2)', | |
1232 | pcformat => sub { sprintf "%s (%.0f%%)", $_[0], $_[1] }, | |
1233 | pconlyformat => sub { sprintf "%.1f%%", $_[0] }, | |
49a35584 TC |
1234 | aa => 'lookup(text.aa)', |
1235 | lineaa => 'lookup(lineaa)', | |
d7fd5863 | 1236 | }, |
35574351 | 1237 | dropshadow => { |
320f5a49 | 1238 | fill => { solid => Imager::Color->new(0, 0, 0, 96) }, |
35574351 TC |
1239 | off => 'scale(0.4,text.size)', |
1240 | offx => 'lookup(dropshadow.off)', | |
1241 | offy => 'lookup(dropshadow.off)', | |
1242 | filter => { type=>'conv', | |
1243 | # this needs a fairly heavy blur | |
1244 | coef=>[0.1, 0.2, 0.4, 0.6, 0.7, 0.9, 1.2, | |
1245 | 0.9, 0.7, 0.6, 0.4, 0.2, 0.1 ] }, | |
1246 | }, | |
1a36ef75 TC |
1247 | # controls the outline of graph elements representing data, eg. pie |
1248 | # slices, bars or columns | |
35574351 TC |
1249 | outline => { |
1250 | line =>'lookup(line)', | |
49a35584 | 1251 | lineaa => 'lookup(lineaa)', |
35574351 | 1252 | }, |
1a36ef75 TC |
1253 | # controls the outline and background of the data area of the chart |
1254 | graph => | |
1255 | { | |
1256 | fill => "lookup(bg)", | |
1257 | outline => "lookup(fg)", | |
1258 | }, | |
35574351 TC |
1259 | size=>256, |
1260 | width=>'scale(1.5,size)', | |
1261 | height=>'lookup(size)', | |
49a35584 TC |
1262 | |
1263 | # yes, the handling of fill and line AA is inconsistent, lack of | |
1264 | # forethought, unfortunately | |
1265 | fill => { | |
1266 | aa => 'lookup(aa)', | |
1267 | }, | |
1268 | lineaa => 'lookup(aa)', | |
0c2d2199 TC |
1269 | |
1270 | line_markers =>[ | |
1271 | { shape => 'circle', radius => 4 }, | |
1272 | { shape => 'square', radius => 4 }, | |
1273 | { shape => 'diamond', radius => 4 }, | |
1274 | { shape => 'triangle', radius => 4 }, | |
1275 | { shape => 'x', radius => 4 }, | |
1276 | { shape => 'plus', radius => 4 }, | |
1277 | ], | |
35574351 TC |
1278 | ); |
1279 | ||
1280 | =item _error($message) | |
1281 | ||
1282 | Sets the error field of the object and returns an empty list or undef, | |
1283 | depending on context. Should be used for error handling, since it may | |
1284 | provide some user hooks at some point. | |
1285 | ||
f68db40f TC |
1286 | The intended usage is: |
1287 | ||
1288 | some action | |
1289 | or return $self->_error("error description"); | |
1290 | ||
1291 | You should almost always return the result of _error() or return | |
1292 | immediately afterwards. | |
1293 | ||
35574351 TC |
1294 | =cut |
1295 | ||
1296 | sub _error { | |
1297 | my ($self, $error) = @_; | |
1298 | ||
1299 | $self->{_errstr} = $error; | |
1300 | ||
1301 | return; | |
1302 | } | |
1303 | ||
1304 | ||
1305 | =item _style_defs() | |
1306 | ||
1307 | Returns the style defaults, such as the relationships between line | |
1308 | color and text color. | |
1309 | ||
1310 | Intended to be over-ridden by base classes to provide graph specific | |
1311 | defaults. | |
1312 | ||
1313 | =cut | |
1314 | ||
1315 | sub _style_defs { | |
1316 | \%style_defs; | |
1317 | } | |
1318 | ||
81453d28 | 1319 | # Let's make the default something that looks really good, so folks will be interested enough to customize the style. |
1320 | my $def_style = 'fount_lin'; | |
35574351 TC |
1321 | |
1322 | my %styles = | |
1323 | ( | |
7b94e723 TC |
1324 | primary => |
1325 | { | |
1326 | fills=> | |
1327 | [ | |
1328 | qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF) | |
1329 | ], | |
1330 | fg=>'000000', | |
2eac77fc | 1331 | negative_bg=>'EEEEEE', |
7b94e723 TC |
1332 | bg=>'E0E0E0', |
1333 | legend=> | |
1334 | { | |
1335 | #patchborder=>'000000' | |
1336 | }, | |
1337 | }, | |
35574351 TC |
1338 | primary_red => |
1339 | { | |
1340 | fills=> | |
1341 | [ | |
1342 | qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF) | |
1343 | ], | |
1344 | fg=>'000000', | |
2eac77fc | 1345 | negative_bg=>'EEEEEE', |
35574351 TC |
1346 | bg=>'C08080', |
1347 | legend=> | |
1348 | { | |
1349 | patchborder=>'000000' | |
1350 | }, | |
1351 | }, | |
1352 | mono => | |
1353 | { | |
1354 | fills=> | |
1355 | [ | |
1356 | { hatch=>'slash2' }, | |
1357 | { hatch=>'slosh2' }, | |
1358 | { hatch=>'vline2' }, | |
1359 | { hatch=>'hline2' }, | |
1360 | { hatch=>'cross2' }, | |
1361 | { hatch=>'grid2' }, | |
1362 | { hatch=>'stipple3' }, | |
1363 | { hatch=>'stipple2' }, | |
1364 | ], | |
1365 | channels=>1, | |
1366 | bg=>'FFFFFF', | |
1367 | fg=>'000000', | |
2eac77fc | 1368 | negative_bg=>'EEEEEE', |
35574351 TC |
1369 | features=>{ outline=>1 }, |
1370 | pie =>{ | |
1371 | blur=>undef, | |
1372 | }, | |
49a35584 | 1373 | aa => 0, |
e68c6863 TC |
1374 | line_markers => |
1375 | [ | |
1376 | { shape => "x", radius => 4 }, | |
1377 | { shape => "plus", radius => 4 }, | |
1378 | { shape => "open_circle", radius => 4 }, | |
1379 | { shape => "open_diamond", radius => 5 }, | |
1380 | { shape => "open_square", radius => 4 }, | |
1381 | { shape => "open_triangle", radius => 4 }, | |
1382 | { shape => "x", radius => 8 }, | |
1383 | { shape => "plus", radius => 8 }, | |
1384 | { shape => "open_circle", radius => 8 }, | |
1385 | { shape => "open_diamond", radius => 10 }, | |
1386 | { shape => "open_square", radius => 8 }, | |
1387 | { shape => "open_triangle", radius => 8 }, | |
1388 | ], | |
35574351 | 1389 | }, |
bb0de914 | 1390 | fount_lin => |
35574351 TC |
1391 | { |
1392 | fills=> | |
1393 | [ | |
1394 | { fountain=>'linear', | |
1395 | xa_ratio=>0.13, ya_ratio=>0.13, xb_ratio=>0.87, yb_ratio=>0.87, | |
35574351 | 1396 | segments => Imager::Fountain->simple(positions=>[0, 1], |
d7fd5863 | 1397 | colors=>[ NC('FFC0C0'), NC('FF0000') ]), |
35574351 TC |
1398 | }, |
1399 | { fountain=>'linear', | |
1400 | xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, | |
1401 | segments => Imager::Fountain->simple(positions=>[0, 1], | |
d7fd5863 | 1402 | colors=>[ NC('C0FFC0'), NC('00FF00') ]), |
35574351 TC |
1403 | }, |
1404 | { fountain=>'linear', | |
1405 | xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, | |
1406 | segments => Imager::Fountain->simple(positions=>[0, 1], | |
d7fd5863 | 1407 | colors=>[ NC('C0C0FF'), NC('0000FF') ]), |
35574351 TC |
1408 | }, |
1409 | { fountain=>'linear', | |
1410 | xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, | |
1411 | segments => Imager::Fountain->simple(positions=>[0, 1], | |
d7fd5863 | 1412 | colors=>[ NC('FFFFC0'), NC('FFFF00') ]), |
35574351 TC |
1413 | }, |
1414 | { fountain=>'linear', | |
1415 | xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, | |
1416 | segments => Imager::Fountain->simple(positions=>[0, 1], | |
d7fd5863 | 1417 | colors=>[ NC('C0FFFF'), NC('00FFFF') ]), |
35574351 TC |
1418 | }, |
1419 | { fountain=>'linear', | |
1420 | xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, | |
1421 | segments => Imager::Fountain->simple(positions=>[0, 1], | |
d7fd5863 | 1422 | colors=>[ NC('FFC0FF'), NC('FF00FF') ]), |
35574351 TC |
1423 | }, |
1424 | ], | |
dfd889da | 1425 | colors => [ |
1426 | qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF) | |
1427 | ], | |
35574351 TC |
1428 | back=>{ fountain=>'linear', |
1429 | xa_ratio=>0, ya_ratio=>0, | |
1430 | xb_ratio=>1.0, yb_ratio=>1.0, | |
1431 | segments=>Imager::Fountain->simple | |
1432 | ( positions=>[0, 1], | |
1433 | colors=>[ NC('6060FF'), NC('60FF60') ]) }, | |
1434 | fg=>'000000', | |
2eac77fc | 1435 | negative_bg=>'EEEEEE', |
35574351 TC |
1436 | bg=>'FFFFFF', |
1437 | features=>{ dropshadow=>1 }, | |
bb0de914 TC |
1438 | }, |
1439 | fount_rad => | |
1440 | { | |
35574351 TC |
1441 | fills=> |
1442 | [ | |
1443 | { fountain=>'radial', | |
1444 | xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5, | |
1445 | segments => Imager::Fountain->simple(positions=>[0, 1], | |
d7fd5863 | 1446 | colors=>[ NC('FF8080'), NC('FF0000') ]), |
35574351 TC |
1447 | }, |
1448 | { fountain=>'radial', | |
1449 | xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5, | |
1450 | segments => Imager::Fountain->simple(positions=>[0, 1], | |
d7fd5863 | 1451 | colors=>[ NC('80FF80'), NC('00FF00') ]), |
35574351 TC |
1452 | }, |
1453 | { fountain=>'radial', | |
1454 | xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5, | |
1455 | segments => Imager::Fountain->simple(positions=>[0, 1], | |
d7fd5863 | 1456 | colors=>[ NC('808080FF'), NC('0000FF') ]), |
35574351 TC |
1457 | }, |
1458 | { fountain=>'radial', | |
1459 | xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5, | |
1460 | segments => Imager::Fountain->simple(positions=>[0, 1], | |
d7fd5863 | 1461 | colors=>[ NC('FFFF80'), NC('FFFF00') ]), |
35574351 TC |
1462 | }, |
1463 | { fountain=>'radial', | |
1464 | xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5, | |
1465 | segments => Imager::Fountain->simple(positions=>[0, 1], | |
d7fd5863 | 1466 | colors=>[ NC('80FFFF'), NC('00FFFF') ]), |
35574351 TC |
1467 | }, |
1468 | { fountain=>'radial', | |
1469 | xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5, | |
1470 | segments => Imager::Fountain->simple(positions=>[0, 1], | |
d7fd5863 | 1471 | colors=>[ NC('FF80FF'), NC('FF00FF') ]), |
35574351 TC |
1472 | }, |
1473 | ], | |
dfd889da | 1474 | colors => [ |
1475 | qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF) | |
1476 | ], | |
35574351 TC |
1477 | back=>{ fountain=>'linear', |
1478 | xa_ratio=>0, ya_ratio=>0, | |
1479 | xb_ratio=>1.0, yb_ratio=>1.0, | |
1480 | segments=>Imager::Fountain->simple | |
1481 | ( positions=>[0, 1], | |
1482 | colors=>[ NC('6060FF'), NC('60FF60') ]) }, | |
1483 | fg=>'000000', | |
2eac77fc | 1484 | negative_bg=>'EEEEEE', |
35574351 | 1485 | bg=>'FFFFFF', |
bb0de914 TC |
1486 | } |
1487 | ); | |
35574351 | 1488 | |
2eac77fc | 1489 | $styles{'ocean'} = { |
1490 | fills => [ | |
1491 | { | |
1492 | fountain =>'linear', | |
1493 | xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, | |
1494 | segments => Imager::Fountain->simple( | |
1495 | positions=>[0, 1], | |
7422650e | 1496 | colors=>[ NC('EFEDCF'), NC('E6E2AF') ]), |
2eac77fc | 1497 | }, |
1498 | { | |
1499 | fountain =>'linear', | |
1500 | xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, | |
1501 | segments => Imager::Fountain->simple( | |
1502 | positions=>[0, 1], | |
7422650e | 1503 | colors=>[ NC('DCD7AB'), NC('A7A37E') ]), |
2eac77fc | 1504 | }, |
1505 | { | |
1506 | fountain =>'linear', | |
1507 | xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, | |
1508 | segments => Imager::Fountain->simple( | |
1509 | positions=>[0, 1], | |
7422650e | 1510 | colors=>[ NC('B2E5D4'), NC('80B4A2') ]), |
2eac77fc | 1511 | }, |
1512 | { | |
1513 | fountain =>'linear', | |
1514 | xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, | |
1515 | segments => Imager::Fountain->simple( | |
1516 | positions=>[0, 1], | |
7422650e | 1517 | colors=>[ NC('7aaab9'), NC('046380') ]), |
2eac77fc | 1518 | }, |
1519 | { | |
1520 | fountain =>'linear', | |
1521 | xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, | |
1522 | segments => Imager::Fountain->simple( | |
1523 | positions=>[0, 1], | |
7422650e | 1524 | colors=>[ NC('c3b8e9'), NC('877EA7') ]), |
2eac77fc | 1525 | }, |
1526 | { | |
1527 | fountain =>'linear', | |
1528 | xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, | |
1529 | segments => Imager::Fountain->simple( | |
1530 | positions=>[0, 1], | |
7422650e | 1531 | colors=>[ NC('A3DF9A'), NC('67A35E') ]), |
2eac77fc | 1532 | }, |
1533 | { | |
1534 | fountain =>'linear', | |
1535 | xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, | |
1536 | segments => Imager::Fountain->simple( | |
1537 | positions=>[0, 1], | |
7422650e | 1538 | colors=>[ NC('E19C98'), NC('B4726F') ]), |
2eac77fc | 1539 | }, |
1540 | ], | |
1541 | colors => [ | |
1542 | qw(E6E2AF A7A37E 80B4A2 046380 877EA7 67A35E B4726F) | |
1543 | ], | |
1544 | fg=>'000000', | |
1545 | negative_bg=>'EEEEEE', | |
1546 | bg=>'FFFFFF', | |
1547 | features=>{ dropshadow=>1 }, | |
1548 | ||
1549 | }; | |
1550 | ||
7422650e | 1551 | $styles{'ocean_flat'} = { |
1552 | fills=> | |
1553 | [ | |
1554 | qw(E6E2AF A7A37E 80B4A2 046380 877EA7 67A35E B4726F) | |
1555 | ], | |
1556 | colors => [ | |
1557 | qw(E6E2AF A7A37E 80B4A2 046380 877EA7 67A35E B4726F) | |
1558 | ], | |
1559 | fg=>'000000', | |
1560 | negative_bg=>'EEEEEE', | |
1561 | bg=>'FFFFFF', | |
1562 | features=>{ dropshadow=>1 }, | |
1563 | ||
1564 | }; | |
1565 | ||
35574351 TC |
1566 | =item $self->_style_setup(\%opts) |
1567 | ||
5057a68f TC |
1568 | Uses the values from %opts, the custom style set by methods, the style |
1569 | set by the style parameter or the set_style() method and the built in | |
1570 | chart defaults to build a working style. | |
1571 | ||
1572 | The working style features member is also populated with the active | |
1573 | features for the chart. | |
1574 | ||
1575 | The working style is stored in the C<_style> member of $self. | |
35574351 TC |
1576 | |
1577 | =cut | |
1578 | ||
1579 | sub _style_setup { | |
1580 | my ($self, $opts) = @_; | |
1581 | my $style_defs = $self->_style_defs; | |
1582 | my $style; | |
dfd889da | 1583 | |
2eac77fc | 1584 | my $pre_def_style = $self->_get_style($opts); |
1585 | my $api_style = $self->{'custom_style'} || {}; | |
dfd889da | 1586 | $style = $styles{$pre_def_style} if $pre_def_style; |
1587 | ||
35574351 TC |
1588 | $style ||= $styles{$def_style}; |
1589 | ||
2eac77fc | 1590 | my @search_list = ( $style_defs, $style, $api_style, $opts); |
35574351 TC |
1591 | my %work; |
1592 | ||
1593 | my @composite = $self->_composite(); | |
1594 | my %composite; | |
1595 | @composite{@composite} = @composite; | |
1596 | ||
1597 | for my $src (@search_list) { | |
1598 | for my $key (keys %$src) { | |
1599 | if ($composite{$key}) { | |
1600 | $work{$key} = {} unless exists $work{$key}; | |
1601 | if (ref $src->{$key}) { | |
1602 | # some keys have sub values, especially text | |
1603 | @{$work{$key}}{keys %{$src->{$key}}} = values %{$src->{$key}}; | |
1604 | } | |
1605 | else { | |
1606 | # assume it's the text for a title or something | |
1607 | $work{$key}{text} = $src->{$key}; | |
1608 | } | |
1609 | } | |
1610 | else { | |
a17e870a TC |
1611 | $work{$key} = $src->{$key} |
1612 | if defined $src->{$key}; # $opts with pmichauds new accessor handling | |
35574351 TC |
1613 | } |
1614 | } | |
1615 | } | |
1616 | ||
1617 | # features are handled specially | |
1a36ef75 TC |
1618 | my %features; |
1619 | $work{features} = \%features; | |
35574351 TC |
1620 | for my $src (@search_list) { |
1621 | if ($src->{features}) { | |
1622 | if (ref $src->{features}) { | |
1623 | if (ref($src->{features}) =~ /ARRAY/) { | |
1624 | # just set those features | |
1625 | for my $feature (@{$src->{features}}) { | |
1a36ef75 TC |
1626 | if ($feature =~ /^no(.+)$/) { |
1627 | delete $features{$1}; | |
1628 | } | |
1629 | else { | |
1630 | $features{$feature} = 1; | |
1631 | } | |
35574351 TC |
1632 | } |
1633 | } | |
1634 | elsif (ref($src->{features}) =~ /HASH/) { | |
1635 | if ($src->{features}{reset}) { | |
1636 | $work{features} = {}; # only the ones the user specifies | |
1637 | } | |
1638 | @{$work{features}}{keys %{$src->{features}}} = | |
1639 | values(%{$src->{features}}); | |
1640 | } | |
1641 | } | |
1642 | else { | |
1643 | # just set that single feature | |
56b495c0 TC |
1644 | if ($src->{features} =~ /^no(.+)$/) { |
1645 | delete $features{$1}; | |
1646 | } | |
1647 | else { | |
1648 | $features{$src->{features}} = 1; | |
1649 | } | |
35574351 TC |
1650 | } |
1651 | } | |
1652 | } | |
35574351 TC |
1653 | |
1654 | $self->{_style} = \%work; | |
1655 | } | |
1656 | ||
1657 | =item $self->_get_thing($name) | |
1658 | ||
1659 | Retrieve some general 'thing'. | |
1660 | ||
1661 | Supports the 'lookup(foo)' mechanism. | |
1662 | ||
f68db40f TC |
1663 | Returns an empty list on failure. |
1664 | ||
35574351 TC |
1665 | =cut |
1666 | ||
1667 | sub _get_thing { | |
1668 | my ($self, $name, @depth) = @_; | |
1669 | ||
1670 | push(@depth, $name); | |
1671 | my $what; | |
1672 | if ($name =~ /^(\w+)\.(\w+)$/) { | |
1673 | $what = $self->{_style}{$1}{$2}; | |
1674 | } | |
1675 | else { | |
1676 | $what = $self->{_style}{$name}; | |
1677 | } | |
1678 | defined $what or | |
1679 | return; | |
1680 | if (ref $what) { | |
1681 | return $what; | |
1682 | } | |
1683 | elsif ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) { | |
1684 | @depth < MAX_DEPTH | |
1685 | or return $self->_error("too many levels of recursion in lookup(@depth)"); | |
1686 | return $self->_get_thing($1, @depth); | |
1687 | } | |
1688 | else { | |
1689 | return $what; | |
1690 | } | |
1691 | } | |
1692 | ||
1693 | =item $self->_get_number($name) | |
1694 | ||
1695 | Retrieves a number from the style. The value in the style can be the | |
1696 | number, or one of two functions: | |
1697 | ||
1698 | =over | |
1699 | ||
1700 | =item lookup(newname) | |
1701 | ||
1702 | Recursively looks up I<newname> in the style. | |
1703 | ||
1704 | =item scale(value1,value2) | |
1705 | ||
33a928b7 | 1706 | Each value can be a number or a name. Names are recursively looked up |
35574351 TC |
1707 | in the style and the product is returned. |
1708 | ||
1709 | =back | |
1710 | ||
1711 | =cut | |
bb0de914 | 1712 | |
35574351 TC |
1713 | sub _get_number { |
1714 | my ($self, $name, @depth) = @_; | |
1715 | ||
1716 | push(@depth, $name); | |
1717 | my $what; | |
1718 | if ($name =~ /^(\w+)\.(\w+)$/) { | |
1719 | $what = $self->{_style}{$1}{$2}; | |
1720 | } | |
1721 | else { | |
1722 | $what = $self->{_style}{$name}; | |
1723 | } | |
1724 | defined $what or | |
1725 | return $self->_error("$name is undef (@depth)"); | |
1726 | ||
1727 | if (ref $what) { | |
1728 | if ($what =~ /CODE/) { | |
1729 | $what = $what->($self, $name); | |
1730 | } | |
1731 | } | |
1732 | else { | |
1733 | if ($what =~ /^lookup\(([\w.]+)\)$/) { | |
1734 | @depth < MAX_DEPTH | |
d7fd5863 | 1735 | or return $self->_error("too many levels of recursion in lookup (@depth)"); |
35574351 TC |
1736 | return $self->_get_number($1, @depth); |
1737 | } | |
1738 | elsif ($what =~ /^scale\( | |
d7fd5863 | 1739 | ((?:[a-z][\w.]*)|$NUM_RE) |
35574351 | 1740 | , |
d7fd5863 | 1741 | ((?:[a-z][\w.]*)|$NUM_RE)\)$/x) { |
35574351 TC |
1742 | my ($left, $right) = ($1, $2); |
1743 | unless ($left =~ /^$NUM_RE$/) { | |
d7fd5863 TC |
1744 | @depth < MAX_DEPTH |
1745 | or return $self->_error("too many levels of recursion in scale (@depth)"); | |
1746 | $left = $self->_get_number($left, @depth); | |
35574351 TC |
1747 | } |
1748 | unless ($right =~ /^$NUM_RE$/) { | |
d7fd5863 TC |
1749 | @depth < MAX_DEPTH |
1750 | or return $self->_error("too many levels of recursion in scale (@depth)"); | |
1751 | $right = $self->_get_number($right, @depth); | |
35574351 TC |
1752 | } |
1753 | return $left * $right; | |
1754 | } | |
1755 | else { | |
1756 | return $what+0; | |
1757 | } | |
1758 | } | |
1759 | } | |
1760 | ||
379c5b02 TC |
1761 | =item $self->_get_integer($name) |
1762 | ||
1763 | Retrieves an integer from the style. This is a simple wrapper around | |
1764 | _get_number() that rounds the result to an integer. | |
1765 | ||
f68db40f TC |
1766 | Returns an empty list on failure. |
1767 | ||
379c5b02 TC |
1768 | =cut |
1769 | ||
1770 | sub _get_integer { | |
1771 | my ($self, $name, @depth) = @_; | |
1772 | ||
1773 | my $number = $self->_get_number($name, @depth) | |
1774 | or return; | |
1775 | ||
1776 | return sprintf("%.0f", $number); | |
1777 | } | |
1778 | ||
35574351 TC |
1779 | =item _get_color($name) |
1780 | ||
1781 | Returns a color object of the given name from the style hash. | |
1782 | ||
1783 | Uses Imager::Color->new to translate normal scalars into color objects. | |
1784 | ||
1785 | Allows the lookup(name) mechanism. | |
1786 | ||
f68db40f TC |
1787 | Returns an empty list on failure. |
1788 | ||
35574351 TC |
1789 | =cut |
1790 | ||
1791 | sub _get_color { | |
1792 | my ($self, $name, @depth) = @_; | |
1793 | ||
1794 | push(@depth, $name); | |
1795 | my $what; | |
1796 | if ($name =~ /^(\w+)\.(\w+)$/) { | |
1797 | $what = $self->{_style}{$1}{$2}; | |
1798 | } | |
1799 | else { | |
1800 | $what = $self->{_style}{$name}; | |
1801 | } | |
1802 | ||
1803 | defined($what) | |
1804 | or return $self->_error("$name was undefined (@depth)"); | |
1805 | ||
1806 | unless (ref $what) { | |
1807 | if ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) { | |
1808 | @depth < MAX_DEPTH or | |
d7fd5863 | 1809 | return $self->_error("too many levels of recursion in lookup (@depth)"); |
35574351 TC |
1810 | |
1811 | return $self->_get_color($1, @depth); | |
1812 | } | |
1813 | $what = Imager::Color->new($what); | |
1814 | } | |
1815 | ||
1816 | $what; | |
1817 | } | |
1818 | ||
1819 | =item _translate_fill($what, $box) | |
1820 | ||
1821 | Given the value of a fill, either attempts to convert it into a fill | |
1822 | list (one of C<<color=>$color_value, filled=>1>> or C<<fill=>{ fill | |
1823 | parameters }>>), or to lookup another fill that is referred to with | |
1824 | the 'lookup(name)' mechanism. | |
1825 | ||
1826 | This function does the fg and bg initialization for hatched fills, and | |
1827 | translation of *_ratio for fountain fills (using the $box parameter). | |
1828 | ||
f68db40f TC |
1829 | Returns an empty list on failure. |
1830 | ||
35574351 TC |
1831 | =cut |
1832 | ||
1833 | sub _translate_fill { | |
1834 | my ($self, $what, $box, @depth) = @_; | |
1835 | ||
1836 | if (ref $what) { | |
1837 | if (UNIVERSAL::isa($what, "Imager::Color")) { | |
1838 | return ( color=>Imager::Color->new($what), filled=>1 ); | |
1839 | } | |
1840 | else { | |
1841 | # a general fill | |
33a928b7 TC |
1842 | # default to normal combine mode |
1843 | my %work = ( combine => 'normal', %$what ); | |
35574351 | 1844 | if ($what->{hatch}) { |
d7fd5863 TC |
1845 | if (!$work{fg}) { |
1846 | $work{fg} = $self->_get_color('fg') | |
1847 | or return; | |
1848 | } | |
1849 | if (!$work{bg}) { | |
1850 | $work{bg} = $self->_get_color('bg') | |
1851 | or return; | |
1852 | } | |
1853 | return ( fill=>\%work ); | |
35574351 TC |
1854 | } |
1855 | elsif ($what->{fountain}) { | |
d7fd5863 TC |
1856 | for my $key (qw(xa ya xb yb)) { |
1857 | if (exists $work{"${key}_ratio"}) { | |
1858 | if ($key =~ /^x/) { | |
1859 | $work{$key} = $box->[0] + $work{"${key}_ratio"} | |
1860 | * ($box->[2] - $box->[0]); | |
1861 | } | |
1862 | else { | |
1863 | $work{$key} = $box->[1] + $work{"${key}_ratio"} | |
1864 | * ($box->[3] - $box->[1]); | |
1865 | } | |
1866 | } | |
1867 | } | |
1868 | return ( fill=>\%work ); | |
35574351 TC |
1869 | } |
1870 | else { | |
d7fd5863 | 1871 | return ( fill=> \%work ); |
35574351 TC |
1872 | } |
1873 | } | |
1874 | } | |
1875 | else { | |
1876 | if ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) { | |
1877 | return $self->_get_fill($1, $box, @depth); | |
1878 | } | |
1879 | else { | |
1880 | # assumed to be an Imager::Color single value | |
1881 | return ( color=>Imager::Color->new($what), filled=>1 ); | |
1882 | } | |
1883 | } | |
1884 | } | |
1885 | ||
1886 | =item _data_fill($index, $box) | |
1887 | ||
1888 | Retrieves the fill parameters for a data area fill. | |
1889 | ||
1890 | =cut | |
1891 | ||
1892 | sub _data_fill { | |
1893 | my ($self, $index, $box) = @_; | |
1894 | ||
1895 | my $fills = $self->{_style}{fills}; | |
1896 | return $self->_translate_fill($fills->[$index % @$fills], $box, | |
1897 | "data.$index"); | |
1898 | } | |
1899 | ||
dfd889da | 1900 | sub _data_color { |
1901 | my ($self, $index) = @_; | |
1902 | ||
1903 | my $colors = $self->{'_style'}{'colors'} || []; | |
1904 | my $fills = $self->{'_style'}{'fills'} || []; | |
1905 | ||
1906 | # Try to just use a fill, so non-fountain styles don't need | |
1907 | # to have a duplicated set of fills and colors | |
1908 | my $fill = $fills->[$index % @$fills]; | |
1909 | if (!ref $fill) { | |
1910 | return $fill; | |
1911 | } | |
1912 | ||
1913 | if (@$colors) { | |
1914 | return $colors->[$index % @$colors] || '000000'; | |
1915 | } | |
1916 | return '000000'; | |
1917 | } | |
1918 | ||
56b495c0 | 1919 | =item _get_fill($name, $box) |
35574351 TC |
1920 | |
1921 | Retrieves fill parameters for a named fill. | |
1922 | ||
1923 | =cut | |
1924 | ||
1925 | sub _get_fill { | |
1926 | my ($self, $name, $box, @depth) = @_; | |
1927 | ||
1928 | push(@depth, $name); | |
1929 | my $what; | |
1930 | if ($name =~ /^(\w+)\.(\w+)$/) { | |
1931 | $what = $self->{_style}{$1}{$2}; | |
1932 | } | |
1933 | else { | |
1934 | $what = $self->{_style}{$name}; | |
1935 | } | |
1936 | ||
1937 | defined($what) | |
1938 | or return $self->_error("no fill $name found"); | |
1939 | ||
1940 | return $self->_translate_fill($what, $box, @depth); | |
1941 | } | |
1942 | ||
56b495c0 TC |
1943 | =item _get_line($name) |
1944 | ||
1945 | Return color (and possibly other) parameters for drawing a line with | |
1946 | the _line() method. | |
1947 | ||
1948 | =cut | |
1949 | ||
1950 | sub _get_line { | |
1951 | my ($self, $name, @depth) = @_; | |
1952 | ||
1953 | push (@depth, $name); | |
1954 | my $what; | |
1955 | if ($name =~ /^(\w+)\.(\w+)$/) { | |
1956 | $what = $self->{_style}{$1}{$2}; | |
1957 | } | |
1958 | else { | |
1959 | $what = $self->{_style}{$name}; | |
1960 | } | |
1961 | ||
1962 | defined($what) | |
1963 | or return $self->_error("no line style $name found"); | |
1964 | ||
1965 | if (ref $what) { | |
1966 | if (eval { $what->isa("Imager::Color") }) { | |
1967 | return $what; | |
1968 | } | |
1969 | if (ref $what eq "HASH") { | |
1970 | # allow each kep to be looked up | |
1971 | my %work = %$what; | |
1972 | ||
1973 | if ($work{color} =~ /^lookup\((.*)\)$/) { | |
1974 | $work{color} = $self->_get_color($1, @depth); | |
1975 | } | |
1976 | for my $key (keys %work) { | |
1977 | $key eq "color" and next; | |
1978 | ||
1979 | if ($work{$key} =~ /^lookup\((.*)\)$/) { | |
1980 | $work{$key} = $self->_get_thing($1); | |
1981 | } | |
1982 | } | |
1983 | ||
1984 | return %work; | |
1985 | } | |
1986 | return ( color => Imager::Color->new(@$what) ); | |
1987 | } | |
1988 | else { | |
1989 | if ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) { | |
1990 | @depth < MAX_DEPTH | |
1991 | or return $self->_error("too many levels of recursion in lookup (@depth)"); | |
1992 | return $self->_get_line($1, @depth); | |
1993 | } | |
1994 | else { | |
1995 | # presumably a text color | |
1996 | my $color = Imager::Color->new($what) | |
1997 | or return $self->_error("Could not translate $what as a color: ".Imager->errstr); | |
1998 | ||
1999 | return ( color => $color ); | |
2000 | } | |
2001 | } | |
2002 | } | |
2003 | ||
35574351 TC |
2004 | =item _make_img() |
2005 | ||
2006 | Builds the image object for the graph and fills it with the background | |
2007 | fill. | |
2008 | ||
2009 | =cut | |
2010 | ||
2011 | sub _make_img { | |
2012 | my ($self) = @_; | |
35574351 | 2013 | |
81453d28 | 2014 | my $width = $self->_get_number('width') || 256; |
2015 | my $height = $self->_get_number('height') || 256; | |
35574351 TC |
2016 | my $channels = $self->{_style}{channels}; |
2017 | ||
2018 | $channels ||= 3; | |
2019 | ||
56b495c0 TC |
2020 | my $img = Imager->new(xsize=>$width, ysize=>$height, channels=>$channels) |
2021 | or return $self->_error("Error creating image: " . Imager->errstr); | |
35574351 TC |
2022 | |
2023 | $img->box($self->_get_fill('back', [ 0, 0, $width-1, $height-1])); | |
2024 | ||
56b495c0 TC |
2025 | $self->{_image} = $img; |
2026 | ||
2027 | return $img; | |
35574351 TC |
2028 | } |
2029 | ||
2eac77fc | 2030 | sub _get_image { |
2031 | my $self = shift; | |
2032 | ||
2eac77fc | 2033 | return $self->{'_image'}; |
2034 | } | |
2035 | ||
f68db40f TC |
2036 | =item _text_style($name) |
2037 | ||
2038 | Returns parameters suitable for calls to Imager::Font's bounding_box() | |
2039 | and draw() methods intended for use in defining text styles. | |
2040 | ||
2041 | Returns an empty list on failure. | |
2042 | ||
49a35584 TC |
2043 | Returns the following attributes: font, color, size, aa, sizew |
2044 | (optionally) | |
2045 | ||
f68db40f TC |
2046 | =cut |
2047 | ||
35574351 TC |
2048 | sub _text_style { |
2049 | my ($self, $name) = @_; | |
2050 | ||
2051 | my %work; | |
2052 | ||
2053 | if ($self->{_style}{$name}) { | |
2054 | %work = %{$self->{_style}{$name}}; | |
2055 | } | |
2056 | else { | |
2057 | %work = %{$self->{_style}{text}}; | |
2058 | } | |
2059 | $work{font} | |
5d622bb8 | 2060 | or return $self->_error("$name has no font parameter"); |
35574351 TC |
2061 | |
2062 | $work{font} = $self->_get_thing("$name.font") | |
5d622bb8 | 2063 | or return $self->_error("No $name.font defined, either set $name.font or font to a font"); |
35574351 TC |
2064 | UNIVERSAL::isa($work{font}, "Imager::Font") |
2065 | or return $self->_error("$name.font is not a font"); | |
2066 | if ($work{color} && !ref $work{color}) { | |
2067 | $work{color} = $self->_get_color("$name.color") | |
2068 | or return; | |
2069 | } | |
2070 | $work{size} = $self->_get_number("$name.size"); | |
2071 | $work{sizew} = $self->_get_number("$name.sizew") | |
2072 | if $work{sizew}; | |
49a35584 | 2073 | $work{aa} = $self->_get_number("$name.aa"); |
35574351 TC |
2074 | |
2075 | %work; | |
2076 | } | |
2077 | ||
f68db40f TC |
2078 | =item _text_bbox($text, $name) |
2079 | ||
2080 | Returns a bounding box for the specified $text as styled by $name. | |
2081 | ||
2082 | Returns an empty list on failure. | |
2083 | ||
2084 | =cut | |
2085 | ||
35574351 TC |
2086 | sub _text_bbox { |
2087 | my ($self, $text, $name) = @_; | |
2088 | ||
5d622bb8 TC |
2089 | my %text_info = $self->_text_style($name) |
2090 | or return; | |
35574351 TC |
2091 | |
2092 | my @bbox = $text_info{font}->bounding_box(%text_info, string=>$text, | |
d7fd5863 | 2093 | canon=>1); |
35574351 TC |
2094 | |
2095 | return @bbox[0..3]; | |
2096 | } | |
2097 | ||
49a35584 TC |
2098 | =item _line_style($name) |
2099 | ||
2100 | Return parameters suitable for calls to Imager's line(), polyline(), | |
2101 | and box() methods. | |
2102 | ||
2103 | For now this returns only color and aa parameters, but future releases | |
2104 | of Imager may support extra parameters. | |
2105 | ||
2106 | =cut | |
2107 | ||
2108 | sub _line_style { | |
2109 | my ($self, $name) = @_; | |
2110 | ||
2111 | my %line; | |
2112 | $line{color} = $self->_get_color("$name.line") | |
2113 | or return; | |
2114 | $line{aa} = $self->_get_number("$name.lineaa"); | |
2115 | defined $line{aa} or $line{aa} = $self->_get_number("aa"); | |
2116 | ||
2117 | return %line; | |
2118 | } | |
2119 | ||
35574351 TC |
2120 | sub _align_box { |
2121 | my ($self, $box, $chart_box, $name) = @_; | |
2122 | ||
2123 | my $halign = $self->{_style}{$name}{halign} | |
2124 | or $self->_error("no halign for $name"); | |
2125 | my $valign = $self->{_style}{$name}{valign}; | |
2126 | ||
2127 | if ($halign eq 'right') { | |
2128 | $box->[0] += $chart_box->[2] - $box->[2]; | |
2129 | } | |
2130 | elsif ($halign eq 'left') { | |
2131 | $box->[0] = $chart_box->[0]; | |
2132 | } | |
2133 | elsif ($halign eq 'center' || $halign eq 'centre') { | |
2134 | $box->[0] = ($chart_box->[0] + $chart_box->[2] - $box->[2])/2; | |
2135 | } | |
2136 | else { | |
2137 | return $self->_error("invalid halign $halign for $name"); | |
2138 | } | |
2139 | ||
2140 | if ($valign eq 'top') { | |
2141 | $box->[1] = $chart_box->[1]; | |
2142 | } | |
2143 | elsif ($valign eq 'bottom') { | |
2144 | $box->[1] = $chart_box->[3] - $box->[3]; | |
2145 | } | |
2146 | elsif ($valign eq 'center' || $valign eq 'centre') { | |
2147 | $box->[1] = ($chart_box->[1] + $chart_box->[3] - $box->[3])/2; | |
2148 | } | |
2149 | else { | |
2150 | return $self->_error("invalid valign $valign for $name"); | |
2151 | } | |
2152 | $box->[2] += $box->[0]; | |
2153 | $box->[3] += $box->[1]; | |
2154 | } | |
2155 | ||
2156 | sub _remove_box { | |
2157 | my ($self, $chart_box, $object_box) = @_; | |
2158 | ||
2159 | my $areax; | |
2160 | my $areay; | |
2161 | if ($object_box->[0] - $chart_box->[0] | |
2162 | < $chart_box->[2] - $object_box->[2]) { | |
2163 | $areax = ($object_box->[2] - $chart_box->[0]) | |
2164 | * ($chart_box->[3] - $chart_box->[1]); | |
2165 | } | |
2166 | else { | |
2167 | $areax = ($chart_box->[2] - $object_box->[0]) | |
2168 | * ($chart_box->[3] - $chart_box->[1]); | |
2169 | } | |
2170 | ||
2171 | if ($object_box->[1] - $chart_box->[1] | |
2172 | < $chart_box->[3] - $object_box->[3]) { | |
2173 | $areay = ($object_box->[3] - $chart_box->[1]) | |
2174 | * ($chart_box->[2] - $chart_box->[0]); | |
2175 | } | |
2176 | else { | |
2177 | $areay = ($chart_box->[3] - $object_box->[1]) | |
2178 | * ($chart_box->[2] - $chart_box->[0]); | |
2179 | } | |
2180 | ||
2181 | if ($areay < $areax) { | |
2182 | if ($object_box->[1] - $chart_box->[1] | |
d7fd5863 | 2183 | < $chart_box->[3] - $object_box->[3]) { |
35574351 TC |
2184 | $chart_box->[1] = $object_box->[3]; |
2185 | } | |
2186 | else { | |
2187 | $chart_box->[3] = $object_box->[1]; | |
2188 | } | |
2189 | } | |
2190 | else { | |
2191 | if ($object_box->[0] - $chart_box->[0] | |
d7fd5863 | 2192 | < $chart_box->[2] - $object_box->[2]) { |
35574351 TC |
2193 | $chart_box->[0] = $object_box->[2]; |
2194 | } | |
2195 | else { | |
2196 | $chart_box->[2] = $object_box->[0]; | |
2197 | } | |
2198 | } | |
2199 | } | |
2200 | ||
2201 | sub _draw_legend { | |
2202 | my ($self, $img, $labels, $chart_box) = @_; | |
2203 | ||
33a928b7 TC |
2204 | my $orient = $self->_get_thing('legend.orientation'); |
2205 | defined $orient or $orient = 'vertical'; | |
2206 | ||
2207 | if ($orient eq 'vertical') { | |
2208 | return $self->_draw_legend_vertical($img, $labels, $chart_box); | |
2209 | } | |
2210 | elsif ($orient eq 'horizontal') { | |
2211 | return $self->_draw_legend_horizontal($img, $labels, $chart_box); | |
2212 | } | |
2213 | else { | |
2214 | return $self->_error("Unknown legend.orientation $orient"); | |
2215 | } | |
2216 | } | |
2217 | ||
2218 | sub _draw_legend_horizontal { | |
2219 | my ($self, $img, $labels, $chart_box) = @_; | |
2220 | ||
2221 | defined(my $padding = $self->_get_integer('legend.padding')) | |
2222 | or return; | |
2223 | my $patchsize = $self->_get_integer('legend.patchsize') | |
2224 | or return; | |
2225 | defined(my $gap = $self->_get_integer('legend.patchgap')) | |
2226 | or return; | |
2227 | ||
2228 | my $minrowsize = $patchsize + $gap; | |
2229 | my ($width, $height) = (0,0); | |
2230 | my $row_height = $minrowsize; | |
2231 | my $pos = 0; | |
2232 | my @sizes; | |
2233 | my @offsets; | |
2234 | for my $label (@$labels) { | |
5d622bb8 TC |
2235 | my @text_box = $self->_text_bbox($label, 'legend') |
2236 | or return; | |
33a928b7 TC |
2237 | push(@sizes, \@text_box); |
2238 | my $entry_width = $patchsize + $gap + $text_box[2]; | |
2239 | if ($pos == 0) { | |
2240 | # never re-wrap the first entry | |
2241 | push @offsets, [ 0, $height ]; | |
2242 | } | |
2243 | else { | |
2244 | if ($pos + $gap + $entry_width > $chart_box->[2]) { | |
d7fd5863 TC |
2245 | $pos = 0; |
2246 | $height += $row_height; | |
33a928b7 TC |
2247 | } |
2248 | push @offsets, [ $pos, $height ]; | |
2249 | } | |
2250 | my $entry_right = $pos + $entry_width; | |
2251 | $pos += $gap + $entry_width; | |
2252 | $entry_right > $width and $width = $entry_right; | |
2253 | if ($text_box[3] > $row_height) { | |
2254 | $row_height = $text_box[3]; | |
2255 | } | |
2256 | } | |
2257 | $height += $row_height; | |
2258 | my @box = ( 0, 0, $width + $padding * 2, $height + $padding * 2 ); | |
2259 | my $outsidepadding = 0; | |
2260 | if ($self->{_style}{legend}{border}) { | |
2261 | defined($outsidepadding = $self->_get_integer('legend.outsidepadding')) | |
2262 | or return; | |
2263 | $box[2] += 2 * $outsidepadding; | |
2264 | $box[3] += 2 * $outsidepadding; | |
2265 | } | |
2266 | $self->_align_box(\@box, $chart_box, 'legend') | |
2267 | or return; | |
2268 | if ($self->{_style}{legend}{fill}) { | |
2269 | $img->box(xmin=>$box[0]+$outsidepadding, | |
2270 | ymin=>$box[1]+$outsidepadding, | |
2271 | xmax=>$box[2]-$outsidepadding, | |
2272 | ymax=>$box[3]-$outsidepadding, | |
d7fd5863 | 2273 | $self->_get_fill('legend.fill', \@box)); |
33a928b7 TC |
2274 | } |
2275 | $box[0] += $outsidepadding; | |
2276 | $box[1] += $outsidepadding; | |
2277 | $box[2] -= $outsidepadding; | |
2278 | $box[3] -= $outsidepadding; | |
2279 | my %text_info = $self->_text_style('legend') | |
2280 | or return; | |
2281 | my $patchborder; | |
2282 | if ($self->{_style}{legend}{patchborder}) { | |
2283 | $patchborder = $self->_get_color('legend.patchborder') | |
2284 | or return; | |
2285 | } | |
2286 | ||
2287 | my $dataindex = 0; | |
2288 | for my $label (@$labels) { | |
2289 | my ($left, $top) = @{$offsets[$dataindex]}; | |
2290 | $left += $box[0] + $padding; | |
2291 | $top += $box[1] + $padding; | |
2292 | my $textpos = $left + $patchsize + $gap; | |
2293 | my @patchbox = ( $left, $top, | |
2294 | $left + $patchsize, $top + $patchsize ); | |
2295 | my @fill = $self->_data_fill($dataindex, \@patchbox) | |
2296 | or return; | |
2297 | $img->box(xmin=>$left, ymin=>$top, xmax=>$left + $patchsize, | |
d7fd5863 | 2298 | ymax=>$top + $patchsize, @fill); |
33a928b7 TC |
2299 | if ($self->{_style}{legend}{patchborder}) { |
2300 | $img->box(xmin=>$left, ymin=>$top, xmax=>$left + $patchsize, | |
d7fd5863 TC |
2301 | ymax=>$top + $patchsize, |
2302 | color=>$patchborder); | |
33a928b7 TC |
2303 | } |
2304 | $img->string(%text_info, x=>$textpos, 'y'=>$top + $patchsize, | |
2305 | text=>$label); | |
2306 | ||
2307 | ++$dataindex; | |
2308 | } | |
2309 | if ($self->{_style}{legend}{border}) { | |
2310 | my $border_color = $self->_get_color('legend.border') | |
2311 | or return; | |
2312 | $img->box(xmin=>$box[0], ymin=>$box[1], xmax=>$box[2], ymax=>$box[3], | |
d7fd5863 | 2313 | color=>$border_color); |
33a928b7 TC |
2314 | } |
2315 | $self->_remove_box($chart_box, \@box); | |
2316 | 1; | |
2317 | } | |
2318 | ||
2319 | sub _draw_legend_vertical { | |
2320 | my ($self, $img, $labels, $chart_box) = @_; | |
2321 | ||
379c5b02 | 2322 | defined(my $padding = $self->_get_integer('legend.padding')) |
35574351 | 2323 | or return; |
379c5b02 | 2324 | my $patchsize = $self->_get_integer('legend.patchsize') |
35574351 | 2325 | or return; |
379c5b02 | 2326 | defined(my $gap = $self->_get_integer('legend.patchgap')) |
35574351 TC |
2327 | or return; |
2328 | my $minrowsize = $patchsize + $gap; | |
2329 | my ($width, $height) = (0,0); | |
2330 | my @sizes; | |
2331 | for my $label (@$labels) { | |
5d622bb8 TC |
2332 | my @box = $self->_text_bbox($label, 'legend') |
2333 | or return; | |
35574351 TC |
2334 | push(@sizes, \@box); |
2335 | $width = $box[2] if $box[2] > $width; | |
2336 | if ($minrowsize > $box[3]) { | |
2337 | $height += $minrowsize; | |
2338 | } | |
2339 | else { | |
2340 | $height += $box[3]; | |
2341 | } | |
2342 | } | |
2343 | my @box = (0, 0, | |
d7fd5863 TC |
2344 | $width + $patchsize + $padding * 2 + $gap, |
2345 | $height + $padding * 2 - $gap); | |
35574351 TC |
2346 | my $outsidepadding = 0; |
2347 | if ($self->{_style}{legend}{border}) { | |
33a928b7 | 2348 | defined($outsidepadding = $self->_get_integer('legend.outsidepadding')) |
35574351 TC |
2349 | or return; |
2350 | $box[2] += 2 * $outsidepadding; | |
2351 | $box[3] += 2 * $outsidepadding; | |
2352 | } | |
2353 | $self->_align_box(\@box, $chart_box, 'legend') | |
2354 | or return; | |
2355 | if ($self->{_style}{legend}{fill}) { | |
2356 | $img->box(xmin=>$box[0]+$outsidepadding, | |
2357 | ymin=>$box[1]+$outsidepadding, | |
2358 | xmax=>$box[2]-$outsidepadding, | |
2359 | ymax=>$box[3]-$outsidepadding, | |
d7fd5863 | 2360 | $self->_get_fill('legend.fill', \@box)); |
35574351 TC |
2361 | } |
2362 | $box[0] += $outsidepadding; | |
2363 | $box[1] += $outsidepadding; | |
2364 | $box[2] -= $outsidepadding; | |
2365 | $box[3] -= $outsidepadding; | |
2366 | my $ypos = $box[1] + $padding; | |
2367 | my $patchpos = $box[0]+$padding; | |
2368 | my $textpos = $patchpos + $patchsize + $gap; | |
2369 | my %text_info = $self->_text_style('legend') | |
2370 | or return; | |
2371 | my $patchborder; | |
2372 | if ($self->{_style}{legend}{patchborder}) { | |
2373 | $patchborder = $self->_get_color('legend.patchborder') | |
2374 | or return; | |
2375 | } | |
2376 | my $dataindex = 0; | |
2377 | for my $label (@$labels) { | |
2378 | my @patchbox = ( $patchpos - $patchsize/2, $ypos - $patchsize/2, | |
2379 | $patchpos + $patchsize * 3 / 2, $ypos + $patchsize*3/2 ); | |
2eac77fc | 2380 | |
2381 | my @fill; | |
2382 | if ($self->_draw_flat_legend()) { | |
2383 | @fill = (color => $self->_data_color($dataindex), filled => 1); | |
2384 | } | |
2385 | else { | |
2386 | @fill = $self->_data_fill($dataindex, \@patchbox) | |
2387 | or return; | |
2388 | } | |
35574351 | 2389 | $img->box(xmin=>$patchpos, ymin=>$ypos, xmax=>$patchpos + $patchsize, |
d7fd5863 | 2390 | ymax=>$ypos + $patchsize, @fill); |
35574351 TC |
2391 | if ($self->{_style}{legend}{patchborder}) { |
2392 | $img->box(xmin=>$patchpos, ymin=>$ypos, xmax=>$patchpos + $patchsize, | |
d7fd5863 TC |
2393 | ymax=>$ypos + $patchsize, |
2394 | color=>$patchborder); | |
35574351 TC |
2395 | } |
2396 | $img->string(%text_info, x=>$textpos, 'y'=>$ypos + $patchsize, | |
2397 | text=>$label); | |
2398 | ||
2399 | my $step = $patchsize + $gap; | |
2400 | if ($minrowsize < $sizes[$dataindex][3]) { | |
2401 | $ypos += $sizes[$dataindex][3]; | |
2402 | } | |
2403 | else { | |
2404 | $ypos += $minrowsize; | |
2405 | } | |
2406 | ++$dataindex; | |
2407 | } | |
2408 | if ($self->{_style}{legend}{border}) { | |
2409 | my $border_color = $self->_get_color('legend.border') | |
2410 | or return; | |
2411 | $img->box(xmin=>$box[0], ymin=>$box[1], xmax=>$box[2], ymax=>$box[3], | |
d7fd5863 | 2412 | color=>$border_color); |
35574351 TC |
2413 | } |
2414 | $self->_remove_box($chart_box, \@box); | |
2415 | 1; | |
2416 | } | |
2417 | ||
2418 | sub _draw_title { | |
2419 | my ($self, $img, $chart_box) = @_; | |
2420 | ||
2421 | my $title = $self->{_style}{title}{text}; | |
5d622bb8 TC |
2422 | my @box = $self->_text_bbox($title, 'title') |
2423 | or return; | |
35574351 TC |
2424 | my $yoff = $box[1]; |
2425 | @box[0,1] = (0,0); | |
2426 | $self->_align_box(\@box, $chart_box, 'title'); | |
5d622bb8 TC |
2427 | my %text_info = $self->_text_style('title') |
2428 | or return; | |
35574351 TC |
2429 | $img->string(%text_info, x=>$box[0], 'y'=>$box[3] + $yoff, text=>$title); |
2430 | $self->_remove_box($chart_box, \@box); | |
2431 | 1; | |
2432 | } | |
2433 | ||
2434 | sub _small_extent { | |
2435 | my ($self, $box) = @_; | |
2436 | ||
2437 | if ($box->[2] - $box->[0] > $box->[3] - $box->[1]) { | |
2438 | return $box->[3] - $box->[1]; | |
2439 | } | |
2440 | else { | |
2441 | return $box->[2] - $box->[0]; | |
2442 | } | |
2443 | } | |
2444 | ||
2eac77fc | 2445 | sub _draw_flat_legend { |
2446 | return 0; | |
2447 | } | |
2448 | ||
35574351 TC |
2449 | =item _composite() |
2450 | ||
2451 | Returns a list of style fields that are stored as composites, and | |
2452 | should be merged instead of just being replaced. | |
2453 | ||
2454 | =cut | |
2455 | ||
2456 | sub _composite { | |
56b495c0 | 2457 | qw(title legend text label dropshadow outline callout graph); |
35574351 TC |
2458 | } |
2459 | ||
2460 | sub _filter_region { | |
2461 | my ($self, $img, $left, $top, $right, $bottom, $filter) = @_; | |
2462 | ||
2463 | unless (ref $filter) { | |
2464 | my $name = $filter; | |
2465 | $filter = $self->_get_thing($name) | |
2466 | or return; | |
2467 | $filter->{type} | |
2468 | or return $self->_error("no type for filter $name"); | |
2469 | } | |
2470 | ||
2471 | $left > 0 or $left = 0; | |
2472 | $top > 0 or $top = 0; | |
2473 | ||
ba203e3a TC |
2474 | my $masked = $img->masked(left=>$left, top=>$top, |
2475 | right=>$right, bottom=>$bottom); | |
2476 | $masked->filter(%$filter); | |
35574351 TC |
2477 | } |
2478 | ||
56b495c0 TC |
2479 | =item _line(x1 => $x1, y1 => $y1, ..., style => $style) |
2480 | ||
2481 | Wrapper for line drawing, implements styles Imager doesn't. | |
2482 | ||
2483 | Currently styles are limited to horizontal and vertical lines. | |
2484 | ||
2485 | =cut | |
2486 | ||
2487 | sub _line { | |
2488 | my ($self, %opts) = @_; | |
2489 | ||
2490 | my $img = delete $opts{img} | |
2491 | or die "No img supplied to _line()"; | |
2492 | my $style = delete $opts{style} || "solid"; | |
2493 | ||
2494 | if ($style eq "solid" || ($opts{x1} != $opts{x2} && $opts{y1} != $opts{y2})) { | |
2495 | return $img->line(%opts); | |
2496 | } | |
2497 | elsif ($style eq 'dashed' || $style eq 'dotted') { | |
2498 | my ($x1, $y1, $x2, $y2) = delete @opts{qw/x1 y1 x2 y2/}; | |
2499 | # the line is vertical or horizontal, so swapping doesn't hurt | |
2500 | $x1 > $x2 and ($x1, $x2) = ($x2, $x1); | |
2501 | $y1 > $y2 and ($y1, $y2) = ($y2, $y1); | |
2502 | my ($stepx, $stepy) = ( 0, 0 ); | |
2503 | my $step_size = $style eq "dashed" ? 8 : 2; | |
2504 | my ($counter, $count_end); | |
2505 | if ($x1 == $x2) { | |
2506 | $stepy = $step_size; | |
2507 | ($counter, $count_end) = ($y1, $y2); | |
2508 | } | |
2509 | else { | |
2510 | $stepx = $step_size; | |
2511 | ($counter, $count_end) = ($x1, $x2); | |
2512 | } | |
2513 | my ($x, $y) = ($x1, $y1); | |
2514 | while ($counter < $count_end) { | |
2515 | if ($style eq "dotted") { | |
2516 | $img->setpixel(x => $x, y => $y, color => $opts{color}); | |
2517 | } | |
2518 | else { | |
2519 | my $xe = $stepx ? $x + $stepx / 2 - 1 : $x; | |
2520 | $xe > $x2 and $xe = $x2; | |
2521 | my $ye = $stepy ? $y + $stepy / 2 - 1 : $y; | |
2522 | $ye > $y2 and $ye = $y2; | |
2523 | $img->line(x1 => $x, y1 => $y, x2 => $xe, y2 => $ye, %opts); | |
2524 | } | |
2525 | $counter += $step_size; | |
2526 | $x += $stepx; | |
2527 | $y += $stepy; | |
2528 | } | |
2529 | ||
2530 | return 1; | |
2531 | } | |
2532 | else { | |
2533 | $self->_error("Unknown line style $style"); | |
2534 | return; | |
2535 | } | |
2536 | } | |
2537 | ||
2538 | =item _box(xmin ..., style => $style) | |
2539 | ||
2540 | A wrapper for drawing styled box outlines. | |
2541 | ||
2542 | =cut | |
2543 | ||
2544 | sub _box { | |
2545 | my ($self, %opts) = @_; | |
2546 | ||
2547 | my $style = delete $opts{style} || "solid"; | |
2548 | my $img = delete $opts{img} | |
2549 | or die "No img supplied to _box"; | |
2550 | ||
2551 | if ($style eq "solid") { | |
2552 | return $img->box(%opts); | |
2553 | } | |
2554 | else { | |
2555 | my $box = delete $opts{box}; | |
2556 | # replicate Imager's defaults | |
2557 | my %work_opts = ( xmin => 0, ymin => 0, xmax => $img->getwidth() - 1, ymax => $img->getheight() -1, %opts, style => $style, img => $img ); | |
2558 | my ($xmin, $ymin, $xmax, $ymax) = delete @work_opts{qw/xmin ymin xmax ymax/}; | |
2559 | if ($box) { | |
2560 | ($xmin, $ymin, $xmax, $ymax) = @$box; | |
2561 | } | |
2562 | $xmin > $xmax and ($xmin, $xmax) = ($xmax, $xmin); | |
2563 | $ymin > $ymax and ($ymin, $ymax) = ($ymax, $ymin); | |
2564 | ||
2565 | if ($xmax - $xmin > 1) { | |
2566 | $self->_line(x1 => $xmin+1, y1 => $ymin, x2 => $xmax-1, y2 => $ymin, %work_opts); | |
2567 | $self->_line(x1 => $xmin+1, y1 => $ymax, x2 => $xmax-1, y2 => $ymax, %work_opts); | |
2568 | } | |
2569 | $self->_line(x1 => $xmin, y1 => $ymin, x2 => $xmin, y2 => $ymax, %work_opts); | |
86f73dc2 | 2570 | return $self->_line(x1 => $xmax, y1 => $ymin, x2 => $xmax, y2 => $ymax, %work_opts); |
56b495c0 TC |
2571 | } |
2572 | } | |
2573 | ||
5057a68f TC |
2574 | =item _feature_enabled($feature_name) |
2575 | ||
2576 | Check if the given feature is enabled in the work style. | |
2577 | ||
2578 | =cut | |
2579 | ||
86f73dc2 TC |
2580 | sub _feature_enabled { |
2581 | my ($self, $name) = @_; | |
2582 | ||
2583 | return $self->{_style}{features}{$name}; | |
2584 | } | |
2585 | ||
e68c6863 TC |
2586 | sub _line_marker { |
2587 | my ($self, $index) = @_; | |
2588 | ||
2589 | my $markers = $self->{'_style'}{'line_markers'}; | |
2590 | if (!$markers) { | |
2591 | return; | |
2592 | } | |
2593 | my $marker = $markers->[$index % @$markers]; | |
2594 | ||
2595 | return $marker; | |
2596 | } | |
2597 | ||
2598 | sub _draw_line_marker { | |
2599 | my $self = shift; | |
2600 | my ($x1, $y1, $series_counter) = @_; | |
2601 | ||
2602 | my $img = $self->_get_image(); | |
2603 | ||
2604 | my $style = $self->_line_marker($series_counter); | |
2605 | return unless $style; | |
2606 | ||
2607 | my $type = $style->{'shape'}; | |
2608 | my $radius = $style->{'radius'}; | |
2609 | ||
2610 | my $line_aa = $self->_get_number("lineaa"); | |
2611 | my $fill_aa = $self->_get_number("fill.aa"); | |
2612 | ||
2613 | if ($type eq 'circle') { | |
2614 | my @fill = $self->_data_fill($series_counter, [$x1 - $radius, $y1 - $radius, $x1 + $radius, $y1 + $radius]); | |
2615 | $img->circle(x => $x1, y => $y1, r => $radius, aa => $fill_aa, filled => 1, @fill); | |
2616 | } | |
2617 | elsif ($type eq 'open_circle') { | |
2618 | my $color = $self->_data_color($series_counter); | |
2619 | $img->circle(x => $x1, y => $y1, r => $radius, aa => $fill_aa, filled => 0, color => $color); | |
2620 | } | |
2621 | elsif ($type eq 'open_square') { | |
2622 | my $color = $self->_data_color($series_counter); | |
2623 | $img->box(xmin => $x1 - $radius, ymin => $y1 - $radius, xmax => $x1 + $radius, ymax => $y1 + $radius, filled => 0, color => $color); | |
2624 | } | |
2625 | elsif ($type eq 'open_triangle') { | |
2626 | my $color = $self->_data_color($series_counter); | |
2627 | $img->polyline( | |
2628 | points => [ | |
2629 | [$x1 - $radius, $y1 + $radius], | |
2630 | [$x1 + $radius, $y1 + $radius], | |
2631 | [$x1, $y1 - $radius], | |
2632 | [$x1 - $radius, $y1 + $radius], | |
2633 | ], | |
2634 | color => $color, aa => $line_aa); | |
2635 | } | |
2636 | elsif ($type eq 'open_diamond') { | |
2637 | my $color = $self->_data_color($series_counter); | |
2638 | $img->polyline( | |
2639 | points => [ | |
2640 | [$x1 - $radius, $y1], | |
2641 | [$x1, $y1 + $radius], | |
2642 | [$x1 + $radius, $y1], | |
2643 | [$x1, $y1 - $radius], | |
2644 | [$x1 - $radius, $y1], | |
2645 | ], | |
2646 | color => $color, aa => $line_aa); | |
2647 | } | |
2648 | elsif ($type eq 'square') { | |
2649 | my @fill = $self->_data_fill($series_counter, [$x1 - $radius, $y1 - $radius, $x1 + $radius, $y1 + $radius]); | |
2650 | $img->box(xmin => $x1 - $radius, ymin => $y1 - $radius, xmax => $x1 + $radius, ymax => $y1 + $radius, @fill); | |
2651 | } | |
2652 | elsif ($type eq 'diamond') { | |
2653 | # The gradient really doesn't work for diamond | |
2654 | my $color = $self->_data_color($series_counter); | |
2655 | $img->polygon( | |
2656 | points => [ | |
2657 | [$x1 - $radius, $y1], | |
2658 | [$x1, $y1 + $radius], | |
2659 | [$x1 + $radius, $y1], | |
2660 | [$x1, $y1 - $radius], | |
2661 | ], | |
2662 | filled => 1, color => $color, aa => $fill_aa); | |
2663 | } | |
2664 | elsif ($type eq 'triangle') { | |
2665 | # The gradient really doesn't work for triangle | |
2666 | my $color = $self->_data_color($series_counter); | |
2667 | $img->polygon( | |
2668 | points => [ | |
2669 | [$x1 - $radius, $y1 + $radius], | |
2670 | [$x1 + $radius, $y1 + $radius], | |
2671 | [$x1, $y1 - $radius], | |
2672 | ], | |
2673 | filled => 1, color => $color, aa => $fill_aa); | |
2674 | ||
2675 | } | |
2676 | elsif ($type eq 'x') { | |
2677 | my $color = $self->_data_color($series_counter); | |
2678 | $img->line(x1 => $x1 - $radius, y1 => $y1 -$radius, x2 => $x1 + $radius, y2 => $y1+$radius, aa => $line_aa, color => $color) || die $img->errstr; | |
2679 | $img->line(x1 => $x1 + $radius, y1 => $y1 -$radius, x2 => $x1 - $radius, y2 => $y1+$radius, aa => $line_aa, color => $color) || die $img->errstr; | |
2680 | } | |
2681 | elsif ($type eq 'plus') { | |
2682 | my $color = $self->_data_color($series_counter); | |
2683 | $img->line(x1 => $x1, y1 => $y1 -$radius, x2 => $x1, y2 => $y1+$radius, aa => $line_aa, color => $color) || die $img->errstr; | |
2684 | $img->line(x1 => $x1 + $radius, y1 => $y1, x2 => $x1 - $radius, y2 => $y1, aa => $line_aa, color => $color) || die $img->errstr; | |
2685 | } | |
2686 | } | |
2687 | ||
35574351 | 2688 | 1; |
e68c6863 | 2689 | |
35574351 TC |
2690 | __END__ |
2691 | ||
2692 | =back | |
2693 | ||
2694 | =head1 SEE ALSO | |
2695 | ||
2696 | Imager::Graph::Pie(3), Imager(3), perl(1). | |
2697 | ||
2698 | =head1 AUTHOR | |
2699 | ||
2700 | Tony Cook <tony@develop-help.com> | |
2701 | ||
54ada35d TC |
2702 | =head1 LICENSE |
2703 | ||
2704 | Imager::Graph is licensed under the same terms as perl itself. | |
2705 | ||
35574351 TC |
2706 | =head1 BLAME |
2707 | ||
2708 | Addi for producing a cool imaging module. :) | |
2709 | ||
2710 | =cut |