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