- round the dimensions used within the legend to integers to prevent
[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 =back
384
385 =item callout
386
387 defines attributes for graph callouts, if any are present.  eg. if the
388 pie graph cannot fit the label into the pie graph segement it will
389 present it as a callout.
390
391 =over
392
393 =item color
394
395 =item font
396
397 =item size
398
399 the text attributes of the callout label.  Inherited from I<text>.
400
401 =item line
402
403 the color of the callout lines.  Inherited from I<line>
404
405 =item inside
406
407 =item outside
408
409 the length of the leader on the inside and the outside of the fill,
410 usually at some angle.  Both default to the size of the callout text.
411
412 =item leadlen
413
414 the length of the horizontal portion of the leader.  Default:
415 I<callout.size>.
416
417 =item gap
418
419 the gap between the callout leader and the callout text.  Defaults to
420 30% of the text callout size.
421
422 =back
423
424 =item label
425
426 defines attributes for labels drawn into the data areas of a graph.
427
428 =over
429
430 =item color
431
432 =item font
433
434 =item size
435
436 The text attributes of the labels.  Inherited from I<text>.
437
438 =back
439
440 =item dropshadow
441
442 the attributes of the graph's drop shadow
443
444 =over
445
446 =item fill
447
448 the fill used for the drop shadow.  Default: '404040' (dark gray)
449
450 =item off
451
452 the offset of the drop shadow.  A convenience value inherited by offx
453 and offy.  Default: 40% of I<text.size>.
454
455 =item offx
456
457 =item offy
458
459 the horizontal and vertical offsets of the drop shadow.  Both
460 inherited from I<dropshadow.off>.
461
462 =item filter
463
464 the filter description passed to Imager's filter method to blur the
465 drop shadow.  Default: an 11 element convolution filter.
466
467 =back
468
469 =item outline
470
471 describes the lines drawn around filled data areas, such as the
472 segments of a pie chart.
473
474 =over
475
476 =item line
477
478 the line color of the outlines, inherited from I<line>.
479
480 =back
481
482 =item fills
483
484 a reference to an array containing fills for each data item.
485
486 You can mix fill types, ie. using a simple color for the first item, a
487 hatched fill for the second and a fountain fill for the next.
488
489 =back
490
491 =head1 HOW VALUES WORK
492
493 Internally rather than specifying literal color, fill, or font objects
494 or literal sizes for each element, Imager::Graph uses a number of
495 special values to inherit or modify values taken from other graph
496 element names.
497
498 =head2 Specifying colors
499
500 You can specify colors by either supplying an Imager::Color object, by
501 supplying lookup of another color, or by supplying a single value that
502 Imager::Color::new can use as an initializer.  The most obvious is
503 just a 6 or 8 digit hex value representing the red, green, blue and
504 optionally alpha channels of the image.
505
506 You can lookup another color by using the lookup() "function", for
507 example if you give a color as "lookup(fg)" then Imager::Graph will
508 look for the fg element in the current style (or as overridden by
509 you.)  This is used internally by Imager::Graph to set up the
510 relationships between the colors of various elements, for example the
511 default style information contains:
512
513    text=>{
514           color=>'lookup(fg)',
515           ...
516          },
517    legend =>{
518              color=>'lookup(text.color)',
519              ...
520             },
521
522 So by setting the I<fg> color, you also set the default text color,
523 since each text element uses lookup(text.color) as its value.
524
525 =head2 Specifying fills
526
527 Fills can be used for the graph background color, the background color
528 for the legend block and for the fills used for each data element.
529
530 You can specify a fill as a L<color value|Specifying colors> or as a
531 general fill, see L<Imager::Fill> for details.  To use a general fill
532 you need a version of Imager after 0.38.
533
534 You don't need (or usually want) to call Imager::Fill::new yourself,
535 since the various fill functions will call it for you, and
536 Imager::Graph provides some hooks to make them more useful.
537
538 =over
539
540 =item *
541
542 with hatched fills, if you don't supply a 'fg' or 'bg' parameter,
543 Imager::Graph will supply the current graph fg and bg colors.
544
545 =item *
546
547 with fountain fill, you can supply the xa_ratio, ya_ratio, xb_ratio
548 and yb_ratio parameters, and they will be scaled in the fill area to
549 define the fountain fills xa, ya, xb and yb parameters.
550
551 =back
552
553 As with colors, you can use lookup(name) or lookup(name1.name2) to
554 have one element to inherit the fill of another.
555
556 =head2 Specifying numbers
557
558 You can specify various numbers, usually representing the size of
559 something, commonly text, but sometimes the length of a line or the
560 size of a gap.
561
562 You can use the same lookup mechanism as with colors and fills, but
563 you can also scale values.  For example, 'scale(0.5,text.size)' will
564 return half the size of the normal text size.
565
566 As with colors, this is used internally to scale graph elements based
567 on the base text size.  If you change the base text size then other
568 graph elements will scale as well.
569
570 =head2 Specifying other elements
571
572 Other elements, such as fonts, or parameters for a filter, can also
573 use the lookup(name) mechanism.
574
575 =head1 INTERNAL METHODS
576
577 Only useful if you need to fix bugs, add features or create a new
578 graph class.
579
580 =over
581
582 =cut
583
584 my %style_defs =
585   (
586    back=> 'lookup(bg)',
587    line=> 'lookup(fg)',
588    text=>{
589           color => 'lookup(fg)',
590           font  => 'lookup(font)',
591           size  => 14,
592          },
593    title=>{ 
594            color  => 'lookup(text.color)', 
595            font   => 'lookup(text.font)',
596            halign => 'center', 
597            valign => 'top',
598            size   => 'scale(text.size,2.0)',
599           },
600    legend =>{
601              color          => 'lookup(text.color)',
602              font           => 'lookup(text.font)',
603              size           => 'lookup(text.size)',
604              patchsize      => 'scale(legend.size,0.9)',
605              patchgap       => 'scale(legend.patchsize,0.3)',
606              patchborder    => 'lookup(line)',
607              halign         => 'right',
608              valign         => 'top',
609              padding        => 'scale(legend.size,0.3)',
610              outsidepadding => 'scale(legend.padding,0.4)',
611             },
612    callout => {
613                color    => 'lookup(text.color)',
614                font     => 'lookup(text.font)',
615                size     => 'lookup(text.size)',
616                line     => 'lookup(line)',
617                inside   => 'lookup(callout.size)',
618                outside  => 'lookup(callout.size)',
619                leadlen  => 'scale(0.8,callout.size)',
620                gap      => 'scale(callout.size,0.3)',
621               },
622    label => {
623              font          => 'lookup(text.font)',
624              size          => 'lookup(text.size)',
625              color         => 'lookup(text.color)',
626              hpad          => 'lookup(label.pad)',
627              vpad          => 'lookup(label.pad)',
628              pad           => 'scale(label.size,0.2)',
629              pcformat      => sub { sprintf "%s (%.0f%%)", $_[0], $_[1] },
630              pconlyformat  => sub { sprintf "%.1f%%", $_[0] },
631              },
632    dropshadow => {
633                   fill    => '404040',
634                   off     => 'scale(0.4,text.size)',
635                   offx    => 'lookup(dropshadow.off)',
636                   offy    => 'lookup(dropshadow.off)',
637                   filter  => { type=>'conv', 
638                               # this needs a fairly heavy blur
639                               coef=>[0.1, 0.2, 0.4, 0.6, 0.7, 0.9, 1.2, 
640                                      0.9, 0.7, 0.6, 0.4, 0.2, 0.1 ] },
641                  },
642    outline => {
643                line =>'lookup(line)',
644               },
645    size=>256,
646    width=>'scale(1.5,size)',
647    height=>'lookup(size)',
648   );
649
650 =item _error($message)
651
652 Sets the error field of the object and returns an empty list or undef,
653 depending on context.  Should be used for error handling, since it may
654 provide some user hooks at some point.
655
656 =cut
657
658 sub _error {
659   my ($self, $error) = @_;
660
661   $self->{_errstr} = $error;
662
663   return;
664 }
665
666
667 =item _style_defs()
668
669 Returns the style defaults, such as the relationships between line
670 color and text color.
671
672 Intended to be over-ridden by base classes to provide graph specific
673 defaults.
674
675 =cut
676
677 sub _style_defs {
678   \%style_defs;
679 }
680
681 my $def_style = 'primary_red';
682
683 my %styles =
684   (
685    primary_red =>
686    {
687     fills=>
688     [
689      qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF)
690     ],
691     fg=>'000000',
692     bg=>'C08080',
693     legend=>
694     {
695      patchborder=>'000000'
696     },
697    },
698    mono =>
699    {
700     fills=>
701     [
702      { hatch=>'slash2' },
703      { hatch=>'slosh2' },
704      { hatch=>'vline2' },
705      { hatch=>'hline2' },
706      { hatch=>'cross2' },
707      { hatch=>'grid2' },
708      { hatch=>'stipple3' },
709      { hatch=>'stipple2' },
710     ],
711     channels=>1,
712     bg=>'FFFFFF',
713     fg=>'000000',
714     features=>{ outline=>1 },
715     pie =>{
716            blur=>undef,
717           },
718    },
719    fount_lin =>
720    {
721     fills=>
722     [
723      { fountain=>'linear',
724        xa_ratio=>0.13, ya_ratio=>0.13, xb_ratio=>0.87, yb_ratio=>0.87,
725        repeat=>'sawtooth',
726        segments => Imager::Fountain->simple(positions=>[0, 1],
727                                             colors=>[ NC('FFC0C0'), NC('FF0000') ]),
728      },
729      { fountain=>'linear',
730        xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
731        segments => Imager::Fountain->simple(positions=>[0, 1],
732                                             colors=>[ NC('C0FFC0'), NC('00FF00') ]),
733      },
734      { fountain=>'linear',
735        xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
736        segments => Imager::Fountain->simple(positions=>[0, 1],
737                                             colors=>[ NC('C0C0FF'), NC('0000FF') ]),
738      },
739      { fountain=>'linear',
740        xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
741        segments => Imager::Fountain->simple(positions=>[0, 1],
742                                             colors=>[ NC('FFFFC0'), NC('FFFF00') ]),
743      },
744      { fountain=>'linear',
745        xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
746        segments => Imager::Fountain->simple(positions=>[0, 1],
747                                             colors=>[ NC('C0FFFF'), NC('00FFFF') ]),
748      },
749      { fountain=>'linear',
750        xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
751        segments => Imager::Fountain->simple(positions=>[0, 1],
752                                             colors=>[ NC('FFC0FF'), NC('FF00FF') ]),
753      },
754     ],
755     back=>{ fountain=>'linear',
756             xa_ratio=>0, ya_ratio=>0,
757             xb_ratio=>1.0, yb_ratio=>1.0,
758             segments=>Imager::Fountain->simple
759             ( positions=>[0, 1],
760               colors=>[ NC('6060FF'), NC('60FF60') ]) },
761     fg=>'000000',
762     bg=>'FFFFFF',
763     features=>{ dropshadow=>1 },
764    },
765    fount_rad =>
766    {
767     fills=>
768     [
769      { fountain=>'radial',
770        xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
771        segments => Imager::Fountain->simple(positions=>[0, 1],
772                                             colors=>[ NC('FF8080'), NC('FF0000') ]),
773      },
774      { fountain=>'radial',
775        xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
776        segments => Imager::Fountain->simple(positions=>[0, 1],
777                                             colors=>[ NC('80FF80'), NC('00FF00') ]),
778      },
779      { fountain=>'radial',
780        xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
781        segments => Imager::Fountain->simple(positions=>[0, 1],
782                                             colors=>[ NC('808080FF'), NC('0000FF') ]),
783      },
784      { fountain=>'radial',
785        xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
786        segments => Imager::Fountain->simple(positions=>[0, 1],
787                                             colors=>[ NC('FFFF80'), NC('FFFF00') ]),
788      },
789      { fountain=>'radial',
790        xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
791        segments => Imager::Fountain->simple(positions=>[0, 1],
792                                             colors=>[ NC('80FFFF'), NC('00FFFF') ]),
793      },
794      { fountain=>'radial',
795        xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
796        segments => Imager::Fountain->simple(positions=>[0, 1],
797                                             colors=>[ NC('FF80FF'), NC('FF00FF') ]),
798      },
799     ],
800     back=>{ fountain=>'linear',
801             xa_ratio=>0, ya_ratio=>0,
802             xb_ratio=>1.0, yb_ratio=>1.0,
803             segments=>Imager::Fountain->simple
804             ( positions=>[0, 1],
805               colors=>[ NC('6060FF'), NC('60FF60') ]) },
806     fg=>'000000',
807     bg=>'FFFFFF',
808    }
809   );
810
811 =item $self->_style_setup(\%opts)
812
813 Uses the values from %opts to build a customized hash describing the
814 way the graph should be drawn.
815
816 =cut
817
818 sub _style_setup {
819   my ($self, $opts) = @_;
820   my $style_defs = $self->_style_defs;
821   my $style;
822   $style = $styles{$opts->{style}} if $opts->{style};
823   $style ||= $styles{$def_style};
824
825   my @search_list = ( $style_defs, $style, $opts);
826   my %work;
827
828   my @composite = $self->_composite();
829   my %composite;
830   @composite{@composite} = @composite;
831
832   for my $src (@search_list) {
833     for my $key (keys %$src) {
834       if ($composite{$key}) {
835         $work{$key} = {} unless exists $work{$key};
836         if (ref $src->{$key}) {
837           # some keys have sub values, especially text
838           @{$work{$key}}{keys %{$src->{$key}}} = values %{$src->{$key}};
839         }
840         else {
841           # assume it's the text for a title or something
842           $work{$key}{text} = $src->{$key};
843         }
844       }
845       else {
846         $work{$key} = $src->{$key};
847       }
848     }
849   }
850
851   # features are handled specially
852   $work{features} = {};
853   for my $src (@search_list) {
854     if ($src->{features}) {
855       if (ref $src->{features}) {
856         if (ref($src->{features}) =~ /ARRAY/) {
857           # just set those features
858           for my $feature (@{$src->{features}}) {
859             $work{features}{$feature} = 1;
860           }
861         }
862         elsif (ref($src->{features}) =~ /HASH/) {
863           if ($src->{features}{reset}) {
864             $work{features} = {}; # only the ones the user specifies
865           }
866           @{$work{features}}{keys %{$src->{features}}} =
867             values(%{$src->{features}});
868         }
869       }
870       else {
871         # just set that single feature
872         $work{features}{$src->{features}} = 1;
873       }
874     }
875   }
876   #use Data::Dumper;
877   #print Dumper(\%work);
878
879   $self->{_style} = \%work;
880 }
881
882 =item $self->_get_thing($name)
883
884 Retrieve some general 'thing'.
885
886 Supports the 'lookup(foo)' mechanism.
887
888 =cut
889
890 sub _get_thing {
891   my ($self, $name, @depth) = @_;
892
893   push(@depth, $name);
894   my $what;
895   if ($name =~ /^(\w+)\.(\w+)$/) {
896     $what = $self->{_style}{$1}{$2};
897   }
898   else {
899     $what = $self->{_style}{$name};
900   }
901   defined $what or
902     return;
903   if (ref $what) {
904     return $what;
905   }
906   elsif ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) {
907     @depth < MAX_DEPTH
908       or return $self->_error("too many levels of recursion in lookup(@depth)");
909     return $self->_get_thing($1, @depth);
910   }
911   else {
912     return $what;
913   }
914 }
915
916 =item $self->_get_number($name)
917
918 Retrieves a number from the style.  The value in the style can be the
919 number, or one of two functions:
920
921 =over
922
923 =item lookup(newname)
924
925 Recursively looks up I<newname> in the style.
926
927 =item scale(value1,value2)
928
929 Each value can be a number or a name.  Names are recursively looks up
930 in the style and the product is returned.
931
932 =back
933
934 =cut
935
936 sub _get_number {
937   my ($self, $name, @depth) = @_;
938
939   push(@depth, $name);
940   my $what;
941   if ($name =~ /^(\w+)\.(\w+)$/) {
942     $what = $self->{_style}{$1}{$2};
943   }
944   else {
945     $what = $self->{_style}{$name};
946   }
947   defined $what or
948     return $self->_error("$name is undef (@depth)");
949
950   if (ref $what) {
951     if ($what =~ /CODE/) {
952       $what = $what->($self, $name);
953     }
954   }
955   else {
956     if ($what =~ /^lookup\(([\w.]+)\)$/) {
957       @depth < MAX_DEPTH
958         or return $self->_error("too many levels of recursion in lookup (@depth)");
959       return $self->_get_number($1, @depth);
960     }
961     elsif ($what =~ /^scale\(
962                     ((?:[a-z][\w.]*)|$NUM_RE)
963                     ,
964                     ((?:[a-z][\w.]*)|$NUM_RE)\)$/x) {
965       my ($left, $right) = ($1, $2);
966       unless ($left =~ /^$NUM_RE$/) {
967         @depth < MAX_DEPTH 
968           or return $self->_error("too many levels of recursion in scale (@depth)");
969         $left = $self->_get_number($left, @depth);
970       }
971       unless ($right =~ /^$NUM_RE$/) {
972         @depth < MAX_DEPTH 
973           or return $self->_error("too many levels of recursion in scale (@depth)");
974         $right = $self->_get_number($right, @depth);
975       }
976       return $left * $right;
977     }
978     else {
979       return $what+0;
980     }
981   }
982 }
983
984 =item $self->_get_integer($name)
985
986 Retrieves an integer from the style.  This is a simple wrapper around
987 _get_number() that rounds the result to an integer.
988
989 =cut
990
991 sub _get_integer {
992   my ($self, $name, @depth) = @_;
993
994   my $number = $self->_get_number($name, @depth)
995     or return;
996
997   return sprintf("%.0f", $number);
998 }
999
1000 =item _get_color($name)
1001
1002 Returns a color object of the given name from the style hash.
1003
1004 Uses Imager::Color->new to translate normal scalars into color objects.
1005
1006 Allows the lookup(name) mechanism.
1007
1008 =cut
1009
1010 sub _get_color {
1011   my ($self, $name, @depth) = @_;
1012
1013   push(@depth, $name);
1014   my $what;
1015   if ($name =~ /^(\w+)\.(\w+)$/) {
1016     $what = $self->{_style}{$1}{$2};
1017   }
1018   else {
1019     $what = $self->{_style}{$name};
1020   }
1021
1022   defined($what)
1023     or return $self->_error("$name was undefined (@depth)");
1024
1025   unless (ref $what) {
1026     if ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) {
1027       @depth < MAX_DEPTH or
1028         return $self->_error("too many levels of recursion in lookup (@depth)");
1029
1030       return $self->_get_color($1, @depth);
1031     }
1032     $what = Imager::Color->new($what);
1033   }
1034
1035   $what;
1036 }
1037
1038 =item _translate_fill($what, $box)
1039
1040 Given the value of a fill, either attempts to convert it into a fill
1041 list (one of C<<color=>$color_value, filled=>1>> or C<<fill=>{ fill
1042 parameters }>>), or to lookup another fill that is referred to with
1043 the 'lookup(name)' mechanism.
1044
1045 This function does the fg and bg initialization for hatched fills, and
1046 translation of *_ratio for fountain fills (using the $box parameter).
1047
1048 =cut
1049
1050 sub _translate_fill {
1051   my ($self, $what, $box, @depth) = @_;
1052
1053   if (ref $what) {
1054     if (UNIVERSAL::isa($what, "Imager::Color")) {
1055       return ( color=>Imager::Color->new($what), filled=>1 );
1056     }
1057     else {
1058       # a general fill
1059       if ($what->{hatch}) {
1060         my %work = %$what;
1061         if (!$work{fg}) {
1062           $work{fg} = $self->_get_color('fg')
1063             or return;
1064         }
1065         if (!$work{bg}) {
1066           $work{bg} = $self->_get_color('bg')
1067             or return;
1068         }
1069         return ( fill=>\%work );
1070       }
1071       elsif ($what->{fountain}) {
1072         my %work = %$what;
1073         for my $key (qw(xa ya xb yb)) {
1074           if (exists $work{"${key}_ratio"}) {
1075             if ($key =~ /^x/) {
1076               $work{$key} = $box->[0] + $work{"${key}_ratio"} 
1077                 * ($box->[2] - $box->[0]);
1078             }
1079             else {
1080               $work{$key} = $box->[1] + $work{"${key}_ratio"} 
1081                 * ($box->[3] - $box->[1]);
1082             }
1083           }
1084         }
1085         return ( fill=>\%work );
1086       }
1087       else {
1088         return ( fill=> $what );
1089       }
1090     }
1091   }
1092   else {
1093     if ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) {
1094       return $self->_get_fill($1, $box, @depth);
1095     }
1096     else {
1097       # assumed to be an Imager::Color single value
1098       return ( color=>Imager::Color->new($what), filled=>1 );
1099     }
1100   }
1101 }
1102
1103 =item _data_fill($index, $box)
1104
1105 Retrieves the fill parameters for a data area fill.
1106
1107 =cut
1108
1109 sub _data_fill {
1110   my ($self, $index, $box) = @_;
1111
1112   my $fills = $self->{_style}{fills};
1113   return $self->_translate_fill($fills->[$index % @$fills], $box,
1114                                 "data.$index");
1115 }
1116
1117 =item _get_fill($index, $box)
1118
1119 Retrieves fill parameters for a named fill.
1120
1121 =cut
1122
1123 sub _get_fill {
1124   my ($self, $name, $box, @depth) = @_;
1125
1126   push(@depth, $name);
1127   my $what;
1128   if ($name =~ /^(\w+)\.(\w+)$/) {
1129     $what = $self->{_style}{$1}{$2};
1130   }
1131   else {
1132     $what = $self->{_style}{$name};
1133   }
1134
1135   defined($what)
1136     or return $self->_error("no fill $name found");
1137
1138   return $self->_translate_fill($what, $box, @depth);
1139 }
1140
1141 =item _make_img()
1142
1143 Builds the image object for the graph and fills it with the background
1144 fill.
1145
1146 =cut
1147
1148 sub _make_img {
1149   my ($self) = @_;
1150   
1151   my ($width, $height) = (256, 256);
1152
1153   $width = $self->_get_number('width');
1154   $height = $self->_get_number('height');
1155   my $channels = $self->{_style}{channels};
1156
1157   $channels ||= 3;
1158
1159   my $img = Imager->new(xsize=>$width, ysize=>$height, channels=>$channels);
1160
1161   $img->box($self->_get_fill('back', [ 0, 0, $width-1, $height-1]));
1162
1163   $img;
1164 }
1165
1166 sub _text_style {
1167   my ($self, $name) = @_;
1168
1169   my %work;
1170
1171   if ($self->{_style}{$name}) {
1172     %work = %{$self->{_style}{$name}};
1173   }
1174   else {
1175     %work = %{$self->{_style}{text}};
1176   }
1177   $work{font}
1178       or return $self->_error("$name has no font parameter");
1179
1180   $work{font} = $self->_get_thing("$name.font")
1181     or return $self->_error("invalid font");
1182   UNIVERSAL::isa($work{font}, "Imager::Font")
1183       or return $self->_error("$name.font is not a font");
1184   if ($work{color} && !ref $work{color}) {
1185     $work{color} = $self->_get_color("$name.color")
1186       or return;
1187   }
1188   $work{size} = $self->_get_number("$name.size");
1189   $work{sizew} = $self->_get_number("$name.sizew")
1190     if $work{sizew};
1191
1192   %work;
1193 }
1194
1195 sub _text_bbox {
1196   my ($self, $text, $name) = @_;
1197
1198   my %text_info = $self->_text_style($name);
1199
1200   my @bbox = $text_info{font}->bounding_box(%text_info, string=>$text,
1201                                             canon=>1);
1202
1203   return @bbox[0..3];
1204 }
1205
1206 sub _align_box {
1207   my ($self, $box, $chart_box, $name) = @_;
1208
1209   my $halign = $self->{_style}{$name}{halign}
1210     or $self->_error("no halign for $name");
1211   my $valign = $self->{_style}{$name}{valign};
1212
1213   if ($halign eq 'right') {
1214     $box->[0] += $chart_box->[2] - $box->[2];
1215   }
1216   elsif ($halign eq 'left') {
1217     $box->[0] = $chart_box->[0];
1218   }
1219   elsif ($halign eq 'center' || $halign eq 'centre') {
1220     $box->[0] = ($chart_box->[0] + $chart_box->[2] - $box->[2])/2;
1221   }
1222   else {
1223     return $self->_error("invalid halign $halign for $name");
1224   }
1225
1226   if ($valign eq 'top') {
1227     $box->[1] = $chart_box->[1];
1228   }
1229   elsif ($valign eq 'bottom') {
1230     $box->[1] = $chart_box->[3] - $box->[3];
1231   }
1232   elsif ($valign eq 'center' || $valign eq 'centre') {
1233     $box->[1] = ($chart_box->[1] + $chart_box->[3] - $box->[3])/2;
1234   }
1235   else {
1236     return $self->_error("invalid valign $valign for $name");
1237   }
1238   $box->[2] += $box->[0];
1239   $box->[3] += $box->[1];
1240 }
1241
1242 sub _remove_box {
1243   my ($self, $chart_box, $object_box) = @_;
1244
1245   my $areax;
1246   my $areay;
1247   if ($object_box->[0] - $chart_box->[0] 
1248       < $chart_box->[2] - $object_box->[2]) {
1249     $areax = ($object_box->[2] - $chart_box->[0]) 
1250       * ($chart_box->[3] - $chart_box->[1]);
1251   }
1252   else {
1253     $areax = ($chart_box->[2] - $object_box->[0]) 
1254       * ($chart_box->[3] - $chart_box->[1]);
1255   }
1256
1257   if ($object_box->[1] - $chart_box->[1] 
1258       < $chart_box->[3] - $object_box->[3]) {
1259     $areay = ($object_box->[3] - $chart_box->[1]) 
1260       * ($chart_box->[2] - $chart_box->[0]);
1261   }
1262   else {
1263     $areay = ($chart_box->[3] - $object_box->[1]) 
1264       * ($chart_box->[2] - $chart_box->[0]);
1265   }
1266
1267   if ($areay < $areax) {
1268     if ($object_box->[1] - $chart_box->[1] 
1269         < $chart_box->[3] - $object_box->[3]) {
1270       $chart_box->[1] = $object_box->[3];
1271     }
1272     else {
1273       $chart_box->[3] = $object_box->[1];
1274     }
1275   }
1276   else {
1277     if ($object_box->[0] - $chart_box->[0] 
1278         < $chart_box->[2] - $object_box->[2]) {
1279       $chart_box->[0] = $object_box->[2];
1280     }
1281     else {
1282       $chart_box->[2] = $object_box->[0];
1283     }
1284   }
1285 }
1286
1287 sub _draw_legend {
1288   my ($self, $img, $labels, $chart_box) = @_;
1289
1290   defined(my $padding = $self->_get_integer('legend.padding'))
1291     or return;
1292   my $patchsize = $self->_get_integer('legend.patchsize')
1293     or return;
1294   defined(my $gap = $self->_get_integer('legend.patchgap'))
1295     or return;
1296   my $minrowsize = $patchsize + $gap;
1297   my ($width, $height) = (0,0);
1298   my @sizes;
1299   for my $label (@$labels) {
1300     my @box = $self->_text_bbox($label, 'legend');
1301     push(@sizes, \@box);
1302     $width = $box[2] if $box[2] > $width;
1303     if ($minrowsize > $box[3]) {
1304       $height += $minrowsize;
1305     }
1306     else {
1307       $height += $box[3];
1308     }
1309   }
1310   my @box = (0, 0, 
1311              $width + $patchsize + $padding * 2 + $gap,
1312              $height + $padding * 2 - $gap);
1313   my $outsidepadding = 0;
1314   if ($self->{_style}{legend}{border}) {
1315     defined($outsidepadding = $self->_get_number('legend.outsidepadding'))
1316       or return;
1317     $box[2] += 2 * $outsidepadding;
1318     $box[3] += 2 * $outsidepadding;
1319   }
1320   $self->_align_box(\@box, $chart_box, 'legend')
1321     or return;
1322   if ($self->{_style}{legend}{fill}) {
1323     $img->box(xmin=>$box[0]+$outsidepadding, 
1324               ymin=>$box[1]+$outsidepadding, 
1325               xmax=>$box[2]-$outsidepadding, 
1326               ymax=>$box[3]-$outsidepadding,
1327              $self->_get_fill('legend.fill', \@box));
1328   }
1329   $box[0] += $outsidepadding;
1330   $box[1] += $outsidepadding;
1331   $box[2] -= $outsidepadding;
1332   $box[3] -= $outsidepadding;
1333   my $ypos = $box[1] + $padding;
1334   my $patchpos = $box[0]+$padding;
1335   my $textpos = $patchpos + $patchsize + $gap;
1336   my %text_info = $self->_text_style('legend')
1337     or return;
1338   my $patchborder;
1339   if ($self->{_style}{legend}{patchborder}) {
1340     $patchborder = $self->_get_color('legend.patchborder')
1341       or return;
1342   }
1343   my $dataindex = 0;
1344   for my $label (@$labels) {
1345     my @patchbox = ( $patchpos - $patchsize/2, $ypos - $patchsize/2,
1346                      $patchpos + $patchsize * 3 / 2, $ypos + $patchsize*3/2 );
1347     my @fill = $self->_data_fill($dataindex, \@patchbox)
1348       or return;
1349     $img->box(xmin=>$patchpos, ymin=>$ypos, xmax=>$patchpos + $patchsize,
1350                ymax=>$ypos + $patchsize, @fill);
1351     if ($self->{_style}{legend}{patchborder}) {
1352       $img->box(xmin=>$patchpos, ymin=>$ypos, xmax=>$patchpos + $patchsize,
1353                 ymax=>$ypos + $patchsize,
1354                 color=>$patchborder);
1355     }
1356     $img->string(%text_info, x=>$textpos, 'y'=>$ypos + $patchsize, 
1357                  text=>$label);
1358
1359     my $step = $patchsize + $gap;
1360     if ($minrowsize < $sizes[$dataindex][3]) {
1361       $ypos += $sizes[$dataindex][3];
1362     }
1363     else {
1364       $ypos += $minrowsize;
1365     }
1366     ++$dataindex;
1367   }
1368   if ($self->{_style}{legend}{border}) {
1369     my $border_color = $self->_get_color('legend.border')
1370       or return;
1371     $img->box(xmin=>$box[0], ymin=>$box[1], xmax=>$box[2], ymax=>$box[3],
1372               color=>$border_color);
1373   }
1374   $self->_remove_box($chart_box, \@box);
1375   1;
1376 }
1377
1378 sub _draw_title {
1379   my ($self, $img, $chart_box) = @_;
1380
1381   my $title = $self->{_style}{title}{text};
1382   my @box = $self->_text_bbox($title, 'title');
1383   my $yoff = $box[1];
1384   @box[0,1] = (0,0);
1385   $self->_align_box(\@box, $chart_box, 'title');
1386   my %text_info = $self->_text_style('title');
1387   $img->string(%text_info, x=>$box[0], 'y'=>$box[3] + $yoff, text=>$title);
1388   $self->_remove_box($chart_box, \@box);
1389   1;
1390 }
1391
1392 sub _small_extent {
1393   my ($self, $box) = @_;
1394
1395   if ($box->[2] - $box->[0] > $box->[3] - $box->[1]) {
1396     return $box->[3] - $box->[1];
1397   }
1398   else {
1399     return $box->[2] - $box->[0];
1400   }
1401 }
1402
1403 =item _composite()
1404
1405 Returns a list of style fields that are stored as composites, and
1406 should be merged instead of just being replaced.
1407
1408 =cut
1409
1410 sub _composite {
1411   qw(title legend text label dropshadow outline callout);
1412 }
1413
1414 sub _filter_region {
1415   my ($self, $img, $left, $top, $right, $bottom, $filter) = @_;
1416
1417   unless (ref $filter) {
1418     my $name = $filter;
1419     $filter = $self->_get_thing($name)
1420       or return;
1421     $filter->{type}
1422       or return $self->_error("no type for filter $name");
1423   }
1424
1425   $left > 0 or $left = 0;
1426   $top > 0 or $top = 0;
1427
1428   # newer versions of Imager let you work on just part of an image
1429   if ($img->can('masked') && !$self->{_style}{features}{_debugblur}) {
1430     my $masked = $img->masked(left=>$left, top=>$top,
1431                               right=>$right, bottom=>$bottom);
1432     $masked->filter(%$filter);
1433   }
1434   else {
1435     # for older versions of Imager
1436     my $subset = $img->crop(left=>$left, top=>$top,
1437                             right=>$right, bottom=>$bottom);
1438     $subset->filter(%$filter);
1439     $img->paste(left=>$left, top=>$top, img=>$subset);
1440   }
1441 }
1442
1443 1;
1444 __END__
1445
1446 =back
1447
1448 =head1 SEE ALSO
1449
1450 Imager::Graph::Pie(3), Imager(3), perl(1).
1451
1452 =head1 AUTHOR
1453
1454 Tony Cook <tony@develop-help.com>
1455
1456 =head1 LICENSE
1457
1458 Imager::Graph is licensed under the same terms as perl itself.
1459
1460 =head1 BLAME
1461
1462 Addi for producing a cool imaging module. :)
1463
1464 =cut