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