]>
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 | ||
10 | use Imager::Graph::SubClass; | |
11 | my $chart = Imager::Graph::SubClass->new; | |
81453d28 | 12 | my $img = $chart->draw(data=> \@data, ...) |
35574351 TC |
13 | or die $chart->error; |
14 | ||
15 | =head1 DESCRIPTION | |
16 | ||
17 | Imager::Graph provides style information to its base classes. It | |
18 | defines the colors, text display information and fills based on both | |
19 | built-in styles and modifications supplied by the user to the draw() | |
20 | method. | |
21 | ||
35574351 TC |
22 | =over |
23 | ||
24 | =cut | |
25 | ||
26 | use strict; | |
81453d28 | 27 | use warnings; |
35574351 TC |
28 | use vars qw($VERSION); |
29 | use Imager qw(:handy); | |
bb0de914 | 30 | use Imager::Fountain; |
35574351 | 31 | |
68a6c9c6 | 32 | $VERSION = '0.06'; |
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 | ||
49 | =item error | |
50 | ||
51 | Returns an error message. Only value if the draw() method returns false. | |
52 | ||
53 | =cut | |
54 | ||
55 | sub error { | |
56 | $_[0]->{_errstr}; | |
57 | } | |
58 | ||
59 | =item draw | |
60 | ||
61 | Creates a new image, draws the chart onto that image and returns it. | |
62 | ||
63 | Typically you will need to supply a C<data> parameter in the format | |
64 | required by that particular graph, and if your graph will use any | |
65 | text, a C<font> parameter | |
66 | ||
67 | You can also supply many different parameters which control the way | |
68 | the graph looks. These are supplied as keyword, value pairs, where | |
69 | the value can be a hashref containing sub values. | |
70 | ||
71 | The C<style> parameter will selects a basic color set, and possibly | |
72 | sets other related parameters. See L</"STYLES">. | |
73 | ||
81453d28 | 74 | my $font = Imager::Font->new(file => 'ImUgly.ttf'); |
75 | my $img = $chart->draw( | |
76 | data => \@data, | |
77 | font => $font, | |
78 | title => { | |
79 | text => "Hello, World!", | |
80 | size => 36, | |
81 | color => 'FF0000' | |
82 | } | |
83 | ); | |
35574351 TC |
84 | |
85 | When referring to a single sub-value this documentation will refer to | |
86 | 'title.color' rather than 'the color element of title'. | |
87 | ||
88 | Returns the graph image on success, or false on failure. | |
89 | ||
90 | =back | |
91 | ||
92 | =head1 STYLES | |
93 | ||
94 | The currently defined styles are: | |
95 | ||
96 | =over | |
97 | ||
7b94e723 TC |
98 | =item primary |
99 | ||
100 | a light grey background with no outlines. Uses primary colors for the | |
101 | data fills. | |
102 | ||
35574351 TC |
103 | =item primary_red |
104 | ||
105 | a light red background with no outlines. Uses primary colors for the | |
7b94e723 | 106 | data fills. |
35574351 TC |
107 | |
108 | Graphs drawn using this style should save well as a gif, even though | |
109 | some graphs may perform a slight blur. | |
110 | ||
7b94e723 | 111 | This was the default style, but the red was too loud. |
35574351 TC |
112 | |
113 | =item mono | |
114 | ||
115 | designed for monochrome output, such as most laser printers, this uses | |
116 | hatched fills for the data, and no colors. The returned image is a | |
117 | one channel image (which can be overridden with the C<channels> | |
118 | parameter.) | |
119 | ||
120 | You can also override the colors used by all components for background | |
121 | or drawing by supplying C<fg> and/or C<bg> parameters. ie. if you | |
122 | supply C<<fg=>'FF0000', channels=>3>> then the hash fills and anything | |
123 | else will be drawn in red. Another use might be to set a transparent | |
124 | background, by supplying C<<bg=>'00000000', channels=>4>>. | |
125 | ||
126 | This style outlines the legend if present and outlines the hashed fills. | |
127 | ||
35574351 TC |
128 | =item fount_lin |
129 | ||
130 | designed as a "pretty" style this uses linear fountain fills for the | |
131 | background and data fills, and adds a drop shadow. | |
132 | ||
133 | You can override the value used for text and outlines by setting the | |
134 | C<fg> parameter. | |
135 | ||
81453d28 | 136 | This is the default style. |
137 | ||
35574351 TC |
138 | =item fount_rad |
139 | ||
140 | also designed as a "pretty" style this uses radial fountain fills for | |
141 | the data and a linear blue to green fill for the background. | |
142 | ||
143 | =back | |
144 | ||
145 | =head1 FEATURES | |
146 | ||
147 | Each graph type has a number of features. These are used to add | |
148 | various items that are displayed in the graph area. Some common | |
149 | features are: | |
150 | ||
151 | =over | |
152 | ||
153 | =item legend | |
154 | ||
155 | adds a box containing boxes filled with the data filess, with | |
156 | the labels provided to the draw method. The legend will only be | |
157 | displayed if both the legend feature is enabled and labels are | |
158 | supplied. | |
159 | ||
160 | =item labels | |
161 | ||
162 | labels each data fill, usually by including text inside the data fill. | |
163 | If the text does not fit in the fill, they could be displayed in some | |
164 | other form, eg. as callouts in a pie graph. There usually isn't much | |
165 | point in including both labels and a legend. | |
166 | ||
167 | =item dropshadow | |
168 | ||
169 | a simple drop shadow is shown behind some of the graph elements. | |
170 | ||
171 | =back | |
172 | ||
173 | Each graph also has features specific to that graph. | |
174 | ||
175 | =head1 COMMON PARAMETERS | |
176 | ||
177 | When referring to a single sub-value this documentation will refer to | |
178 | 'title.color' rather than 'the color element of title'. | |
179 | ||
180 | Normally, except for the font parameter, these are controlled by | |
181 | styles, but these are the style parameters I'd mostly likely expect | |
182 | you want to use: | |
183 | ||
184 | =over | |
185 | ||
186 | =item font | |
187 | ||
188 | the Imager font object used to draw text on the chart. | |
189 | ||
190 | =item back | |
191 | ||
192 | the background fill for the graph. Default depends on the style. | |
193 | ||
194 | =item size | |
195 | ||
196 | the base size of the graph image. Default: 256 | |
197 | ||
198 | =item width | |
199 | ||
200 | the width of the graph image. Default: 1.5 * size (384) | |
201 | ||
202 | =item height | |
203 | ||
204 | the height of the graph image. Default: size (256) | |
205 | ||
206 | =item channels | |
207 | ||
208 | the number of channels in the image. Default: 3 (the 'mono' style | |
209 | sets this to 1). | |
210 | ||
211 | =item line | |
212 | ||
213 | the color used for drawing lines, such as outlines or callouts. | |
214 | Default depends on the current style. Set to undef to remove the | |
215 | outline from a style. | |
216 | ||
217 | =item title | |
218 | ||
219 | the text used for a graph title. Default: no title. Note: this is | |
220 | the same as the title=>{ text => ... } field. | |
221 | ||
222 | =over | |
223 | ||
224 | =item halign | |
225 | ||
226 | horizontal alignment of the title in the graph, one of 'left', | |
227 | 'center' or 'right'. Default: center | |
228 | ||
229 | =item valign | |
230 | ||
231 | vertical alignment of the title, one of 'top', 'center' or 'right'. | |
232 | Default: top. It's probably a bad idea to set this to 'center' unless | |
233 | you have a very short title. | |
234 | ||
235 | =back | |
236 | ||
237 | =item text | |
238 | ||
239 | This contains basic defaults used in drawing text. | |
240 | ||
241 | =over | |
242 | ||
243 | =item color | |
244 | ||
245 | the default color used for all text, defaults to the fg color. | |
246 | ||
247 | =item size | |
248 | ||
249 | the base size used for text, also used to scale many graph elements. | |
250 | Default: 14. | |
251 | ||
252 | =back | |
253 | ||
254 | =back | |
255 | ||
256 | =head1 BEYOND STYLES | |
257 | ||
258 | In most cases you will want to use just the styles, but you may want | |
259 | to exert more control over the way your chart looks. This section | |
260 | describes the options you can use to control the way your chart looks. | |
261 | ||
262 | Hopefully you don't need to read this. | |
263 | ||
264 | =over | |
265 | ||
266 | =item back | |
267 | ||
268 | The background of the graph. | |
269 | ||
270 | =item bg | |
271 | ||
272 | =item fg | |
273 | ||
274 | Used to define basic background and foreground colors for the graph. | |
275 | The bg color may be used for the background of the graph, and is used | |
276 | as a default for the background of hatcheed fills. The fg is used as | |
277 | the default for line and text colors. | |
278 | ||
279 | =item font | |
280 | ||
281 | The default font used by the graph. Normally you should supply this | |
282 | if your graph as any text. | |
283 | ||
284 | =item line | |
285 | ||
286 | The default line color. | |
287 | ||
288 | =item text | |
289 | ||
290 | defaults for drawing text. Other textual graph elements will inherit | |
291 | or modify these values. | |
292 | ||
293 | =over | |
294 | ||
295 | =item color | |
296 | ||
297 | default text color, defaults to the I<fg> color. | |
298 | ||
299 | =item size | |
300 | ||
301 | default text size. Default: 14. This is used to scale many graph | |
302 | elements, including padding and leader sizes. Other text elements | |
303 | will either use or scale this value. | |
304 | ||
305 | =item font | |
306 | ||
307 | default font object. Inherited from I<font>, which should have been | |
308 | supplied by the caller. | |
309 | ||
310 | =back | |
311 | ||
312 | =item title | |
313 | ||
314 | If you supply a scalar value for this element, it will be stored in | |
315 | the I<text> field. | |
316 | ||
317 | Defines the text, font and layout information for the title. | |
318 | ||
319 | =over | |
320 | ||
321 | =item color | |
322 | ||
323 | The color of the title, inherited from I<text.color>. | |
324 | ||
325 | =item font | |
326 | ||
327 | The font object used for the title, inherited from I<text.font>. | |
328 | ||
329 | =item size | |
330 | ||
331 | size of the title text. Default: double I<text.size> | |
332 | ||
333 | =item halign | |
334 | ||
335 | =item valign | |
336 | ||
337 | The horizontal and vertical alignment of the title. | |
338 | ||
339 | =back | |
340 | ||
341 | =item legend | |
342 | ||
343 | defines attributes of the graph legend, if present. | |
344 | ||
345 | =over | |
346 | ||
347 | =item color | |
348 | ||
349 | =item font | |
350 | ||
351 | =item size | |
352 | ||
353 | text attributes for the labels used in the legend. | |
354 | ||
355 | =item patchsize | |
356 | ||
357 | the width and height of the color patch in the legend. Defaults to | |
358 | 90% of the legend text size. | |
359 | ||
360 | =item patchgap | |
361 | ||
362 | the minimum gap between patches in pixels. Defaults to 30% of the | |
363 | patchsize. | |
364 | ||
365 | =item patchborder | |
366 | ||
367 | the color of the border drawn around each patch. Inherited from I<line>. | |
368 | ||
369 | =item halign | |
370 | ||
371 | =item valign | |
372 | ||
373 | the horizontal and vertical alignment of the legend within the graph. | |
374 | Defaults to 'right' and 'top'. | |
375 | ||
376 | =item padding | |
377 | ||
378 | the gap between the legend patches and text and the outside of it's | |
379 | box, or to the legend border, if any. | |
380 | ||
381 | =item outsidepadding | |
382 | ||
383 | the gap between the border and the outside of the legend's box. This | |
384 | is only used if the I<legend.border> attribute is defined. | |
385 | ||
386 | =item fill | |
387 | ||
388 | the background fill for the legend. Default: none | |
389 | ||
390 | =item border | |
391 | ||
392 | the border color of the legend. Default: none (no border is drawn | |
393 | around the legend.) | |
394 | ||
33a928b7 TC |
395 | =item orientation |
396 | ||
397 | The orientation of the legend. If this is C<vertical> the the patches | |
398 | and labels are stacked on top of each other. If this is C<horizontal> | |
399 | the patchs and labels are word wrapped across the image. Default: | |
400 | vertical. | |
401 | ||
35574351 TC |
402 | =back |
403 | ||
33a928b7 TC |
404 | For example to create a horizontal legend with borderless patches, |
405 | darker than the background, you might do: | |
406 | ||
407 | my $im = $chart->draw | |
408 | (..., | |
409 | legend => | |
410 | { | |
411 | patchborder => undef, | |
412 | orientation => 'horizontal', | |
413 | fill => { solid => Imager::Color->new(0, 0, 0, 32), } | |
414 | }, | |
415 | ...); | |
416 | ||
35574351 TC |
417 | =item callout |
418 | ||
419 | defines attributes for graph callouts, if any are present. eg. if the | |
420 | pie graph cannot fit the label into the pie graph segement it will | |
421 | present it as a callout. | |
422 | ||
423 | =over | |
424 | ||
425 | =item color | |
426 | ||
427 | =item font | |
428 | ||
429 | =item size | |
430 | ||
431 | the text attributes of the callout label. Inherited from I<text>. | |
432 | ||
433 | =item line | |
434 | ||
435 | the color of the callout lines. Inherited from I<line> | |
436 | ||
437 | =item inside | |
438 | ||
439 | =item outside | |
440 | ||
441 | the length of the leader on the inside and the outside of the fill, | |
442 | usually at some angle. Both default to the size of the callout text. | |
443 | ||
444 | =item leadlen | |
445 | ||
446 | the length of the horizontal portion of the leader. Default: | |
447 | I<callout.size>. | |
448 | ||
449 | =item gap | |
450 | ||
451 | the gap between the callout leader and the callout text. Defaults to | |
452 | 30% of the text callout size. | |
453 | ||
454 | =back | |
455 | ||
456 | =item label | |
457 | ||
458 | defines attributes for labels drawn into the data areas of a graph. | |
459 | ||
460 | =over | |
461 | ||
462 | =item color | |
463 | ||
464 | =item font | |
465 | ||
466 | =item size | |
467 | ||
468 | The text attributes of the labels. Inherited from I<text>. | |
469 | ||
470 | =back | |
471 | ||
472 | =item dropshadow | |
473 | ||
474 | the attributes of the graph's drop shadow | |
475 | ||
476 | =over | |
477 | ||
478 | =item fill | |
479 | ||
480 | the fill used for the drop shadow. Default: '404040' (dark gray) | |
481 | ||
482 | =item off | |
483 | ||
484 | the offset of the drop shadow. A convenience value inherited by offx | |
485 | and offy. Default: 40% of I<text.size>. | |
486 | ||
487 | =item offx | |
488 | ||
489 | =item offy | |
490 | ||
491 | the horizontal and vertical offsets of the drop shadow. Both | |
492 | inherited from I<dropshadow.off>. | |
493 | ||
494 | =item filter | |
495 | ||
496 | the filter description passed to Imager's filter method to blur the | |
497 | drop shadow. Default: an 11 element convolution filter. | |
498 | ||
499 | =back | |
500 | ||
501 | =item outline | |
502 | ||
503 | describes the lines drawn around filled data areas, such as the | |
504 | segments of a pie chart. | |
505 | ||
506 | =over | |
507 | ||
508 | =item line | |
509 | ||
510 | the line color of the outlines, inherited from I<line>. | |
511 | ||
512 | =back | |
513 | ||
514 | =item fills | |
515 | ||
516 | a reference to an array containing fills for each data item. | |
517 | ||
518 | You can mix fill types, ie. using a simple color for the first item, a | |
519 | hatched fill for the second and a fountain fill for the next. | |
520 | ||
521 | =back | |
522 | ||
523 | =head1 HOW VALUES WORK | |
524 | ||
525 | Internally rather than specifying literal color, fill, or font objects | |
526 | or literal sizes for each element, Imager::Graph uses a number of | |
527 | special values to inherit or modify values taken from other graph | |
528 | element names. | |
529 | ||
530 | =head2 Specifying colors | |
531 | ||
532 | You can specify colors by either supplying an Imager::Color object, by | |
533 | supplying lookup of another color, or by supplying a single value that | |
534 | Imager::Color::new can use as an initializer. The most obvious is | |
535 | just a 6 or 8 digit hex value representing the red, green, blue and | |
536 | optionally alpha channels of the image. | |
537 | ||
538 | You can lookup another color by using the lookup() "function", for | |
539 | example if you give a color as "lookup(fg)" then Imager::Graph will | |
540 | look for the fg element in the current style (or as overridden by | |
541 | you.) This is used internally by Imager::Graph to set up the | |
542 | relationships between the colors of various elements, for example the | |
543 | default style information contains: | |
544 | ||
545 | text=>{ | |
546 | color=>'lookup(fg)', | |
547 | ... | |
548 | }, | |
549 | legend =>{ | |
550 | color=>'lookup(text.color)', | |
551 | ... | |
552 | }, | |
553 | ||
554 | So by setting the I<fg> color, you also set the default text color, | |
555 | since each text element uses lookup(text.color) as its value. | |
556 | ||
557 | =head2 Specifying fills | |
558 | ||
559 | Fills can be used for the graph background color, the background color | |
560 | for the legend block and for the fills used for each data element. | |
561 | ||
562 | You can specify a fill as a L<color value|Specifying colors> or as a | |
33a928b7 | 563 | general fill, see L<Imager::Fill> for details. |
35574351 TC |
564 | |
565 | You don't need (or usually want) to call Imager::Fill::new yourself, | |
566 | since the various fill functions will call it for you, and | |
567 | Imager::Graph provides some hooks to make them more useful. | |
568 | ||
569 | =over | |
570 | ||
571 | =item * | |
572 | ||
573 | with hatched fills, if you don't supply a 'fg' or 'bg' parameter, | |
574 | Imager::Graph will supply the current graph fg and bg colors. | |
575 | ||
576 | =item * | |
577 | ||
578 | with fountain fill, you can supply the xa_ratio, ya_ratio, xb_ratio | |
579 | and yb_ratio parameters, and they will be scaled in the fill area to | |
580 | define the fountain fills xa, ya, xb and yb parameters. | |
581 | ||
582 | =back | |
583 | ||
584 | As with colors, you can use lookup(name) or lookup(name1.name2) to | |
585 | have one element to inherit the fill of another. | |
586 | ||
33a928b7 TC |
587 | Imager::Graph defaults the fill combine value to C<'normal'>. This |
588 | doesn't apply to simple color fills. | |
589 | ||
35574351 TC |
590 | =head2 Specifying numbers |
591 | ||
592 | You can specify various numbers, usually representing the size of | |
593 | something, commonly text, but sometimes the length of a line or the | |
594 | size of a gap. | |
595 | ||
596 | You can use the same lookup mechanism as with colors and fills, but | |
597 | you can also scale values. For example, 'scale(0.5,text.size)' will | |
598 | return half the size of the normal text size. | |
599 | ||
600 | As with colors, this is used internally to scale graph elements based | |
601 | on the base text size. If you change the base text size then other | |
602 | graph elements will scale as well. | |
603 | ||
604 | =head2 Specifying other elements | |
605 | ||
606 | Other elements, such as fonts, or parameters for a filter, can also | |
607 | use the lookup(name) mechanism. | |
608 | ||
609 | =head1 INTERNAL METHODS | |
610 | ||
611 | Only useful if you need to fix bugs, add features or create a new | |
612 | graph class. | |
613 | ||
614 | =over | |
615 | ||
616 | =cut | |
617 | ||
618 | my %style_defs = | |
619 | ( | |
620 | back=> 'lookup(bg)', | |
621 | line=> 'lookup(fg)', | |
622 | text=>{ | |
623 | color => 'lookup(fg)', | |
624 | font => 'lookup(font)', | |
625 | size => 14, | |
626 | }, | |
627 | title=>{ | |
628 | color => 'lookup(text.color)', | |
629 | font => 'lookup(text.font)', | |
630 | halign => 'center', | |
631 | valign => 'top', | |
632 | size => 'scale(text.size,2.0)', | |
633 | }, | |
634 | legend =>{ | |
635 | color => 'lookup(text.color)', | |
636 | font => 'lookup(text.font)', | |
637 | size => 'lookup(text.size)', | |
638 | patchsize => 'scale(legend.size,0.9)', | |
639 | patchgap => 'scale(legend.patchsize,0.3)', | |
640 | patchborder => 'lookup(line)', | |
641 | halign => 'right', | |
642 | valign => 'top', | |
643 | padding => 'scale(legend.size,0.3)', | |
644 | outsidepadding => 'scale(legend.padding,0.4)', | |
645 | }, | |
646 | callout => { | |
647 | color => 'lookup(text.color)', | |
648 | font => 'lookup(text.font)', | |
649 | size => 'lookup(text.size)', | |
650 | line => 'lookup(line)', | |
651 | inside => 'lookup(callout.size)', | |
652 | outside => 'lookup(callout.size)', | |
653 | leadlen => 'scale(0.8,callout.size)', | |
654 | gap => 'scale(callout.size,0.3)', | |
655 | }, | |
656 | label => { | |
657 | font => 'lookup(text.font)', | |
658 | size => 'lookup(text.size)', | |
659 | color => 'lookup(text.color)', | |
660 | hpad => 'lookup(label.pad)', | |
661 | vpad => 'lookup(label.pad)', | |
662 | pad => 'scale(label.size,0.2)', | |
663 | pcformat => sub { sprintf "%s (%.0f%%)", $_[0], $_[1] }, | |
664 | pconlyformat => sub { sprintf "%.1f%%", $_[0] }, | |
665 | }, | |
666 | dropshadow => { | |
320f5a49 | 667 | fill => { solid => Imager::Color->new(0, 0, 0, 96) }, |
35574351 TC |
668 | off => 'scale(0.4,text.size)', |
669 | offx => 'lookup(dropshadow.off)', | |
670 | offy => 'lookup(dropshadow.off)', | |
671 | filter => { type=>'conv', | |
672 | # this needs a fairly heavy blur | |
673 | coef=>[0.1, 0.2, 0.4, 0.6, 0.7, 0.9, 1.2, | |
674 | 0.9, 0.7, 0.6, 0.4, 0.2, 0.1 ] }, | |
675 | }, | |
676 | outline => { | |
677 | line =>'lookup(line)', | |
678 | }, | |
679 | size=>256, | |
680 | width=>'scale(1.5,size)', | |
681 | height=>'lookup(size)', | |
682 | ); | |
683 | ||
684 | =item _error($message) | |
685 | ||
686 | Sets the error field of the object and returns an empty list or undef, | |
687 | depending on context. Should be used for error handling, since it may | |
688 | provide some user hooks at some point. | |
689 | ||
690 | =cut | |
691 | ||
692 | sub _error { | |
693 | my ($self, $error) = @_; | |
694 | ||
695 | $self->{_errstr} = $error; | |
696 | ||
697 | return; | |
698 | } | |
699 | ||
700 | ||
701 | =item _style_defs() | |
702 | ||
703 | Returns the style defaults, such as the relationships between line | |
704 | color and text color. | |
705 | ||
706 | Intended to be over-ridden by base classes to provide graph specific | |
707 | defaults. | |
708 | ||
709 | =cut | |
710 | ||
711 | sub _style_defs { | |
712 | \%style_defs; | |
713 | } | |
714 | ||
81453d28 | 715 | # Let's make the default something that looks really good, so folks will be interested enough to customize the style. |
716 | my $def_style = 'fount_lin'; | |
35574351 TC |
717 | |
718 | my %styles = | |
719 | ( | |
7b94e723 TC |
720 | primary => |
721 | { | |
722 | fills=> | |
723 | [ | |
724 | qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF) | |
725 | ], | |
726 | fg=>'000000', | |
727 | bg=>'E0E0E0', | |
728 | legend=> | |
729 | { | |
730 | #patchborder=>'000000' | |
731 | }, | |
732 | }, | |
35574351 TC |
733 | primary_red => |
734 | { | |
735 | fills=> | |
736 | [ | |
737 | qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF) | |
738 | ], | |
739 | fg=>'000000', | |
740 | bg=>'C08080', | |
741 | legend=> | |
742 | { | |
743 | patchborder=>'000000' | |
744 | }, | |
745 | }, | |
746 | mono => | |
747 | { | |
748 | fills=> | |
749 | [ | |
750 | { hatch=>'slash2' }, | |
751 | { hatch=>'slosh2' }, | |
752 | { hatch=>'vline2' }, | |
753 | { hatch=>'hline2' }, | |
754 | { hatch=>'cross2' }, | |
755 | { hatch=>'grid2' }, | |
756 | { hatch=>'stipple3' }, | |
757 | { hatch=>'stipple2' }, | |
758 | ], | |
759 | channels=>1, | |
760 | bg=>'FFFFFF', | |
761 | fg=>'000000', | |
762 | features=>{ outline=>1 }, | |
763 | pie =>{ | |
764 | blur=>undef, | |
765 | }, | |
766 | }, | |
bb0de914 | 767 | fount_lin => |
35574351 TC |
768 | { |
769 | fills=> | |
770 | [ | |
771 | { fountain=>'linear', | |
772 | xa_ratio=>0.13, ya_ratio=>0.13, xb_ratio=>0.87, yb_ratio=>0.87, | |
35574351 TC |
773 | segments => Imager::Fountain->simple(positions=>[0, 1], |
774 | colors=>[ NC('FFC0C0'), NC('FF0000') ]), | |
775 | }, | |
776 | { fountain=>'linear', | |
777 | xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, | |
778 | segments => Imager::Fountain->simple(positions=>[0, 1], | |
779 | colors=>[ NC('C0FFC0'), NC('00FF00') ]), | |
780 | }, | |
781 | { fountain=>'linear', | |
782 | xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, | |
783 | segments => Imager::Fountain->simple(positions=>[0, 1], | |
784 | colors=>[ NC('C0C0FF'), NC('0000FF') ]), | |
785 | }, | |
786 | { fountain=>'linear', | |
787 | xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, | |
788 | segments => Imager::Fountain->simple(positions=>[0, 1], | |
789 | colors=>[ NC('FFFFC0'), NC('FFFF00') ]), | |
790 | }, | |
791 | { fountain=>'linear', | |
792 | xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, | |
793 | segments => Imager::Fountain->simple(positions=>[0, 1], | |
794 | colors=>[ NC('C0FFFF'), NC('00FFFF') ]), | |
795 | }, | |
796 | { fountain=>'linear', | |
797 | xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, | |
798 | segments => Imager::Fountain->simple(positions=>[0, 1], | |
799 | colors=>[ NC('FFC0FF'), NC('FF00FF') ]), | |
800 | }, | |
801 | ], | |
802 | back=>{ fountain=>'linear', | |
803 | xa_ratio=>0, ya_ratio=>0, | |
804 | xb_ratio=>1.0, yb_ratio=>1.0, | |
805 | segments=>Imager::Fountain->simple | |
806 | ( positions=>[0, 1], | |
807 | colors=>[ NC('6060FF'), NC('60FF60') ]) }, | |
808 | fg=>'000000', | |
809 | bg=>'FFFFFF', | |
810 | features=>{ dropshadow=>1 }, | |
bb0de914 TC |
811 | }, |
812 | fount_rad => | |
813 | { | |
35574351 TC |
814 | fills=> |
815 | [ | |
816 | { fountain=>'radial', | |
817 | xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5, | |
818 | segments => Imager::Fountain->simple(positions=>[0, 1], | |
819 | colors=>[ NC('FF8080'), NC('FF0000') ]), | |
820 | }, | |
821 | { fountain=>'radial', | |
822 | xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5, | |
823 | segments => Imager::Fountain->simple(positions=>[0, 1], | |
824 | colors=>[ NC('80FF80'), NC('00FF00') ]), | |
825 | }, | |
826 | { fountain=>'radial', | |
827 | xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5, | |
828 | segments => Imager::Fountain->simple(positions=>[0, 1], | |
829 | colors=>[ NC('808080FF'), NC('0000FF') ]), | |
830 | }, | |
831 | { fountain=>'radial', | |
832 | xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5, | |
833 | segments => Imager::Fountain->simple(positions=>[0, 1], | |
834 | colors=>[ NC('FFFF80'), NC('FFFF00') ]), | |
835 | }, | |
836 | { fountain=>'radial', | |
837 | xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5, | |
838 | segments => Imager::Fountain->simple(positions=>[0, 1], | |
839 | colors=>[ NC('80FFFF'), NC('00FFFF') ]), | |
840 | }, | |
841 | { fountain=>'radial', | |
842 | xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5, | |
843 | segments => Imager::Fountain->simple(positions=>[0, 1], | |
844 | colors=>[ NC('FF80FF'), NC('FF00FF') ]), | |
845 | }, | |
846 | ], | |
847 | back=>{ fountain=>'linear', | |
848 | xa_ratio=>0, ya_ratio=>0, | |
849 | xb_ratio=>1.0, yb_ratio=>1.0, | |
850 | segments=>Imager::Fountain->simple | |
851 | ( positions=>[0, 1], | |
852 | colors=>[ NC('6060FF'), NC('60FF60') ]) }, | |
853 | fg=>'000000', | |
854 | bg=>'FFFFFF', | |
bb0de914 TC |
855 | } |
856 | ); | |
35574351 TC |
857 | |
858 | =item $self->_style_setup(\%opts) | |
859 | ||
860 | Uses the values from %opts to build a customized hash describing the | |
861 | way the graph should be drawn. | |
862 | ||
863 | =cut | |
864 | ||
865 | sub _style_setup { | |
866 | my ($self, $opts) = @_; | |
867 | my $style_defs = $self->_style_defs; | |
868 | my $style; | |
869 | $style = $styles{$opts->{style}} if $opts->{style}; | |
870 | $style ||= $styles{$def_style}; | |
871 | ||
872 | my @search_list = ( $style_defs, $style, $opts); | |
873 | my %work; | |
874 | ||
875 | my @composite = $self->_composite(); | |
876 | my %composite; | |
877 | @composite{@composite} = @composite; | |
878 | ||
879 | for my $src (@search_list) { | |
880 | for my $key (keys %$src) { | |
881 | if ($composite{$key}) { | |
882 | $work{$key} = {} unless exists $work{$key}; | |
883 | if (ref $src->{$key}) { | |
884 | # some keys have sub values, especially text | |
885 | @{$work{$key}}{keys %{$src->{$key}}} = values %{$src->{$key}}; | |
886 | } | |
887 | else { | |
888 | # assume it's the text for a title or something | |
889 | $work{$key}{text} = $src->{$key}; | |
890 | } | |
891 | } | |
892 | else { | |
893 | $work{$key} = $src->{$key}; | |
894 | } | |
895 | } | |
896 | } | |
897 | ||
898 | # features are handled specially | |
899 | $work{features} = {}; | |
900 | for my $src (@search_list) { | |
901 | if ($src->{features}) { | |
902 | if (ref $src->{features}) { | |
903 | if (ref($src->{features}) =~ /ARRAY/) { | |
904 | # just set those features | |
905 | for my $feature (@{$src->{features}}) { | |
906 | $work{features}{$feature} = 1; | |
907 | } | |
908 | } | |
909 | elsif (ref($src->{features}) =~ /HASH/) { | |
910 | if ($src->{features}{reset}) { | |
911 | $work{features} = {}; # only the ones the user specifies | |
912 | } | |
913 | @{$work{features}}{keys %{$src->{features}}} = | |
914 | values(%{$src->{features}}); | |
915 | } | |
916 | } | |
917 | else { | |
918 | # just set that single feature | |
919 | $work{features}{$src->{features}} = 1; | |
920 | } | |
921 | } | |
922 | } | |
923 | #use Data::Dumper; | |
924 | #print Dumper(\%work); | |
925 | ||
926 | $self->{_style} = \%work; | |
927 | } | |
928 | ||
929 | =item $self->_get_thing($name) | |
930 | ||
931 | Retrieve some general 'thing'. | |
932 | ||
933 | Supports the 'lookup(foo)' mechanism. | |
934 | ||
935 | =cut | |
936 | ||
937 | sub _get_thing { | |
938 | my ($self, $name, @depth) = @_; | |
939 | ||
940 | push(@depth, $name); | |
941 | my $what; | |
942 | if ($name =~ /^(\w+)\.(\w+)$/) { | |
943 | $what = $self->{_style}{$1}{$2}; | |
944 | } | |
945 | else { | |
946 | $what = $self->{_style}{$name}; | |
947 | } | |
948 | defined $what or | |
949 | return; | |
950 | if (ref $what) { | |
951 | return $what; | |
952 | } | |
953 | elsif ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) { | |
954 | @depth < MAX_DEPTH | |
955 | or return $self->_error("too many levels of recursion in lookup(@depth)"); | |
956 | return $self->_get_thing($1, @depth); | |
957 | } | |
958 | else { | |
959 | return $what; | |
960 | } | |
961 | } | |
962 | ||
963 | =item $self->_get_number($name) | |
964 | ||
965 | Retrieves a number from the style. The value in the style can be the | |
966 | number, or one of two functions: | |
967 | ||
968 | =over | |
969 | ||
970 | =item lookup(newname) | |
971 | ||
972 | Recursively looks up I<newname> in the style. | |
973 | ||
974 | =item scale(value1,value2) | |
975 | ||
33a928b7 | 976 | Each value can be a number or a name. Names are recursively looked up |
35574351 TC |
977 | in the style and the product is returned. |
978 | ||
979 | =back | |
980 | ||
981 | =cut | |
bb0de914 | 982 | |
35574351 TC |
983 | sub _get_number { |
984 | my ($self, $name, @depth) = @_; | |
985 | ||
986 | push(@depth, $name); | |
987 | my $what; | |
988 | if ($name =~ /^(\w+)\.(\w+)$/) { | |
989 | $what = $self->{_style}{$1}{$2}; | |
990 | } | |
991 | else { | |
992 | $what = $self->{_style}{$name}; | |
993 | } | |
994 | defined $what or | |
995 | return $self->_error("$name is undef (@depth)"); | |
996 | ||
997 | if (ref $what) { | |
998 | if ($what =~ /CODE/) { | |
999 | $what = $what->($self, $name); | |
1000 | } | |
1001 | } | |
1002 | else { | |
1003 | if ($what =~ /^lookup\(([\w.]+)\)$/) { | |
1004 | @depth < MAX_DEPTH | |
1005 | or return $self->_error("too many levels of recursion in lookup (@depth)"); | |
1006 | return $self->_get_number($1, @depth); | |
1007 | } | |
1008 | elsif ($what =~ /^scale\( | |
1009 | ((?:[a-z][\w.]*)|$NUM_RE) | |
1010 | , | |
1011 | ((?:[a-z][\w.]*)|$NUM_RE)\)$/x) { | |
1012 | my ($left, $right) = ($1, $2); | |
1013 | unless ($left =~ /^$NUM_RE$/) { | |
1014 | @depth < MAX_DEPTH | |
1015 | or return $self->_error("too many levels of recursion in scale (@depth)"); | |
1016 | $left = $self->_get_number($left, @depth); | |
1017 | } | |
1018 | unless ($right =~ /^$NUM_RE$/) { | |
1019 | @depth < MAX_DEPTH | |
1020 | or return $self->_error("too many levels of recursion in scale (@depth)"); | |
1021 | $right = $self->_get_number($right, @depth); | |
1022 | } | |
1023 | return $left * $right; | |
1024 | } | |
1025 | else { | |
1026 | return $what+0; | |
1027 | } | |
1028 | } | |
1029 | } | |
1030 | ||
379c5b02 TC |
1031 | =item $self->_get_integer($name) |
1032 | ||
1033 | Retrieves an integer from the style. This is a simple wrapper around | |
1034 | _get_number() that rounds the result to an integer. | |
1035 | ||
1036 | =cut | |
1037 | ||
1038 | sub _get_integer { | |
1039 | my ($self, $name, @depth) = @_; | |
1040 | ||
1041 | my $number = $self->_get_number($name, @depth) | |
1042 | or return; | |
1043 | ||
1044 | return sprintf("%.0f", $number); | |
1045 | } | |
1046 | ||
35574351 TC |
1047 | =item _get_color($name) |
1048 | ||
1049 | Returns a color object of the given name from the style hash. | |
1050 | ||
1051 | Uses Imager::Color->new to translate normal scalars into color objects. | |
1052 | ||
1053 | Allows the lookup(name) mechanism. | |
1054 | ||
1055 | =cut | |
1056 | ||
1057 | sub _get_color { | |
1058 | my ($self, $name, @depth) = @_; | |
1059 | ||
1060 | push(@depth, $name); | |
1061 | my $what; | |
1062 | if ($name =~ /^(\w+)\.(\w+)$/) { | |
1063 | $what = $self->{_style}{$1}{$2}; | |
1064 | } | |
1065 | else { | |
1066 | $what = $self->{_style}{$name}; | |
1067 | } | |
1068 | ||
1069 | defined($what) | |
1070 | or return $self->_error("$name was undefined (@depth)"); | |
1071 | ||
1072 | unless (ref $what) { | |
1073 | if ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) { | |
1074 | @depth < MAX_DEPTH or | |
1075 | return $self->_error("too many levels of recursion in lookup (@depth)"); | |
1076 | ||
1077 | return $self->_get_color($1, @depth); | |
1078 | } | |
1079 | $what = Imager::Color->new($what); | |
1080 | } | |
1081 | ||
1082 | $what; | |
1083 | } | |
1084 | ||
1085 | =item _translate_fill($what, $box) | |
1086 | ||
1087 | Given the value of a fill, either attempts to convert it into a fill | |
1088 | list (one of C<<color=>$color_value, filled=>1>> or C<<fill=>{ fill | |
1089 | parameters }>>), or to lookup another fill that is referred to with | |
1090 | the 'lookup(name)' mechanism. | |
1091 | ||
1092 | This function does the fg and bg initialization for hatched fills, and | |
1093 | translation of *_ratio for fountain fills (using the $box parameter). | |
1094 | ||
1095 | =cut | |
1096 | ||
1097 | sub _translate_fill { | |
1098 | my ($self, $what, $box, @depth) = @_; | |
1099 | ||
1100 | if (ref $what) { | |
1101 | if (UNIVERSAL::isa($what, "Imager::Color")) { | |
1102 | return ( color=>Imager::Color->new($what), filled=>1 ); | |
1103 | } | |
1104 | else { | |
1105 | # a general fill | |
33a928b7 TC |
1106 | # default to normal combine mode |
1107 | my %work = ( combine => 'normal', %$what ); | |
35574351 | 1108 | if ($what->{hatch}) { |
35574351 TC |
1109 | if (!$work{fg}) { |
1110 | $work{fg} = $self->_get_color('fg') | |
1111 | or return; | |
1112 | } | |
1113 | if (!$work{bg}) { | |
1114 | $work{bg} = $self->_get_color('bg') | |
1115 | or return; | |
1116 | } | |
1117 | return ( fill=>\%work ); | |
1118 | } | |
1119 | elsif ($what->{fountain}) { | |
35574351 TC |
1120 | for my $key (qw(xa ya xb yb)) { |
1121 | if (exists $work{"${key}_ratio"}) { | |
1122 | if ($key =~ /^x/) { | |
1123 | $work{$key} = $box->[0] + $work{"${key}_ratio"} | |
1124 | * ($box->[2] - $box->[0]); | |
1125 | } | |
1126 | else { | |
1127 | $work{$key} = $box->[1] + $work{"${key}_ratio"} | |
1128 | * ($box->[3] - $box->[1]); | |
1129 | } | |
1130 | } | |
1131 | } | |
1132 | return ( fill=>\%work ); | |
1133 | } | |
1134 | else { | |
33a928b7 | 1135 | return ( fill=> \%work ); |
35574351 TC |
1136 | } |
1137 | } | |
1138 | } | |
1139 | else { | |
1140 | if ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) { | |
1141 | return $self->_get_fill($1, $box, @depth); | |
1142 | } | |
1143 | else { | |
1144 | # assumed to be an Imager::Color single value | |
1145 | return ( color=>Imager::Color->new($what), filled=>1 ); | |
1146 | } | |
1147 | } | |
1148 | } | |
1149 | ||
1150 | =item _data_fill($index, $box) | |
1151 | ||
1152 | Retrieves the fill parameters for a data area fill. | |
1153 | ||
1154 | =cut | |
1155 | ||
1156 | sub _data_fill { | |
1157 | my ($self, $index, $box) = @_; | |
1158 | ||
1159 | my $fills = $self->{_style}{fills}; | |
1160 | return $self->_translate_fill($fills->[$index % @$fills], $box, | |
1161 | "data.$index"); | |
1162 | } | |
1163 | ||
1164 | =item _get_fill($index, $box) | |
1165 | ||
1166 | Retrieves fill parameters for a named fill. | |
1167 | ||
1168 | =cut | |
1169 | ||
1170 | sub _get_fill { | |
1171 | my ($self, $name, $box, @depth) = @_; | |
1172 | ||
1173 | push(@depth, $name); | |
1174 | my $what; | |
1175 | if ($name =~ /^(\w+)\.(\w+)$/) { | |
1176 | $what = $self->{_style}{$1}{$2}; | |
1177 | } | |
1178 | else { | |
1179 | $what = $self->{_style}{$name}; | |
1180 | } | |
1181 | ||
1182 | defined($what) | |
1183 | or return $self->_error("no fill $name found"); | |
1184 | ||
1185 | return $self->_translate_fill($what, $box, @depth); | |
1186 | } | |
1187 | ||
1188 | =item _make_img() | |
1189 | ||
1190 | Builds the image object for the graph and fills it with the background | |
1191 | fill. | |
1192 | ||
1193 | =cut | |
1194 | ||
1195 | sub _make_img { | |
1196 | my ($self) = @_; | |
35574351 | 1197 | |
81453d28 | 1198 | my $width = $self->_get_number('width') || 256; |
1199 | my $height = $self->_get_number('height') || 256; | |
35574351 TC |
1200 | my $channels = $self->{_style}{channels}; |
1201 | ||
1202 | $channels ||= 3; | |
1203 | ||
1204 | my $img = Imager->new(xsize=>$width, ysize=>$height, channels=>$channels); | |
1205 | ||
1206 | $img->box($self->_get_fill('back', [ 0, 0, $width-1, $height-1])); | |
1207 | ||
1208 | $img; | |
1209 | } | |
1210 | ||
1211 | sub _text_style { | |
1212 | my ($self, $name) = @_; | |
1213 | ||
1214 | my %work; | |
1215 | ||
1216 | if ($self->{_style}{$name}) { | |
1217 | %work = %{$self->{_style}{$name}}; | |
1218 | } | |
1219 | else { | |
1220 | %work = %{$self->{_style}{text}}; | |
1221 | } | |
1222 | $work{font} | |
1223 | or return $self->_error("$name has no font parameter"); | |
1224 | ||
1225 | $work{font} = $self->_get_thing("$name.font") | |
1226 | or return $self->_error("invalid font"); | |
1227 | UNIVERSAL::isa($work{font}, "Imager::Font") | |
1228 | or return $self->_error("$name.font is not a font"); | |
1229 | if ($work{color} && !ref $work{color}) { | |
1230 | $work{color} = $self->_get_color("$name.color") | |
1231 | or return; | |
1232 | } | |
1233 | $work{size} = $self->_get_number("$name.size"); | |
1234 | $work{sizew} = $self->_get_number("$name.sizew") | |
1235 | if $work{sizew}; | |
1236 | ||
1237 | %work; | |
1238 | } | |
1239 | ||
1240 | sub _text_bbox { | |
1241 | my ($self, $text, $name) = @_; | |
1242 | ||
1243 | my %text_info = $self->_text_style($name); | |
1244 | ||
81453d28 | 1245 | if (!defined $text_info{font}) { |
1246 | die "No font or invalid font specified, and we're trying to draw text.\n"; | |
1247 | } | |
35574351 TC |
1248 | my @bbox = $text_info{font}->bounding_box(%text_info, string=>$text, |
1249 | canon=>1); | |
1250 | ||
1251 | return @bbox[0..3]; | |
1252 | } | |
1253 | ||
1254 | sub _align_box { | |
1255 | my ($self, $box, $chart_box, $name) = @_; | |
1256 | ||
1257 | my $halign = $self->{_style}{$name}{halign} | |
1258 | or $self->_error("no halign for $name"); | |
1259 | my $valign = $self->{_style}{$name}{valign}; | |
1260 | ||
1261 | if ($halign eq 'right') { | |
1262 | $box->[0] += $chart_box->[2] - $box->[2]; | |
1263 | } | |
1264 | elsif ($halign eq 'left') { | |
1265 | $box->[0] = $chart_box->[0]; | |
1266 | } | |
1267 | elsif ($halign eq 'center' || $halign eq 'centre') { | |
1268 | $box->[0] = ($chart_box->[0] + $chart_box->[2] - $box->[2])/2; | |
1269 | } | |
1270 | else { | |
1271 | return $self->_error("invalid halign $halign for $name"); | |
1272 | } | |
1273 | ||
1274 | if ($valign eq 'top') { | |
1275 | $box->[1] = $chart_box->[1]; | |
1276 | } | |
1277 | elsif ($valign eq 'bottom') { | |
1278 | $box->[1] = $chart_box->[3] - $box->[3]; | |
1279 | } | |
1280 | elsif ($valign eq 'center' || $valign eq 'centre') { | |
1281 | $box->[1] = ($chart_box->[1] + $chart_box->[3] - $box->[3])/2; | |
1282 | } | |
1283 | else { | |
1284 | return $self->_error("invalid valign $valign for $name"); | |
1285 | } | |
1286 | $box->[2] += $box->[0]; | |
1287 | $box->[3] += $box->[1]; | |
1288 | } | |
1289 | ||
1290 | sub _remove_box { | |
1291 | my ($self, $chart_box, $object_box) = @_; | |
1292 | ||
1293 | my $areax; | |
1294 | my $areay; | |
1295 | if ($object_box->[0] - $chart_box->[0] | |
1296 | < $chart_box->[2] - $object_box->[2]) { | |
1297 | $areax = ($object_box->[2] - $chart_box->[0]) | |
1298 | * ($chart_box->[3] - $chart_box->[1]); | |
1299 | } | |
1300 | else { | |
1301 | $areax = ($chart_box->[2] - $object_box->[0]) | |
1302 | * ($chart_box->[3] - $chart_box->[1]); | |
1303 | } | |
1304 | ||
1305 | if ($object_box->[1] - $chart_box->[1] | |
1306 | < $chart_box->[3] - $object_box->[3]) { | |
1307 | $areay = ($object_box->[3] - $chart_box->[1]) | |
1308 | * ($chart_box->[2] - $chart_box->[0]); | |
1309 | } | |
1310 | else { | |
1311 | $areay = ($chart_box->[3] - $object_box->[1]) | |
1312 | * ($chart_box->[2] - $chart_box->[0]); | |
1313 | } | |
1314 | ||
1315 | if ($areay < $areax) { | |
1316 | if ($object_box->[1] - $chart_box->[1] | |
1317 | < $chart_box->[3] - $object_box->[3]) { | |
1318 | $chart_box->[1] = $object_box->[3]; | |
1319 | } | |
1320 | else { | |
1321 | $chart_box->[3] = $object_box->[1]; | |
1322 | } | |
1323 | } | |
1324 | else { | |
1325 | if ($object_box->[0] - $chart_box->[0] | |
1326 | < $chart_box->[2] - $object_box->[2]) { | |
1327 | $chart_box->[0] = $object_box->[2]; | |
1328 | } | |
1329 | else { | |
1330 | $chart_box->[2] = $object_box->[0]; | |
1331 | } | |
1332 | } | |
1333 | } | |
1334 | ||
1335 | sub _draw_legend { | |
1336 | my ($self, $img, $labels, $chart_box) = @_; | |
1337 | ||
33a928b7 TC |
1338 | my $orient = $self->_get_thing('legend.orientation'); |
1339 | defined $orient or $orient = 'vertical'; | |
1340 | ||
1341 | if ($orient eq 'vertical') { | |
1342 | return $self->_draw_legend_vertical($img, $labels, $chart_box); | |
1343 | } | |
1344 | elsif ($orient eq 'horizontal') { | |
1345 | return $self->_draw_legend_horizontal($img, $labels, $chart_box); | |
1346 | } | |
1347 | else { | |
1348 | return $self->_error("Unknown legend.orientation $orient"); | |
1349 | } | |
1350 | } | |
1351 | ||
1352 | sub _draw_legend_horizontal { | |
1353 | my ($self, $img, $labels, $chart_box) = @_; | |
1354 | ||
1355 | defined(my $padding = $self->_get_integer('legend.padding')) | |
1356 | or return; | |
1357 | my $patchsize = $self->_get_integer('legend.patchsize') | |
1358 | or return; | |
1359 | defined(my $gap = $self->_get_integer('legend.patchgap')) | |
1360 | or return; | |
1361 | ||
1362 | my $minrowsize = $patchsize + $gap; | |
1363 | my ($width, $height) = (0,0); | |
1364 | my $row_height = $minrowsize; | |
1365 | my $pos = 0; | |
1366 | my @sizes; | |
1367 | my @offsets; | |
1368 | for my $label (@$labels) { | |
1369 | my @text_box = $self->_text_bbox($label, 'legend'); | |
1370 | push(@sizes, \@text_box); | |
1371 | my $entry_width = $patchsize + $gap + $text_box[2]; | |
1372 | if ($pos == 0) { | |
1373 | # never re-wrap the first entry | |
1374 | push @offsets, [ 0, $height ]; | |
1375 | } | |
1376 | else { | |
1377 | if ($pos + $gap + $entry_width > $chart_box->[2]) { | |
1378 | $pos = 0; | |
1379 | $height += $row_height; | |
1380 | } | |
1381 | push @offsets, [ $pos, $height ]; | |
1382 | } | |
1383 | my $entry_right = $pos + $entry_width; | |
1384 | $pos += $gap + $entry_width; | |
1385 | $entry_right > $width and $width = $entry_right; | |
1386 | if ($text_box[3] > $row_height) { | |
1387 | $row_height = $text_box[3]; | |
1388 | } | |
1389 | } | |
1390 | $height += $row_height; | |
1391 | my @box = ( 0, 0, $width + $padding * 2, $height + $padding * 2 ); | |
1392 | my $outsidepadding = 0; | |
1393 | if ($self->{_style}{legend}{border}) { | |
1394 | defined($outsidepadding = $self->_get_integer('legend.outsidepadding')) | |
1395 | or return; | |
1396 | $box[2] += 2 * $outsidepadding; | |
1397 | $box[3] += 2 * $outsidepadding; | |
1398 | } | |
1399 | $self->_align_box(\@box, $chart_box, 'legend') | |
1400 | or return; | |
1401 | if ($self->{_style}{legend}{fill}) { | |
1402 | $img->box(xmin=>$box[0]+$outsidepadding, | |
1403 | ymin=>$box[1]+$outsidepadding, | |
1404 | xmax=>$box[2]-$outsidepadding, | |
1405 | ymax=>$box[3]-$outsidepadding, | |
1406 | $self->_get_fill('legend.fill', \@box)); | |
1407 | } | |
1408 | $box[0] += $outsidepadding; | |
1409 | $box[1] += $outsidepadding; | |
1410 | $box[2] -= $outsidepadding; | |
1411 | $box[3] -= $outsidepadding; | |
1412 | my %text_info = $self->_text_style('legend') | |
1413 | or return; | |
1414 | my $patchborder; | |
1415 | if ($self->{_style}{legend}{patchborder}) { | |
1416 | $patchborder = $self->_get_color('legend.patchborder') | |
1417 | or return; | |
1418 | } | |
1419 | ||
1420 | my $dataindex = 0; | |
1421 | for my $label (@$labels) { | |
1422 | my ($left, $top) = @{$offsets[$dataindex]}; | |
1423 | $left += $box[0] + $padding; | |
1424 | $top += $box[1] + $padding; | |
1425 | my $textpos = $left + $patchsize + $gap; | |
1426 | my @patchbox = ( $left, $top, | |
1427 | $left + $patchsize, $top + $patchsize ); | |
1428 | my @fill = $self->_data_fill($dataindex, \@patchbox) | |
1429 | or return; | |
1430 | $img->box(xmin=>$left, ymin=>$top, xmax=>$left + $patchsize, | |
1431 | ymax=>$top + $patchsize, @fill); | |
1432 | if ($self->{_style}{legend}{patchborder}) { | |
1433 | $img->box(xmin=>$left, ymin=>$top, xmax=>$left + $patchsize, | |
1434 | ymax=>$top + $patchsize, | |
1435 | color=>$patchborder); | |
1436 | } | |
1437 | $img->string(%text_info, x=>$textpos, 'y'=>$top + $patchsize, | |
1438 | text=>$label); | |
1439 | ||
1440 | ++$dataindex; | |
1441 | } | |
1442 | if ($self->{_style}{legend}{border}) { | |
1443 | my $border_color = $self->_get_color('legend.border') | |
1444 | or return; | |
1445 | $img->box(xmin=>$box[0], ymin=>$box[1], xmax=>$box[2], ymax=>$box[3], | |
1446 | color=>$border_color); | |
1447 | } | |
1448 | $self->_remove_box($chart_box, \@box); | |
1449 | 1; | |
1450 | } | |
1451 | ||
1452 | sub _draw_legend_vertical { | |
1453 | my ($self, $img, $labels, $chart_box) = @_; | |
1454 | ||
379c5b02 | 1455 | defined(my $padding = $self->_get_integer('legend.padding')) |
35574351 | 1456 | or return; |
379c5b02 | 1457 | my $patchsize = $self->_get_integer('legend.patchsize') |
35574351 | 1458 | or return; |
379c5b02 | 1459 | defined(my $gap = $self->_get_integer('legend.patchgap')) |
35574351 TC |
1460 | or return; |
1461 | my $minrowsize = $patchsize + $gap; | |
1462 | my ($width, $height) = (0,0); | |
1463 | my @sizes; | |
1464 | for my $label (@$labels) { | |
1465 | my @box = $self->_text_bbox($label, 'legend'); | |
1466 | push(@sizes, \@box); | |
1467 | $width = $box[2] if $box[2] > $width; | |
1468 | if ($minrowsize > $box[3]) { | |
1469 | $height += $minrowsize; | |
1470 | } | |
1471 | else { | |
1472 | $height += $box[3]; | |
1473 | } | |
1474 | } | |
1475 | my @box = (0, 0, | |
1476 | $width + $patchsize + $padding * 2 + $gap, | |
1477 | $height + $padding * 2 - $gap); | |
1478 | my $outsidepadding = 0; | |
1479 | if ($self->{_style}{legend}{border}) { | |
33a928b7 | 1480 | defined($outsidepadding = $self->_get_integer('legend.outsidepadding')) |
35574351 TC |
1481 | or return; |
1482 | $box[2] += 2 * $outsidepadding; | |
1483 | $box[3] += 2 * $outsidepadding; | |
1484 | } | |
1485 | $self->_align_box(\@box, $chart_box, 'legend') | |
1486 | or return; | |
1487 | if ($self->{_style}{legend}{fill}) { | |
1488 | $img->box(xmin=>$box[0]+$outsidepadding, | |
1489 | ymin=>$box[1]+$outsidepadding, | |
1490 | xmax=>$box[2]-$outsidepadding, | |
1491 | ymax=>$box[3]-$outsidepadding, | |
1492 | $self->_get_fill('legend.fill', \@box)); | |
1493 | } | |
1494 | $box[0] += $outsidepadding; | |
1495 | $box[1] += $outsidepadding; | |
1496 | $box[2] -= $outsidepadding; | |
1497 | $box[3] -= $outsidepadding; | |
1498 | my $ypos = $box[1] + $padding; | |
1499 | my $patchpos = $box[0]+$padding; | |
1500 | my $textpos = $patchpos + $patchsize + $gap; | |
1501 | my %text_info = $self->_text_style('legend') | |
1502 | or return; | |
1503 | my $patchborder; | |
1504 | if ($self->{_style}{legend}{patchborder}) { | |
1505 | $patchborder = $self->_get_color('legend.patchborder') | |
1506 | or return; | |
1507 | } | |
1508 | my $dataindex = 0; | |
1509 | for my $label (@$labels) { | |
1510 | my @patchbox = ( $patchpos - $patchsize/2, $ypos - $patchsize/2, | |
1511 | $patchpos + $patchsize * 3 / 2, $ypos + $patchsize*3/2 ); | |
1512 | my @fill = $self->_data_fill($dataindex, \@patchbox) | |
1513 | or return; | |
1514 | $img->box(xmin=>$patchpos, ymin=>$ypos, xmax=>$patchpos + $patchsize, | |
1515 | ymax=>$ypos + $patchsize, @fill); | |
1516 | if ($self->{_style}{legend}{patchborder}) { | |
1517 | $img->box(xmin=>$patchpos, ymin=>$ypos, xmax=>$patchpos + $patchsize, | |
1518 | ymax=>$ypos + $patchsize, | |
1519 | color=>$patchborder); | |
1520 | } | |
1521 | $img->string(%text_info, x=>$textpos, 'y'=>$ypos + $patchsize, | |
1522 | text=>$label); | |
1523 | ||
1524 | my $step = $patchsize + $gap; | |
1525 | if ($minrowsize < $sizes[$dataindex][3]) { | |
1526 | $ypos += $sizes[$dataindex][3]; | |
1527 | } | |
1528 | else { | |
1529 | $ypos += $minrowsize; | |
1530 | } | |
1531 | ++$dataindex; | |
1532 | } | |
1533 | if ($self->{_style}{legend}{border}) { | |
1534 | my $border_color = $self->_get_color('legend.border') | |
1535 | or return; | |
1536 | $img->box(xmin=>$box[0], ymin=>$box[1], xmax=>$box[2], ymax=>$box[3], | |
1537 | color=>$border_color); | |
1538 | } | |
1539 | $self->_remove_box($chart_box, \@box); | |
1540 | 1; | |
1541 | } | |
1542 | ||
1543 | sub _draw_title { | |
1544 | my ($self, $img, $chart_box) = @_; | |
1545 | ||
1546 | my $title = $self->{_style}{title}{text}; | |
1547 | my @box = $self->_text_bbox($title, 'title'); | |
1548 | my $yoff = $box[1]; | |
1549 | @box[0,1] = (0,0); | |
1550 | $self->_align_box(\@box, $chart_box, 'title'); | |
1551 | my %text_info = $self->_text_style('title'); | |
1552 | $img->string(%text_info, x=>$box[0], 'y'=>$box[3] + $yoff, text=>$title); | |
1553 | $self->_remove_box($chart_box, \@box); | |
1554 | 1; | |
1555 | } | |
1556 | ||
1557 | sub _small_extent { | |
1558 | my ($self, $box) = @_; | |
1559 | ||
1560 | if ($box->[2] - $box->[0] > $box->[3] - $box->[1]) { | |
1561 | return $box->[3] - $box->[1]; | |
1562 | } | |
1563 | else { | |
1564 | return $box->[2] - $box->[0]; | |
1565 | } | |
1566 | } | |
1567 | ||
1568 | =item _composite() | |
1569 | ||
1570 | Returns a list of style fields that are stored as composites, and | |
1571 | should be merged instead of just being replaced. | |
1572 | ||
1573 | =cut | |
1574 | ||
1575 | sub _composite { | |
1576 | qw(title legend text label dropshadow outline callout); | |
1577 | } | |
1578 | ||
1579 | sub _filter_region { | |
1580 | my ($self, $img, $left, $top, $right, $bottom, $filter) = @_; | |
1581 | ||
1582 | unless (ref $filter) { | |
1583 | my $name = $filter; | |
1584 | $filter = $self->_get_thing($name) | |
1585 | or return; | |
1586 | $filter->{type} | |
1587 | or return $self->_error("no type for filter $name"); | |
1588 | } | |
1589 | ||
1590 | $left > 0 or $left = 0; | |
1591 | $top > 0 or $top = 0; | |
1592 | ||
1593 | # newer versions of Imager let you work on just part of an image | |
1594 | if ($img->can('masked') && !$self->{_style}{features}{_debugblur}) { | |
1595 | my $masked = $img->masked(left=>$left, top=>$top, | |
1596 | right=>$right, bottom=>$bottom); | |
1597 | $masked->filter(%$filter); | |
1598 | } | |
1599 | else { | |
1600 | # for older versions of Imager | |
1601 | my $subset = $img->crop(left=>$left, top=>$top, | |
1602 | right=>$right, bottom=>$bottom); | |
1603 | $subset->filter(%$filter); | |
1604 | $img->paste(left=>$left, top=>$top, img=>$subset); | |
1605 | } | |
1606 | } | |
1607 | ||
1608 | 1; | |
1609 | __END__ | |
1610 | ||
1611 | =back | |
1612 | ||
1613 | =head1 SEE ALSO | |
1614 | ||
1615 | Imager::Graph::Pie(3), Imager(3), perl(1). | |
1616 | ||
1617 | =head1 AUTHOR | |
1618 | ||
1619 | Tony Cook <tony@develop-help.com> | |
1620 | ||
54ada35d TC |
1621 | =head1 LICENSE |
1622 | ||
1623 | Imager::Graph is licensed under the same terms as perl itself. | |
1624 | ||
35574351 TC |
1625 | =head1 BLAME |
1626 | ||
1627 | Addi for producing a cool imaging module. :) | |
1628 | ||
1629 | =cut |