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