remove more ancient Imager cruft
[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 _get_color($name)
985
986 Returns a color object of the given name from the style hash.
987
988 Uses Imager::Color->new to translate normal scalars into color objects.
989
990 Allows the lookup(name) mechanism.
991
992 =cut
993
994 sub _get_color {
995   my ($self, $name, @depth) = @_;
996
997   push(@depth, $name);
998   my $what;
999   if ($name =~ /^(\w+)\.(\w+)$/) {
1000     $what = $self->{_style}{$1}{$2};
1001   }
1002   else {
1003     $what = $self->{_style}{$name};
1004   }
1005
1006   defined($what)
1007     or return $self->_error("$name was undefined (@depth)");
1008
1009   unless (ref $what) {
1010     if ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) {
1011       @depth < MAX_DEPTH or
1012         return $self->_error("too many levels of recursion in lookup (@depth)");
1013
1014       return $self->_get_color($1, @depth);
1015     }
1016     $what = Imager::Color->new($what);
1017   }
1018
1019   $what;
1020 }
1021
1022 =item _translate_fill($what, $box)
1023
1024 Given the value of a fill, either attempts to convert it into a fill
1025 list (one of C<<color=>$color_value, filled=>1>> or C<<fill=>{ fill
1026 parameters }>>), or to lookup another fill that is referred to with
1027 the 'lookup(name)' mechanism.
1028
1029 This function does the fg and bg initialization for hatched fills, and
1030 translation of *_ratio for fountain fills (using the $box parameter).
1031
1032 =cut
1033
1034 sub _translate_fill {
1035   my ($self, $what, $box, @depth) = @_;
1036
1037   if (ref $what) {
1038     if (UNIVERSAL::isa($what, "Imager::Color")) {
1039       return ( color=>Imager::Color->new($what), filled=>1 );
1040     }
1041     else {
1042       # a general fill
1043       if ($what->{hatch}) {
1044         my %work = %$what;
1045         if (!$work{fg}) {
1046           $work{fg} = $self->_get_color('fg')
1047             or return;
1048         }
1049         if (!$work{bg}) {
1050           $work{bg} = $self->_get_color('bg')
1051             or return;
1052         }
1053         return ( fill=>\%work );
1054       }
1055       elsif ($what->{fountain}) {
1056         my %work = %$what;
1057         for my $key (qw(xa ya xb yb)) {
1058           if (exists $work{"${key}_ratio"}) {
1059             if ($key =~ /^x/) {
1060               $work{$key} = $box->[0] + $work{"${key}_ratio"} 
1061                 * ($box->[2] - $box->[0]);
1062             }
1063             else {
1064               $work{$key} = $box->[1] + $work{"${key}_ratio"} 
1065                 * ($box->[3] - $box->[1]);
1066             }
1067           }
1068         }
1069         return ( fill=>\%work );
1070       }
1071       else {
1072         return ( fill=> $what );
1073       }
1074     }
1075   }
1076   else {
1077     if ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) {
1078       return $self->_get_fill($1, $box, @depth);
1079     }
1080     else {
1081       # assumed to be an Imager::Color single value
1082       return ( color=>Imager::Color->new($what), filled=>1 );
1083     }
1084   }
1085 }
1086
1087 =item _data_fill($index, $box)
1088
1089 Retrieves the fill parameters for a data area fill.
1090
1091 =cut
1092
1093 sub _data_fill {
1094   my ($self, $index, $box) = @_;
1095
1096   my $fills = $self->{_style}{fills};
1097   return $self->_translate_fill($fills->[$index % @$fills], $box,
1098                                 "data.$index");
1099 }
1100
1101 =item _get_fill($index, $box)
1102
1103 Retrieves fill parameters for a named fill.
1104
1105 =cut
1106
1107 sub _get_fill {
1108   my ($self, $name, $box, @depth) = @_;
1109
1110   push(@depth, $name);
1111   my $what;
1112   if ($name =~ /^(\w+)\.(\w+)$/) {
1113     $what = $self->{_style}{$1}{$2};
1114   }
1115   else {
1116     $what = $self->{_style}{$name};
1117   }
1118
1119   defined($what)
1120     or return $self->_error("no fill $name found");
1121
1122   return $self->_translate_fill($what, $box, @depth);
1123 }
1124
1125 =item _make_img()
1126
1127 Builds the image object for the graph and fills it with the background
1128 fill.
1129
1130 =cut
1131
1132 sub _make_img {
1133   my ($self) = @_;
1134   
1135   my ($width, $height) = (256, 256);
1136
1137   $width = $self->_get_number('width');
1138   $height = $self->_get_number('height');
1139   my $channels = $self->{_style}{channels};
1140
1141   $channels ||= 3;
1142
1143   my $img = Imager->new(xsize=>$width, ysize=>$height, channels=>$channels);
1144
1145   $img->box($self->_get_fill('back', [ 0, 0, $width-1, $height-1]));
1146
1147   $img;
1148 }
1149
1150 sub _text_style {
1151   my ($self, $name) = @_;
1152
1153   my %work;
1154
1155   if ($self->{_style}{$name}) {
1156     %work = %{$self->{_style}{$name}};
1157   }
1158   else {
1159     %work = %{$self->{_style}{text}};
1160   }
1161   $work{font}
1162       or return $self->_error("$name has no font parameter");
1163
1164   $work{font} = $self->_get_thing("$name.font")
1165     or return $self->_error("invalid font");
1166   UNIVERSAL::isa($work{font}, "Imager::Font")
1167       or return $self->_error("$name.font is not a font");
1168   if ($work{color} && !ref $work{color}) {
1169     $work{color} = $self->_get_color("$name.color")
1170       or return;
1171   }
1172   $work{size} = $self->_get_number("$name.size");
1173   $work{sizew} = $self->_get_number("$name.sizew")
1174     if $work{sizew};
1175
1176   %work;
1177 }
1178
1179 sub _text_bbox {
1180   my ($self, $text, $name) = @_;
1181
1182   my %text_info = $self->_text_style($name);
1183
1184   my @bbox = $text_info{font}->bounding_box(%text_info, string=>$text,
1185                                             canon=>1);
1186
1187   return @bbox[0..3];
1188 }
1189
1190 sub _align_box {
1191   my ($self, $box, $chart_box, $name) = @_;
1192
1193   my $halign = $self->{_style}{$name}{halign}
1194     or $self->_error("no halign for $name");
1195   my $valign = $self->{_style}{$name}{valign};
1196
1197   if ($halign eq 'right') {
1198     $box->[0] += $chart_box->[2] - $box->[2];
1199   }
1200   elsif ($halign eq 'left') {
1201     $box->[0] = $chart_box->[0];
1202   }
1203   elsif ($halign eq 'center' || $halign eq 'centre') {
1204     $box->[0] = ($chart_box->[0] + $chart_box->[2] - $box->[2])/2;
1205   }
1206   else {
1207     return $self->_error("invalid halign $halign for $name");
1208   }
1209
1210   if ($valign eq 'top') {
1211     $box->[1] = $chart_box->[1];
1212   }
1213   elsif ($valign eq 'bottom') {
1214     $box->[1] = $chart_box->[3] - $box->[3];
1215   }
1216   elsif ($valign eq 'center' || $valign eq 'centre') {
1217     $box->[1] = ($chart_box->[1] + $chart_box->[3] - $box->[3])/2;
1218   }
1219   else {
1220     return $self->_error("invalid valign $valign for $name");
1221   }
1222   $box->[2] += $box->[0];
1223   $box->[3] += $box->[1];
1224 }
1225
1226 sub _remove_box {
1227   my ($self, $chart_box, $object_box) = @_;
1228
1229   my $areax;
1230   my $areay;
1231   if ($object_box->[0] - $chart_box->[0] 
1232       < $chart_box->[2] - $object_box->[2]) {
1233     $areax = ($object_box->[2] - $chart_box->[0]) 
1234       * ($chart_box->[3] - $chart_box->[1]);
1235   }
1236   else {
1237     $areax = ($chart_box->[2] - $object_box->[0]) 
1238       * ($chart_box->[3] - $chart_box->[1]);
1239   }
1240
1241   if ($object_box->[1] - $chart_box->[1] 
1242       < $chart_box->[3] - $object_box->[3]) {
1243     $areay = ($object_box->[3] - $chart_box->[1]) 
1244       * ($chart_box->[2] - $chart_box->[0]);
1245   }
1246   else {
1247     $areay = ($chart_box->[3] - $object_box->[1]) 
1248       * ($chart_box->[2] - $chart_box->[0]);
1249   }
1250
1251   if ($areay < $areax) {
1252     if ($object_box->[1] - $chart_box->[1] 
1253         < $chart_box->[3] - $object_box->[3]) {
1254       $chart_box->[1] = $object_box->[3];
1255     }
1256     else {
1257       $chart_box->[3] = $object_box->[1];
1258     }
1259   }
1260   else {
1261     if ($object_box->[0] - $chart_box->[0] 
1262         < $chart_box->[2] - $object_box->[2]) {
1263       $chart_box->[0] = $object_box->[2];
1264     }
1265     else {
1266       $chart_box->[2] = $object_box->[0];
1267     }
1268   }
1269 }
1270
1271 sub _draw_legend {
1272   my ($self, $img, $labels, $chart_box) = @_;
1273
1274   defined(my $padding = $self->_get_number('legend.padding'))
1275     or return;
1276   my $patchsize = $self->_get_number('legend.patchsize')
1277     or return;
1278   defined(my $gap = $self->_get_number('legend.patchgap'))
1279     or return;
1280   my $minrowsize = $patchsize + $gap;
1281   my ($width, $height) = (0,0);
1282   my @sizes;
1283   for my $label (@$labels) {
1284     my @box = $self->_text_bbox($label, 'legend');
1285     push(@sizes, \@box);
1286     $width = $box[2] if $box[2] > $width;
1287     if ($minrowsize > $box[3]) {
1288       $height += $minrowsize;
1289     }
1290     else {
1291       $height += $box[3];
1292     }
1293   }
1294   my @box = (0, 0, 
1295              $width + $patchsize + $padding * 2 + $gap,
1296              $height + $padding * 2 - $gap);
1297   my $outsidepadding = 0;
1298   if ($self->{_style}{legend}{border}) {
1299     defined($outsidepadding = $self->_get_number('legend.outsidepadding'))
1300       or return;
1301     $box[2] += 2 * $outsidepadding;
1302     $box[3] += 2 * $outsidepadding;
1303   }
1304   $self->_align_box(\@box, $chart_box, 'legend')
1305     or return;
1306   if ($self->{_style}{legend}{fill}) {
1307     $img->box(xmin=>$box[0]+$outsidepadding, 
1308               ymin=>$box[1]+$outsidepadding, 
1309               xmax=>$box[2]-$outsidepadding, 
1310               ymax=>$box[3]-$outsidepadding,
1311              $self->_get_fill('legend.fill', \@box));
1312   }
1313   $box[0] += $outsidepadding;
1314   $box[1] += $outsidepadding;
1315   $box[2] -= $outsidepadding;
1316   $box[3] -= $outsidepadding;
1317   my $ypos = $box[1] + $padding;
1318   my $patchpos = $box[0]+$padding;
1319   my $textpos = $patchpos + $patchsize + $gap;
1320   my %text_info = $self->_text_style('legend')
1321     or return;
1322   my $patchborder;
1323   if ($self->{_style}{legend}{patchborder}) {
1324     $patchborder = $self->_get_color('legend.patchborder')
1325       or return;
1326   }
1327   my $dataindex = 0;
1328   for my $label (@$labels) {
1329     my @patchbox = ( $patchpos - $patchsize/2, $ypos - $patchsize/2,
1330                      $patchpos + $patchsize * 3 / 2, $ypos + $patchsize*3/2 );
1331     my @fill = $self->_data_fill($dataindex, \@patchbox)
1332       or return;
1333     $img->box(xmin=>$patchpos, ymin=>$ypos, xmax=>$patchpos + $patchsize,
1334                ymax=>$ypos + $patchsize, @fill);
1335     if ($self->{_style}{legend}{patchborder}) {
1336       $img->box(xmin=>$patchpos, ymin=>$ypos, xmax=>$patchpos + $patchsize,
1337                 ymax=>$ypos + $patchsize,
1338                 color=>$patchborder);
1339     }
1340     $img->string(%text_info, x=>$textpos, 'y'=>$ypos + $patchsize, 
1341                  text=>$label);
1342
1343     my $step = $patchsize + $gap;
1344     if ($minrowsize < $sizes[$dataindex][3]) {
1345       $ypos += $sizes[$dataindex][3];
1346     }
1347     else {
1348       $ypos += $minrowsize;
1349     }
1350     ++$dataindex;
1351   }
1352   if ($self->{_style}{legend}{border}) {
1353     my $border_color = $self->_get_color('legend.border')
1354       or return;
1355     $img->box(xmin=>$box[0], ymin=>$box[1], xmax=>$box[2], ymax=>$box[3],
1356               color=>$border_color);
1357   }
1358   $self->_remove_box($chart_box, \@box);
1359   1;
1360 }
1361
1362 sub _draw_title {
1363   my ($self, $img, $chart_box) = @_;
1364
1365   my $title = $self->{_style}{title}{text};
1366   my @box = $self->_text_bbox($title, 'title');
1367   my $yoff = $box[1];
1368   @box[0,1] = (0,0);
1369   $self->_align_box(\@box, $chart_box, 'title');
1370   my %text_info = $self->_text_style('title');
1371   $img->string(%text_info, x=>$box[0], 'y'=>$box[3] + $yoff, text=>$title);
1372   $self->_remove_box($chart_box, \@box);
1373   1;
1374 }
1375
1376 sub _small_extent {
1377   my ($self, $box) = @_;
1378
1379   if ($box->[2] - $box->[0] > $box->[3] - $box->[1]) {
1380     return $box->[3] - $box->[1];
1381   }
1382   else {
1383     return $box->[2] - $box->[0];
1384   }
1385 }
1386
1387 =item _composite()
1388
1389 Returns a list of style fields that are stored as composites, and
1390 should be merged instead of just being replaced.
1391
1392 =cut
1393
1394 sub _composite {
1395   qw(title legend text label dropshadow outline callout);
1396 }
1397
1398 sub _filter_region {
1399   my ($self, $img, $left, $top, $right, $bottom, $filter) = @_;
1400
1401   unless (ref $filter) {
1402     my $name = $filter;
1403     $filter = $self->_get_thing($name)
1404       or return;
1405     $filter->{type}
1406       or return $self->_error("no type for filter $name");
1407   }
1408
1409   $left > 0 or $left = 0;
1410   $top > 0 or $top = 0;
1411
1412   # newer versions of Imager let you work on just part of an image
1413   if ($img->can('masked') && !$self->{_style}{features}{_debugblur}) {
1414     my $masked = $img->masked(left=>$left, top=>$top,
1415                               right=>$right, bottom=>$bottom);
1416     $masked->filter(%$filter);
1417   }
1418   else {
1419     # for older versions of Imager
1420     my $subset = $img->crop(left=>$left, top=>$top,
1421                             right=>$right, bottom=>$bottom);
1422     $subset->filter(%$filter);
1423     $img->paste(left=>$left, top=>$top, img=>$subset);
1424   }
1425 }
1426
1427 1;
1428 __END__
1429
1430 =back
1431
1432 =head1 SEE ALSO
1433
1434 Imager::Graph::Pie(3), Imager(3), perl(1).
1435
1436 =head1 AUTHOR
1437
1438 Tony Cook <tony@develop-help.com>
1439
1440 =head1 LICENSE
1441
1442 Imager::Graph is licensed under the same terms as perl itself.
1443
1444 =head1 BLAME
1445
1446 Addi for producing a cool imaging module. :)
1447
1448 =cut