note the RT ticket fixed
[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::Sub_class;
11   my $chart = Imager::Graph::Sub_class->new;
12   my $img = $chart->draw(data=> \@data, ...)
13     or die $chart->error;
14   $img->write(file => 'image.png');
15
16 =head1 DESCRIPTION
17
18 Imager::Graph provides style information to its base classes.  It
19 defines the colors, text display information and fills based on both
20 built-in styles and modifications supplied by the user to the draw()
21 method.
22
23 =over
24
25 =cut
26
27 use strict;
28 use vars qw($VERSION);
29 use Imager qw(:handy);
30 use Imager::Fountain;
31
32 $VERSION = '0.09';
33
34 # the maximum recursion depth in determining a color, fill or number
35 use constant MAX_DEPTH => 10;
36
37 my $NUM_RE = '(?:[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:[eE][+-]\d+?)?)';
38
39 =item new
40
41 This is a simple constructor.  No parameters required.
42
43 =cut
44
45 sub new {
46   bless {}, $_[0];
47 }
48
49 =item set_graph_size($size)
50
51 Sets the size of the graph (in pixels) within the image.  The size of the image defaults to 1.5 * $graph_size.
52
53 =cut
54
55 sub set_graph_size {
56   $_[0]->{'custom_style'}->{'size'} = $_[1];
57 }
58
59 =item set_image_width($width)
60
61 Sets the width of the image in pixels.
62
63 =cut
64
65 sub set_image_width {
66   $_[0]->{'custom_style'}->{'width'} = $_[1];
67 }
68
69 =item set_image_height($height)
70
71 Sets the height of the image in pixels.
72
73 =cut
74
75 sub set_image_height {
76   $_[0]->{'custom_style'}->{'height'} = $_[1];
77 }
78
79 =item add_data_series([8, 6, 7, 5, 3, 0, 9], 'Series Name');
80
81 Adds a data series to the graph.  For L<Imager::Graph::Pie>, only one data series can be added.
82
83 =cut
84
85 sub add_data_series {
86   my $self = shift;
87   my $data_ref = shift;
88   my $series_name = shift;
89
90   my $graph_data = $self->{'graph_data'} || [];
91
92   push @$graph_data, { data => $data_ref, series_name => $series_name };
93   if (defined $series_name) {
94     push @{$self->{'labels'}}, $series_name;
95   }
96
97   $self->{'graph_data'} = $graph_data;
98   return;
99 }
100
101 sub _get_data_series {
102   my ($self, $opts) = @_;
103
104   # return the data supplied to draw() if any.
105   if ($opts->{data}) {
106     # one or multiple series?
107     my $data = $opts->{data};
108     if (@$data && ref $data->[0] && ref $data->[0] =~ /ARRAY/) {
109       return $data;
110     }
111     else {
112       return [ { data => $data } ];
113     }
114   }
115
116   return $self->{'graph_data'};
117 }
118
119 =item set_labels(['label1', 'label2' ... ])
120
121 Labels the specific data points.  For line/bar graphs, this is the x-axis.  For pie graphs, it is the label for the wedges.
122
123 =cut
124
125 sub set_labels {
126   $_[0]->{'labels'} = $_[1];
127 }
128
129 sub _get_labels {
130   my ($self, $opts) = @_;
131
132   $opts->{labels}
133     and return $opts->{labels};
134
135   return $_[0]->{'labels'}
136 }
137
138 =item set_title($title)
139
140 Sets the title of the graph.  Requires setting a font.
141
142 =cut
143
144 sub set_title {
145   $_[0]->{'custom_style'}->{'title'}->{'text'} = $_[1];
146 }
147
148 =item set_font($font)
149
150 Sets the font to use for text.  Takes an L<Imager::Font> object.
151
152 =cut
153
154 sub set_font {
155   $_[0]->{'custom_style'}->{'font'} = $_[1];
156 }
157
158 =item set_style($style_name)
159
160 Sets the style to be used for the graph.  Imager::Graph comes with several pre-defined styles: fount_lin (default), fount_rad, mono, primary_red, and primary.
161
162 =cut
163
164 sub set_style {
165   $_[0]->{'style'} = $_[1];
166 }
167
168 sub _get_style {
169   my ($self, $opts) = @_;
170
171   $opts->{style}
172     and return $opts->{style};
173
174   return $self->{'style'};
175 }
176
177 =item error
178
179 Returns an error message.  Only valid if the draw() method returns false.
180
181 =cut
182
183 sub error {
184   $_[0]->{_errstr};
185 }
186
187 =item draw
188
189 Creates a new image, draws the chart onto that image and returns it.
190
191 Optionally, instead of using the api methods to configure your chart,
192 you can supply a C<data> parameter in the format
193 required by that particular graph, and if your graph will use any
194 text, a C<font> parameter
195
196 You can also supply many different parameters which control the way
197 the graph looks.  These are supplied as keyword, value pairs, where
198 the value can be a hashref containing sub values.
199
200 The C<style> parameter will selects a basic color set, and possibly
201 sets other related parameters.  See L</"STYLES">.
202
203  my $font = Imager::Font->new(file => 'ImUgly.ttf');
204  my $img = $chart->draw(
205                  data    => \@data,
206                  font    => $font,
207                  title   => {
208                                  text  => "Hello, World!",
209                                  size  => 36,
210                                  color => 'FF0000'
211                             }
212                  );
213
214 When referring to a single sub-value this documentation will refer to
215 'title.color' rather than 'the color element of title'.
216
217 Returns the graph image on success, or false on failure.
218
219 =back
220
221 =head1 STYLES
222
223 The currently defined styles are:
224
225 =over
226
227 =item primary
228
229 a light grey background with no outlines.  Uses primary colors for the
230 data fills.
231
232 =item primary_red
233
234 a light red background with no outlines.  Uses primary colors for the
235 data fills.
236
237 Graphs drawn using this style should save well as a gif, even though
238 some graphs may perform a slight blur.
239
240 This was the default style, but the red was too loud.
241
242 =item mono
243
244 designed for monochrome output, such as most laser printers, this uses
245 hatched fills for the data, and no colors.  The returned image is a
246 one channel image (which can be overridden with the C<channels>
247 parameter.)
248
249 You can also override the colors used by all components for background
250 or drawing by supplying C<fg> and/or C<bg> parameters.  ie.  if you
251 supply C<<fg=>'FF0000', channels=>3>> then the hash fills and anything
252 else will be drawn in red.  Another use might be to set a transparent
253 background, by supplying C<<bg=>'00000000', channels=>4>>.
254
255 This style outlines the legend if present and outlines the hashed fills.
256
257 =item fount_lin
258
259 designed as a "pretty" style this uses linear fountain fills for the
260 background and data fills, and adds a drop shadow.
261
262 You can override the value used for text and outlines by setting the
263 C<fg> parameter.
264
265 This is the default style.
266
267 =item fount_rad
268
269 also designed as a "pretty" style this uses radial fountain fills for
270 the data and a linear blue to green fill for the background.
271
272 =back
273
274 =head1 Style API
275
276 To set or override styles, you can use the following methods:
277
278 =over 4
279
280 =item set_image_background
281
282 =cut
283
284 sub set_image_background {
285   $_[0]->{'custom_style'}->{'back'} = $_[1];
286 }
287
288 =item set_channels
289
290 =cut
291
292 sub set_channels {
293   $_[0]->{'custom_style'}->{'channels'} = $_[1];
294 }
295
296 =item set_line_color
297
298 =cut
299
300 sub set_line_color {
301   $_[0]->{'custom_style'}->{'line'} = $_[1];
302 }
303
304 =item set_title_font_size
305
306 =cut
307
308 sub set_title_font_size {
309   $_[0]->{'custom_style'}->{'title'}->{'size'} = $_[1];
310 }
311
312 =item set_title_font_color
313
314 =cut
315
316 sub set_title_font_color {
317   $_[0]->{'custom_style'}->{'title'}->{'color'} = $_[1];
318 }
319
320 =item set_title_horizontal_align
321
322 =cut
323
324 sub set_title_horizontal_align {
325   $_[0]->{'custom_style'}->{'title'}->{'halign'} = $_[1];
326 }
327
328 =item set_title_vertical_align
329
330 =cut
331
332 sub set_title_vertical_align {
333   $_[0]->{'custom_style'}->{'title'}->{'valign'} = $_[1];
334 }
335
336 =item set_text_font_color
337
338 =cut
339
340 sub set_text_font_color {
341   $_[0]->{'custom_style'}->{'text'}->{'color'} = $_[1];
342 }
343
344 =item set_text_font_size
345
346 =cut
347
348 sub set_text_font_size {
349   $_[0]->{'custom_style'}->{'text'}->{'size'} = $_[1];
350 }
351
352 =item set_graph_background_color
353
354 =cut
355
356 sub set_graph_background_color {
357   $_[0]->{'custom_style'}->{'bg'} = $_[1];
358 }
359
360 =item set_graph_foreground_color
361
362 =cut
363
364 sub set_graph_foreground_color {
365   $_[0]->{'custom_style'}->{'fg'} = $_[1];
366 }
367
368 =item set_legend_font_color
369
370 =cut
371
372 sub set_legend_font_color {
373   $_[0]->{'custom_style'}->{'legend'}->{'color'} = $_[1];
374 }
375
376 =item set_legend_font
377
378 =cut
379
380 sub set_legend_font {
381   $_[0]->{'custom_style'}->{'legend'}->{'font'} = $_[1];
382 }
383
384 =item set_legend_font_size
385
386 =cut
387
388 sub set_legend_font_size {
389   $_[0]->{'custom_style'}->{'legend'}->{'size'} = $_[1];
390 }
391
392 =item set_legend_patch_size
393
394 =cut
395
396 sub set_legend_patch_size {
397   $_[0]->{'custom_style'}->{'legend'}->{'patchsize'} = $_[1];
398 }
399
400 =item set_legend_patch_gap
401
402 =cut
403
404 sub set_legend_patch_gap {
405   $_[0]->{'custom_style'}->{'legend'}->{'patchgap'} = $_[1];
406 }
407
408 =item set_legend_horizontal_align
409
410 =cut
411
412 sub set_legend_horizontal_align {
413   $_[0]->{'custom_style'}->{'legend'}->{'halign'} = $_[1];
414 }
415
416 =item set_legend_vertical_align
417
418 =cut
419
420 sub set_legend_vertical_align {
421   $_[0]->{'custom_style'}->{'legend'}->{'valign'} = $_[1];
422 }
423
424 =item set_legend_padding
425
426 =cut
427
428 sub set_legend_padding {
429   $_[0]->{'custom_style'}->{'legend'}->{'padding'} = $_[1];
430 }
431
432 =item set_legend_outside_padding
433
434 =cut
435
436 sub set_legend_outside_padding {
437   $_[0]->{'custom_style'}->{'legend'}->{'outsidepadding'} = $_[1];
438 }
439
440 =item set_legend_fill
441
442 =cut
443
444 sub set_legend_fill {
445   $_[0]->{'custom_style'}->{'legend'}->{'fill'} = $_[1];
446 }
447
448 =item set_legend_border
449
450 =cut
451
452 sub set_legend_border {
453   $_[0]->{'custom_style'}->{'legend'}->{'border'} = $_[1];
454 }
455
456 =item set_legend_orientation
457
458 =cut
459
460 sub set_legend_orientation {
461   $_[0]->{'custom_style'}->{'legend'}->{'orientation'} = $_[1];
462 }
463
464 =item set_callout_font_color
465
466 =cut
467
468 sub set_callout_font_color {
469   $_[0]->{'custom_style'}->{'callout'}->{'color'} = $_[1];
470 }
471
472 =item set_callout_font
473
474 =cut
475
476 sub set_callout_font {
477   $_[0]->{'custom_style'}->{'callout'}->{'font'} = $_[1];
478 }
479
480 =item set_callout_font_size
481
482 =cut
483
484 sub set_callout_font_size {
485   $_[0]->{'custom_style'}->{'callout'}->{'size'} = $_[1];
486 }
487
488 =item set_callout_line_color
489
490 =cut
491
492 sub set_callout_line_color {
493   $_[0]->{'custom_style'}->{'callout'}->{'line'} = $_[1];
494 }
495
496 =item set_callout_leader_inside_length
497
498 =cut
499
500 sub set_callout_leader_inside_length {
501   $_[0]->{'custom_style'}->{'callout'}->{'inside'} = $_[1];
502 }
503
504 =item set_callout_leader_outside_length
505
506 =cut
507
508 sub set_callout_leader_outside_length {
509   $_[0]->{'custom_style'}->{'callout'}->{'outside'} = $_[1];
510 }
511
512 =item set_callout_leader_length
513
514 =cut
515
516 sub set_callout_leader_length {
517   $_[0]->{'custom_style'}->{'callout'}->{'leadlen'} = $_[1];
518 }
519
520 =item set_callout_gap
521
522 =cut
523
524 sub set_callout_gap {
525   $_[0]->{'custom_style'}->{'callout'}->{'gap'} = $_[1];
526 }
527
528 =item set_label_font_color
529
530 =cut
531
532 sub set_label_font_color {
533   $_[0]->{'custom_style'}->{'label'}->{'color'} = $_[1];
534 }
535
536 =item set_label_font
537
538 =cut
539
540 sub set_label_font {
541   $_[0]->{'custom_style'}->{'label'}->{'font'} = $_[1];
542 }
543
544 =item set_label_font_size
545
546 =cut
547
548 sub set_label_font_size {
549   $_[0]->{'custom_style'}->{'label'}->{'size'} = $_[1];
550 }
551
552 =item set_drop_shadow_fill_color
553
554 =cut
555
556 sub set_drop_shadow_fill_color {
557   $_[0]->{'custom_style'}->{'dropshadow'}->{'fill'} = $_[1];
558 }
559
560 =item set_drop_shadow_offset
561
562 =cut
563
564 sub set_drop_shadow_offset {
565   $_[0]->{'custom_style'}->{'dropshadow'}->{'off'} = $_[1];
566 }
567
568 =item set_drop_shadowXOffset
569
570 =cut
571
572 sub set_drop_shadowXOffset {
573   $_[0]->{'custom_style'}->{'dropshadow'}->{'offx'} = $_[1];
574 }
575
576 =item set_drop_shadowYOffset
577
578 =cut
579
580 sub set_drop_shadowYOffset {
581   $_[0]->{'custom_style'}->{'dropshadow'}->{'offy'} = $_[1];
582 }
583
584 =item set_drop_shadow_filter
585
586 =cut
587
588 sub set_drop_shadow_filter {
589   $_[0]->{'custom_style'}->{'dropshadow'}->{'filter'} = $_[1];
590 }
591
592 =item set_outline_color
593
594 =cut
595
596 sub set_outline_color {
597   $_[0]->{'custom_style'}->{'outline'}->{'line'} = $_[1];
598 }
599
600 =item set_data_area_fills
601
602 =cut
603
604 sub set_data_area_fills {
605   $_[0]->{'custom_style'}->{'fills'} = $_[1];
606 }
607
608 =item set_data_line_colors
609
610 =cut
611
612 sub set_data_line_colors {
613   $_[0]->{'custom_style'}->{'colors'} = $_[1];
614 }
615
616 =back
617
618 =head1 FEATURES
619
620 Each graph type has a number of features.  These are used to add
621 various items that are displayed in the graph area.
622
623 Features can be controlled by calling methods on the graph object, or
624 by passing a C<features> parameter to draw().
625
626 Some common features are:
627
628 =over
629
630 =item show_legend()
631
632 Feature: legend
633 X<legend><features, legend>
634
635 adds a box containing boxes filled with the data fills, with
636 the labels provided to the draw method.  The legend will only be
637 displayed if both the legend feature is enabled and labels are
638 supplied.
639
640 =cut
641
642 sub show_legend {
643     $_[0]->{'custom_style'}->{'features'}->{'legend'} = 1;
644 }
645
646 =item show_outline()
647
648 Feature: outline
649 X<outline>X<features, outline>
650
651 If enabled, draw a border around the elements representing data in the
652 graph, eg. around each pie segments on a pie chart, around each bar on
653 a bar chart.
654
655 =cut
656
657 sub show_outline {
658     $_[0]->{'custom_style'}->{'features'}->{'outline'} = 1;
659 }
660
661 =item show_labels()
662
663 Feature: labels
664 X<labels>X<features, labels>
665
666 labels each data fill, usually by including text inside the data fill.
667 If the text does not fit in the fill, they could be displayed in some
668 other form, eg. as callouts in a pie graph.
669
670 For pie charts there isn't much point in enabling both the C<legend>
671 and C<labels> features.
672
673 For other charts, the labels label the independent variable, while the
674 legend describes the color used to plot the dependent variables.
675
676 =cut
677
678 sub show_labels {
679     $_[0]->{'custom_style'}->{'features'}->{'labels'} = 1;
680 }
681
682 =item show_drop_shadow()
683
684 Feature: dropshadow
685 X<dropshadow>X<features, dropshadow>
686
687 a simple drop shadow is shown behind some of the graph elements.
688
689 =cut
690
691 sub show_drop_shadow {
692     $_[0]->{'custom_style'}->{'features'}->{'dropshadow'} = 1;
693 }
694
695 =item reset_features()
696
697 Unsets all of the features.
698
699 Note: this disables all features, even those enabled by default for a
700 style.  They can then be enabled by calling feature methods or by
701 supplying a C<feature> parameter to the draw() method.
702
703 =cut
704
705 sub reset_features {
706     $_[0]->{'custom_style'}->{'features'} = {};
707     $_[0]->{'custom_style'}->{'features'}->{'reset'} = 1;
708 }
709
710 =back
711
712 Additionally, features can be set by passing them into the draw()
713 method, named as above:
714
715 =over
716
717 =item *
718
719 if supplied as an array reference, then any element C<no>I<featurename> will
720 disable that feature, while an element I<featurename> will enable it.
721
722 =item *
723
724 if supplied as a scalar, it is treated as if it were a reference to
725 an array containing only that scalar.
726
727 =item *
728
729 if supplied as a hash reference, then a C<reset> key with a true value
730 will avoid inheriting any default features, a key I<feature> with a
731 false value will disable that feature and a key I<feature> with a true
732 value will enable that feature.
733
734 =back
735
736 Each graph also has features specific to that graph.
737
738 =head1 COMMON PARAMETERS
739
740 When referring to a single sub-value this documentation will refer to
741 'title.color' rather than 'the color element of title'.
742
743 Normally, except for the font parameter, these are controlled by
744 styles, but these are the style parameters I'd mostly likely expect
745 you want to use:
746
747 =over
748
749 =item font
750
751 the Imager font object used to draw text on the chart.
752
753 =item back
754
755 the background fill for the graph.  Default depends on the style.
756
757 =item size
758
759 the base size of the graph image.  Default: 256
760
761 =item width
762
763 the width of the graph image.  Default: 1.5 * size (384)
764
765 =item height
766
767 the height of the graph image.  Default: size (256)
768
769 =item channels
770
771 the number of channels in the image.  Default: 3 (the 'mono' style
772 sets this to 1).
773
774 =item line
775
776 the color used for drawing lines, such as outlines or callouts.
777 Default depends on the current style.  Set to undef to remove the
778 outline from a style.
779
780 =item title
781
782 the text used for a graph title.  Default: no title.  Note: this is
783 the same as the title=>{ text => ... } field.
784
785 =over
786
787 =item halign
788
789 horizontal alignment of the title in the graph, one of 'left',
790 'center' or 'right'. Default: center
791
792 =item valign
793
794 vertical alignment of the title, one of 'top', 'center' or 'right'.
795 Default: top.  It's probably a bad idea to set this to 'center' unless
796 you have a very short title.
797
798 =back
799
800 =item text
801
802 This contains basic defaults used in drawing text.
803
804 =over
805
806 =item color
807
808 the default color used for all text, defaults to the fg color.
809
810 =item size
811
812 the base size used for text, also used to scale many graph elements.
813 Default: 14.
814
815 =back
816
817 =back
818
819 =head1 BEYOND STYLES
820
821 In most cases you will want to use just the styles, but you may want
822 to exert more control over the way your chart looks.  This section
823 describes the options you can use to control the way your chart looks.
824
825 Hopefully you don't need to read this.
826
827 =over
828
829 =item back
830
831 The background of the graph.
832
833 =item bg
834
835 =item fg
836
837 Used to define basic background and foreground colors for the graph.
838 The bg color may be used for the background of the graph, and is used
839 as a default for the background of hatched fills.  The fg is used as
840 the default for line and text colors.
841
842 =item font
843
844 The default font used by the graph.  Normally you should supply this
845 if your graph as any text.
846
847 =item line
848
849 The default line color.
850
851 =item text
852
853 defaults for drawing text.  Other textual graph elements will inherit
854 or modify these values.
855
856 =over
857
858 =item color
859
860 default text color, defaults to the I<fg> color.
861
862 =item size
863
864 default text size. Default: 14.  This is used to scale many graph
865 elements, including padding and leader sizes.  Other text elements
866 will either use or scale this value.
867
868 =item font
869
870 default font object.  Inherited from I<font>, which should have been
871 supplied by the caller.
872
873 =back
874
875 =item title
876
877 If you supply a scalar value for this element, it will be stored in
878 the I<text> field.
879
880 Defines the text, font and layout information for the title.
881
882 =over
883
884 =item color
885
886 The color of the title, inherited from I<text.color>.
887
888 =item font
889
890 The font object used for the title, inherited from I<text.font>.
891
892 =item size
893
894 size of the title text. Default: double I<text.size>
895
896 =item halign
897
898 =item valign
899
900 The horizontal and vertical alignment of the title.
901
902 =back
903
904 =item legend
905
906 defines attributes of the graph legend, if present.
907
908 =over
909
910 =item color
911
912 =item font
913
914 =item size
915
916 text attributes for the labels used in the legend.
917
918 =item patchsize
919
920 the width and height of the color patch in the legend.  Defaults to
921 90% of the legend text size.
922
923 =item patchgap
924
925 the minimum gap between patches in pixels.  Defaults to 30% of the
926 patchsize.
927
928 =item patchborder
929
930 the color of the border drawn around each patch.  Inherited from I<line>.
931
932 =item halign
933
934 =item valign
935
936 the horizontal and vertical alignment of the legend within the graph.
937 Defaults to 'right' and 'top'.
938
939 =item padding
940
941 the gap between the legend patches and text and the outside of its
942 box, or to the legend border, if any.
943
944 =item outsidepadding
945
946 the gap between the border and the outside of the legend's box.  This
947 is only used if the I<legend.border> attribute is defined.
948
949 =item fill
950
951 the background fill for the legend.  Default: none
952
953 =item border
954
955 the border color of the legend.  Default: none (no border is drawn
956 around the legend.)
957
958 =item orientation
959
960 The orientation of the legend.  If this is C<vertical> the the patches
961 and labels are stacked on top of each other.  If this is C<horizontal>
962 the patchs and labels are word wrapped across the image.  Default:
963 vertical.
964
965 =back
966
967 For example to create a horizontal legend with borderless patches,
968 darker than the background, you might do:
969
970   my $im = $chart->draw
971     (...,
972     legend =>
973     {
974       patchborder => undef,
975       orientation => 'horizontal',
976       fill => { solid => Imager::Color->new(0, 0, 0, 32), }
977     },
978     ...);
979
980 =item callout
981
982 defines attributes for graph callouts, if any are present.  eg. if the
983 pie graph cannot fit the label into the pie graph segement it will
984 present it as a callout.
985
986 =over
987
988 =item color
989
990 =item font
991
992 =item size
993
994 the text attributes of the callout label.  Inherited from I<text>.
995
996 =item line
997
998 the color of the callout lines.  Inherited from I<line>
999
1000 =item inside
1001
1002 =item outside
1003
1004 the length of the leader on the inside and the outside of the fill,
1005 usually at some angle.  Both default to the size of the callout text.
1006
1007 =item leadlen
1008
1009 the length of the horizontal portion of the leader.  Default:
1010 I<callout.size>.
1011
1012 =item gap
1013
1014 the gap between the callout leader and the callout text.  Defaults to
1015 30% of the text callout size.
1016
1017 =back
1018
1019 =item label
1020
1021 defines attributes for labels drawn into the data areas of a graph.
1022
1023 =over
1024
1025 =item color
1026
1027 =item font
1028
1029 =item size
1030
1031 The text attributes of the labels.  Inherited from I<text>.
1032
1033 =back
1034
1035 =item dropshadow
1036
1037 the attributes of the graph's drop shadow
1038
1039 =over
1040
1041 =item fill
1042
1043 the fill used for the drop shadow.  Default: '404040' (dark gray)
1044
1045 =item off
1046
1047 the offset of the drop shadow.  A convenience value inherited by offx
1048 and offy.  Default: 40% of I<text.size>.
1049
1050 =item offx
1051
1052 =item offy
1053
1054 the horizontal and vertical offsets of the drop shadow.  Both
1055 inherited from I<dropshadow.off>.
1056
1057 =item filter
1058
1059 the filter description passed to Imager's filter method to blur the
1060 drop shadow.  Default: an 11 element convolution filter.
1061
1062 =back
1063
1064 =item outline
1065
1066 describes the lines drawn around filled data areas, such as the
1067 segments of a pie chart.
1068
1069 =over
1070
1071 =item line
1072
1073 the line color of the outlines, inherited from I<line>.
1074
1075 =back
1076
1077 =item fills
1078
1079 a reference to an array containing fills for each data item.
1080
1081 You can mix fill types, ie. using a simple color for the first item, a
1082 hatched fill for the second and a fountain fill for the next.
1083
1084 =back
1085
1086 =head1 HOW VALUES WORK
1087
1088 Internally rather than specifying literal color, fill, or font objects
1089 or literal sizes for each element, Imager::Graph uses a number of
1090 special values to inherit or modify values taken from other graph
1091 element names.
1092
1093 =head2 Specifying colors
1094
1095 You can specify colors by either supplying an Imager::Color object, by
1096 supplying lookup of another color, or by supplying a single value that
1097 Imager::Color::new can use as an initializer.  The most obvious is
1098 just a 6 or 8 digit hex value representing the red, green, blue and
1099 optionally alpha channels of the image.
1100
1101 You can lookup another color by using the lookup() "function", for
1102 example if you give a color as "lookup(fg)" then Imager::Graph will
1103 look for the fg element in the current style (or as overridden by
1104 you.)  This is used internally by Imager::Graph to set up the
1105 relationships between the colors of various elements, for example the
1106 default style information contains:
1107
1108    text=>{
1109           color=>'lookup(fg)',
1110           ...
1111          },
1112    legend =>{
1113              color=>'lookup(text.color)',
1114              ...
1115             },
1116
1117 So by setting the I<fg> color, you also set the default text color,
1118 since each text element uses lookup(text.color) as its value.
1119
1120 =head2 Specifying fills
1121
1122 Fills can be used for the graph background color, the background color
1123 for the legend block and for the fills used for each data element.
1124
1125 You can specify a fill as a L<color value|Specifying colors> or as a
1126 general fill, see L<Imager::Fill> for details.
1127
1128 You don't need (or usually want) to call Imager::Fill::new yourself,
1129 since the various fill functions will call it for you, and
1130 Imager::Graph provides some hooks to make them more useful.
1131
1132 =over
1133
1134 =item *
1135
1136 with hatched fills, if you don't supply a 'fg' or 'bg' parameter,
1137 Imager::Graph will supply the current graph fg and bg colors.
1138
1139 =item *
1140
1141 with fountain fill, you can supply the xa_ratio, ya_ratio, xb_ratio
1142 and yb_ratio parameters, and they will be scaled in the fill area to
1143 define the fountain fills xa, ya, xb and yb parameters.
1144
1145 =back
1146
1147 As with colors, you can use lookup(name) or lookup(name1.name2) to
1148 have one element to inherit the fill of another.
1149
1150 Imager::Graph defaults the fill combine value to C<'normal'>.  This
1151 doesn't apply to simple color fills.
1152
1153 =head2 Specifying numbers
1154
1155 You can specify various numbers, usually representing the size of
1156 something, commonly text, but sometimes the length of a line or the
1157 size of a gap.
1158
1159 You can use the same lookup mechanism as with colors and fills, but
1160 you can also scale values.  For example, 'scale(0.5,text.size)' will
1161 return half the size of the normal text size.
1162
1163 As with colors, this is used internally to scale graph elements based
1164 on the base text size.  If you change the base text size then other
1165 graph elements will scale as well.
1166
1167 =head2 Specifying other elements
1168
1169 Other elements, such as fonts, or parameters for a filter, can also
1170 use the lookup(name) mechanism.
1171
1172 =head1 INTERNAL METHODS
1173
1174 Only useful if you need to fix bugs, add features or create a new
1175 graph class.
1176
1177 =over
1178
1179 =cut
1180
1181 my %style_defs =
1182   (
1183    back=> 'lookup(bg)',
1184    line=> 'lookup(fg)',
1185    aa => 1,
1186    text=>{
1187           color => 'lookup(fg)',
1188           font  => 'lookup(font)',
1189           size  => 14,
1190           aa    => 'lookup(aa)',
1191          },
1192    title=>{ 
1193            color  => 'lookup(text.color)', 
1194            font   => 'lookup(text.font)',
1195            halign => 'center', 
1196            valign => 'top',
1197            size   => 'scale(text.size,2.0)',
1198            aa     => 'lookup(text.aa)',
1199           },
1200    legend =>{
1201              color          => 'lookup(text.color)',
1202              font           => 'lookup(text.font)',
1203              aa             => 'lookup(text.aa)',
1204              size           => 'lookup(text.size)',
1205              patchsize      => 'scale(legend.size,0.9)',
1206              patchgap       => 'scale(legend.patchsize,0.3)',
1207              patchborder    => 'lookup(line)',
1208              halign         => 'right',
1209              valign         => 'top',
1210              padding        => 'scale(legend.size,0.3)',
1211              outsidepadding => 'scale(legend.padding,0.4)',
1212             },
1213    callout => {
1214                color    => 'lookup(text.color)',
1215                font     => 'lookup(text.font)',
1216                size     => 'lookup(text.size)',
1217                line     => 'lookup(line)',
1218                inside   => 'lookup(callout.size)',
1219                outside  => 'lookup(callout.size)',
1220                leadlen  => 'scale(0.8,callout.size)',
1221                gap      => 'scale(callout.size,0.3)',
1222                aa       => 'lookup(text.aa)',
1223                lineaa   => 'lookup(lineaa)',
1224               },
1225    label => {
1226              font          => 'lookup(text.font)',
1227              size          => 'lookup(text.size)',
1228              color         => 'lookup(text.color)',
1229              hpad          => 'lookup(label.pad)',
1230              vpad          => 'lookup(label.pad)',
1231              pad           => 'scale(label.size,0.2)',
1232              pcformat      => sub { sprintf "%s (%.0f%%)", $_[0], $_[1] },
1233              pconlyformat  => sub { sprintf "%.1f%%", $_[0] },
1234              aa            => 'lookup(text.aa)',
1235              lineaa        => 'lookup(lineaa)',
1236              },
1237    dropshadow => {
1238                   fill    => { solid => Imager::Color->new(0, 0, 0, 96) },
1239                   off     => 'scale(0.4,text.size)',
1240                   offx    => 'lookup(dropshadow.off)',
1241                   offy    => 'lookup(dropshadow.off)',
1242                   filter  => { type=>'conv', 
1243                               # this needs a fairly heavy blur
1244                               coef=>[0.1, 0.2, 0.4, 0.6, 0.7, 0.9, 1.2, 
1245                                      0.9, 0.7, 0.6, 0.4, 0.2, 0.1 ] },
1246                  },
1247    # controls the outline of graph elements representing data, eg. pie
1248    # slices, bars or columns
1249    outline => {
1250                line =>'lookup(line)',
1251                lineaa => 'lookup(lineaa)',
1252               },
1253    # controls the outline and background of the data area of the chart
1254    graph =>
1255    {
1256     fill => "lookup(bg)",
1257     outline => "lookup(fg)",
1258    },
1259    size=>256,
1260    width=>'scale(1.5,size)',
1261    height=>'lookup(size)',
1262
1263    # yes, the handling of fill and line AA is inconsistent, lack of
1264    # forethought, unfortunately
1265    fill => {
1266             aa => 'lookup(aa)',
1267            },
1268    lineaa => 'lookup(aa)',
1269
1270     line_markers =>[
1271       { shape => 'circle',   radius => 4 },
1272       { shape => 'square',   radius => 4 },
1273       { shape => 'diamond',  radius => 4 },
1274       { shape => 'triangle', radius => 4 },
1275       { shape => 'x',        radius => 4 },
1276       { shape => 'plus',     radius => 4 },
1277     ],
1278   );
1279
1280 =item _error($message)
1281
1282 Sets the error field of the object and returns an empty list or undef,
1283 depending on context.  Should be used for error handling, since it may
1284 provide some user hooks at some point.
1285
1286 The intended usage is:
1287
1288   some action
1289     or return $self->_error("error description");
1290
1291 You should almost always return the result of _error() or return
1292 immediately afterwards.
1293
1294 =cut
1295
1296 sub _error {
1297   my ($self, $error) = @_;
1298
1299   $self->{_errstr} = $error;
1300
1301   return;
1302 }
1303
1304
1305 =item _style_defs()
1306
1307 Returns the style defaults, such as the relationships between line
1308 color and text color.
1309
1310 Intended to be over-ridden by base classes to provide graph specific
1311 defaults.
1312
1313 =cut
1314
1315 sub _style_defs {
1316   \%style_defs;
1317 }
1318
1319 # Let's make the default something that looks really good, so folks will be interested enough to customize the style.
1320 my $def_style = 'fount_lin';
1321
1322 my %styles =
1323   (
1324    primary =>
1325    {
1326     fills=>
1327     [
1328      qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF)
1329     ],
1330     fg=>'000000',
1331     negative_bg=>'EEEEEE',
1332     bg=>'E0E0E0',
1333     legend=>
1334     {
1335      #patchborder=>'000000'
1336     },
1337    },
1338    primary_red =>
1339    {
1340     fills=>
1341     [
1342      qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF)
1343     ],
1344     fg=>'000000',
1345     negative_bg=>'EEEEEE',
1346     bg=>'C08080',
1347     legend=>
1348     {
1349      patchborder=>'000000'
1350     },
1351    },
1352    mono =>
1353    {
1354     fills=>
1355     [
1356      { hatch=>'slash2' },
1357      { hatch=>'slosh2' },
1358      { hatch=>'vline2' },
1359      { hatch=>'hline2' },
1360      { hatch=>'cross2' },
1361      { hatch=>'grid2' },
1362      { hatch=>'stipple3' },
1363      { hatch=>'stipple2' },
1364     ],
1365     channels=>1,
1366     bg=>'FFFFFF',
1367     fg=>'000000',
1368     negative_bg=>'EEEEEE',
1369     features=>{ outline=>1 },
1370     pie =>{
1371            blur=>undef,
1372           },
1373     aa => 0,
1374     line_markers =>
1375     [
1376      { shape => "x", radius => 4 },
1377      { shape => "plus", radius => 4 },
1378      { shape => "open_circle", radius => 4 },
1379      { shape => "open_diamond", radius => 5 },
1380      { shape => "open_square", radius => 4 },
1381      { shape => "open_triangle", radius => 4 },
1382      { shape => "x", radius => 8 },
1383      { shape => "plus", radius => 8 },
1384      { shape => "open_circle", radius => 8 },
1385      { shape => "open_diamond", radius => 10 },
1386      { shape => "open_square", radius => 8 },
1387      { shape => "open_triangle", radius => 8 },
1388     ],
1389    },
1390    fount_lin =>
1391    {
1392     fills=>
1393     [
1394      { fountain=>'linear',
1395        xa_ratio=>0.13, ya_ratio=>0.13, xb_ratio=>0.87, yb_ratio=>0.87,
1396        segments => Imager::Fountain->simple(positions=>[0, 1],
1397                                             colors=>[ NC('FFC0C0'), NC('FF0000') ]),
1398      },
1399      { fountain=>'linear',
1400        xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1401        segments => Imager::Fountain->simple(positions=>[0, 1],
1402                                             colors=>[ NC('C0FFC0'), NC('00FF00') ]),
1403      },
1404      { fountain=>'linear',
1405        xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1406        segments => Imager::Fountain->simple(positions=>[0, 1],
1407                                             colors=>[ NC('C0C0FF'), NC('0000FF') ]),
1408      },
1409      { fountain=>'linear',
1410        xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1411        segments => Imager::Fountain->simple(positions=>[0, 1],
1412                                             colors=>[ NC('FFFFC0'), NC('FFFF00') ]),
1413      },
1414      { fountain=>'linear',
1415        xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1416        segments => Imager::Fountain->simple(positions=>[0, 1],
1417                                             colors=>[ NC('C0FFFF'), NC('00FFFF') ]),
1418      },
1419      { fountain=>'linear',
1420        xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1421        segments => Imager::Fountain->simple(positions=>[0, 1],
1422                                             colors=>[ NC('FFC0FF'), NC('FF00FF') ]),
1423      },
1424     ],
1425     colors  => [
1426      qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF)
1427     ],
1428     back=>{ fountain=>'linear',
1429             xa_ratio=>0, ya_ratio=>0,
1430             xb_ratio=>1.0, yb_ratio=>1.0,
1431             segments=>Imager::Fountain->simple
1432             ( positions=>[0, 1],
1433               colors=>[ NC('6060FF'), NC('60FF60') ]) },
1434     fg=>'000000',
1435     negative_bg=>'EEEEEE',
1436     bg=>'FFFFFF',
1437     features=>{ dropshadow=>1 },
1438    },
1439    fount_rad =>
1440    {
1441     fills=>
1442     [
1443      { fountain=>'radial',
1444        xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
1445        segments => Imager::Fountain->simple(positions=>[0, 1],
1446                                             colors=>[ NC('FF8080'), NC('FF0000') ]),
1447      },
1448      { fountain=>'radial',
1449        xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
1450        segments => Imager::Fountain->simple(positions=>[0, 1],
1451                                             colors=>[ NC('80FF80'), NC('00FF00') ]),
1452      },
1453      { fountain=>'radial',
1454        xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
1455        segments => Imager::Fountain->simple(positions=>[0, 1],
1456                                             colors=>[ NC('808080FF'), NC('0000FF') ]),
1457      },
1458      { fountain=>'radial',
1459        xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
1460        segments => Imager::Fountain->simple(positions=>[0, 1],
1461                                             colors=>[ NC('FFFF80'), NC('FFFF00') ]),
1462      },
1463      { fountain=>'radial',
1464        xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
1465        segments => Imager::Fountain->simple(positions=>[0, 1],
1466                                             colors=>[ NC('80FFFF'), NC('00FFFF') ]),
1467      },
1468      { fountain=>'radial',
1469        xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
1470        segments => Imager::Fountain->simple(positions=>[0, 1],
1471                                             colors=>[ NC('FF80FF'), NC('FF00FF') ]),
1472      },
1473     ],
1474     colors  => [
1475      qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF)
1476     ],
1477     back=>{ fountain=>'linear',
1478             xa_ratio=>0, ya_ratio=>0,
1479             xb_ratio=>1.0, yb_ratio=>1.0,
1480             segments=>Imager::Fountain->simple
1481             ( positions=>[0, 1],
1482               colors=>[ NC('6060FF'), NC('60FF60') ]) },
1483     fg=>'000000',
1484     negative_bg=>'EEEEEE',
1485     bg=>'FFFFFF',
1486    }
1487   );
1488
1489 $styles{'ocean'} = {
1490     fills  => [
1491              {
1492               fountain =>'linear',
1493               xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1494               segments => Imager::Fountain->simple(
1495                                                     positions=>[0, 1],
1496                                                     colors=>[ NC('EFEDCF'), NC('E6E2AF') ]),
1497             },
1498              {
1499               fountain =>'linear',
1500               xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1501               segments => Imager::Fountain->simple(
1502                                                     positions=>[0, 1],
1503                                                     colors=>[ NC('DCD7AB'), NC('A7A37E') ]),
1504             },
1505              {
1506               fountain =>'linear',
1507               xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1508               segments => Imager::Fountain->simple(
1509                                                     positions=>[0, 1],
1510                                                     colors=>[ NC('B2E5D4'), NC('80B4A2') ]),
1511             },
1512             {
1513               fountain =>'linear',
1514               xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1515               segments => Imager::Fountain->simple(
1516                                                     positions=>[0, 1],
1517                                                     colors=>[ NC('7aaab9'), NC('046380') ]),
1518             },
1519             {
1520               fountain =>'linear',
1521               xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1522               segments => Imager::Fountain->simple(
1523                                                     positions=>[0, 1],
1524                                                     colors=>[ NC('c3b8e9'), NC('877EA7') ]),
1525             },
1526             {
1527               fountain =>'linear',
1528               xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1529               segments => Imager::Fountain->simple(
1530                                                     positions=>[0, 1],
1531                                                     colors=>[ NC('A3DF9A'), NC('67A35E') ]),
1532             },
1533             {
1534               fountain =>'linear',
1535               xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1536               segments => Imager::Fountain->simple(
1537                                                     positions=>[0, 1],
1538                                                     colors=>[ NC('E19C98'), NC('B4726F') ]),
1539             },
1540     ],
1541     colors  => [
1542      qw(E6E2AF A7A37E 80B4A2 046380 877EA7 67A35E B4726F)
1543     ],
1544     fg=>'000000',
1545     negative_bg=>'EEEEEE',
1546     bg=>'FFFFFF',
1547     features=>{ dropshadow=>1 },
1548
1549 };
1550
1551 $styles{'ocean_flat'} = {
1552     fills=>
1553     [
1554      qw(E6E2AF A7A37E 80B4A2 046380 877EA7 67A35E B4726F)
1555     ],
1556     colors  => [
1557      qw(E6E2AF A7A37E 80B4A2 046380 877EA7 67A35E B4726F)
1558     ],
1559     fg=>'000000',
1560     negative_bg=>'EEEEEE',
1561     bg=>'FFFFFF',
1562     features=>{ dropshadow=>1 },
1563
1564 };
1565
1566 =item $self->_style_setup(\%opts)
1567
1568 Uses the values from %opts, the custom style set by methods, the style
1569 set by the style parameter or the set_style() method and the built in
1570 chart defaults to build a working style.
1571
1572 The working style features member is also populated with the active
1573 features for the chart.
1574
1575 The working style is stored in the C<_style> member of $self.
1576
1577 =cut
1578
1579 sub _style_setup {
1580   my ($self, $opts) = @_;
1581   my $style_defs = $self->_style_defs;
1582   my $style;
1583
1584   my $pre_def_style = $self->_get_style($opts);
1585   my $api_style = $self->{'custom_style'} || {};
1586   $style = $styles{$pre_def_style} if $pre_def_style;
1587
1588   $style ||= $styles{$def_style};
1589
1590   my @search_list = ( $style_defs, $style, $api_style, $opts);
1591   my %work;
1592
1593   my @composite = $self->_composite();
1594   my %composite;
1595   @composite{@composite} = @composite;
1596
1597   for my $src (@search_list) {
1598     for my $key (keys %$src) {
1599       if ($composite{$key}) {
1600         $work{$key} = {} unless exists $work{$key};
1601         if (ref $src->{$key}) {
1602           # some keys have sub values, especially text
1603           @{$work{$key}}{keys %{$src->{$key}}} = values %{$src->{$key}};
1604         }
1605         else {
1606           # assume it's the text for a title or something
1607           $work{$key}{text} = $src->{$key};
1608         }
1609       }
1610       else {
1611         $work{$key} = $src->{$key}
1612           if defined $src->{$key}; # $opts with pmichauds new accessor handling
1613       }
1614     }
1615   }
1616
1617   # features are handled specially
1618   my %features;
1619   $work{features} = \%features;
1620   for my $src (@search_list) {
1621     if ($src->{features}) {
1622       if (ref $src->{features}) {
1623         if (ref($src->{features}) =~ /ARRAY/) {
1624           # just set those features
1625           for my $feature (@{$src->{features}}) {
1626             if ($feature =~ /^no(.+)$/) {
1627               delete $features{$1};
1628             }
1629             else {
1630               $features{$feature} = 1;
1631             }
1632           }
1633         }
1634         elsif (ref($src->{features}) =~ /HASH/) {
1635           if ($src->{features}{reset}) {
1636             $work{features} = {}; # only the ones the user specifies
1637           }
1638           @{$work{features}}{keys %{$src->{features}}} =
1639             values(%{$src->{features}});
1640         }
1641       }
1642       else {
1643         # just set that single feature
1644         if ($src->{features} =~ /^no(.+)$/) {
1645           delete $features{$1};
1646         }
1647         else {
1648           $features{$src->{features}} = 1;
1649         }
1650       }
1651     }
1652   }
1653
1654   $self->{_style} = \%work;
1655 }
1656
1657 =item $self->_get_thing($name)
1658
1659 Retrieve some general 'thing'.
1660
1661 Supports the 'lookup(foo)' mechanism.
1662
1663 Returns an empty list on failure.
1664
1665 =cut
1666
1667 sub _get_thing {
1668   my ($self, $name, @depth) = @_;
1669
1670   push(@depth, $name);
1671   my $what;
1672   if ($name =~ /^(\w+)\.(\w+)$/) {
1673     $what = $self->{_style}{$1}{$2};
1674   }
1675   else {
1676     $what = $self->{_style}{$name};
1677   }
1678   defined $what or
1679     return;
1680   if (ref $what) {
1681     return $what;
1682   }
1683   elsif ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) {
1684     @depth < MAX_DEPTH
1685       or return $self->_error("too many levels of recursion in lookup(@depth)");
1686     return $self->_get_thing($1, @depth);
1687   }
1688   else {
1689     return $what;
1690   }
1691 }
1692
1693 =item $self->_get_number($name)
1694
1695 Retrieves a number from the style.  The value in the style can be the
1696 number, or one of two functions:
1697
1698 =over
1699
1700 =item lookup(newname)
1701
1702 Recursively looks up I<newname> in the style.
1703
1704 =item scale(value1,value2)
1705
1706 Each value can be a number or a name.  Names are recursively looked up
1707 in the style and the product is returned.
1708
1709 =back
1710
1711 =cut
1712
1713 sub _get_number {
1714   my ($self, $name, @depth) = @_;
1715
1716   push(@depth, $name);
1717   my $what;
1718   if ($name =~ /^(\w+)\.(\w+)$/) {
1719     $what = $self->{_style}{$1}{$2};
1720   }
1721   else {
1722     $what = $self->{_style}{$name};
1723   }
1724   defined $what or
1725     return $self->_error("$name is undef (@depth)");
1726
1727   if (ref $what) {
1728     if ($what =~ /CODE/) {
1729       $what = $what->($self, $name);
1730     }
1731   }
1732   else {
1733     if ($what =~ /^lookup\(([\w.]+)\)$/) {
1734       @depth < MAX_DEPTH
1735         or return $self->_error("too many levels of recursion in lookup (@depth)");
1736       return $self->_get_number($1, @depth);
1737     }
1738     elsif ($what =~ /^scale\(
1739                     ((?:[a-z][\w.]*)|$NUM_RE)
1740                     ,
1741                     ((?:[a-z][\w.]*)|$NUM_RE)\)$/x) {
1742       my ($left, $right) = ($1, $2);
1743       unless ($left =~ /^$NUM_RE$/) {
1744         @depth < MAX_DEPTH 
1745           or return $self->_error("too many levels of recursion in scale (@depth)");
1746         $left = $self->_get_number($left, @depth);
1747       }
1748       unless ($right =~ /^$NUM_RE$/) {
1749         @depth < MAX_DEPTH 
1750           or return $self->_error("too many levels of recursion in scale (@depth)");
1751         $right = $self->_get_number($right, @depth);
1752       }
1753       return $left * $right;
1754     }
1755     else {
1756       return $what+0;
1757     }
1758   }
1759 }
1760
1761 =item $self->_get_integer($name)
1762
1763 Retrieves an integer from the style.  This is a simple wrapper around
1764 _get_number() that rounds the result to an integer.
1765
1766 Returns an empty list on failure.
1767
1768 =cut
1769
1770 sub _get_integer {
1771   my ($self, $name, @depth) = @_;
1772
1773   my $number = $self->_get_number($name, @depth)
1774     or return;
1775
1776   return sprintf("%.0f", $number);
1777 }
1778
1779 =item _get_color($name)
1780
1781 Returns a color object of the given name from the style hash.
1782
1783 Uses Imager::Color->new to translate normal scalars into color objects.
1784
1785 Allows the lookup(name) mechanism.
1786
1787 Returns an empty list on failure.
1788
1789 =cut
1790
1791 sub _get_color {
1792   my ($self, $name, @depth) = @_;
1793
1794   push(@depth, $name);
1795   my $what;
1796   if ($name =~ /^(\w+)\.(\w+)$/) {
1797     $what = $self->{_style}{$1}{$2};
1798   }
1799   else {
1800     $what = $self->{_style}{$name};
1801   }
1802
1803   defined($what)
1804     or return $self->_error("$name was undefined (@depth)");
1805
1806   unless (ref $what) {
1807     if ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) {
1808       @depth < MAX_DEPTH or
1809         return $self->_error("too many levels of recursion in lookup (@depth)");
1810
1811       return $self->_get_color($1, @depth);
1812     }
1813     $what = Imager::Color->new($what);
1814   }
1815
1816   $what;
1817 }
1818
1819 =item _translate_fill($what, $box)
1820
1821 Given the value of a fill, either attempts to convert it into a fill
1822 list (one of C<<color=>$color_value, filled=>1>> or C<<fill=>{ fill
1823 parameters }>>), or to lookup another fill that is referred to with
1824 the 'lookup(name)' mechanism.
1825
1826 This function does the fg and bg initialization for hatched fills, and
1827 translation of *_ratio for fountain fills (using the $box parameter).
1828
1829 Returns an empty list on failure.
1830
1831 =cut
1832
1833 sub _translate_fill {
1834   my ($self, $what, $box, @depth) = @_;
1835
1836   if (ref $what) {
1837     if (UNIVERSAL::isa($what, "Imager::Color")) {
1838       return ( color=>Imager::Color->new($what), filled=>1 );
1839     }
1840     else {
1841       # a general fill
1842       # default to normal combine mode
1843       my %work = ( combine => 'normal', %$what );
1844       if ($what->{hatch}) {
1845         if (!$work{fg}) {
1846           $work{fg} = $self->_get_color('fg')
1847             or return;
1848         }
1849         if (!$work{bg}) {
1850           $work{bg} = $self->_get_color('bg')
1851             or return;
1852         }
1853         return ( fill=>\%work );
1854       }
1855       elsif ($what->{fountain}) {
1856         for my $key (qw(xa ya xb yb)) {
1857           if (exists $work{"${key}_ratio"}) {
1858             if ($key =~ /^x/) {
1859               $work{$key} = $box->[0] + $work{"${key}_ratio"} 
1860                 * ($box->[2] - $box->[0]);
1861             }
1862             else {
1863               $work{$key} = $box->[1] + $work{"${key}_ratio"} 
1864                 * ($box->[3] - $box->[1]);
1865             }
1866           }
1867         }
1868         return ( fill=>\%work );
1869       }
1870       else {
1871         return ( fill=> \%work );
1872       }
1873     }
1874   }
1875   else {
1876     if ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) {
1877       return $self->_get_fill($1, $box, @depth);
1878     }
1879     else {
1880       # assumed to be an Imager::Color single value
1881       return ( color=>Imager::Color->new($what), filled=>1 );
1882     }
1883   }
1884 }
1885
1886 =item _data_fill($index, $box)
1887
1888 Retrieves the fill parameters for a data area fill.
1889
1890 =cut
1891
1892 sub _data_fill {
1893   my ($self, $index, $box) = @_;
1894
1895   my $fills = $self->{_style}{fills};
1896   return $self->_translate_fill($fills->[$index % @$fills], $box,
1897                                 "data.$index");
1898 }
1899
1900 sub _data_color {
1901   my ($self, $index) = @_;
1902
1903   my $colors = $self->{'_style'}{'colors'} || [];
1904   my $fills  = $self->{'_style'}{'fills'} || [];
1905
1906   # Try to just use a fill, so non-fountain styles don't need
1907   # to have a duplicated set of fills and colors
1908   my $fill = $fills->[$index % @$fills];
1909   if (!ref $fill) {
1910     return $fill;
1911   }
1912
1913   if (@$colors) {
1914     return $colors->[$index % @$colors] || '000000';
1915   }
1916   return '000000';
1917 }
1918
1919 =item _get_fill($name, $box)
1920
1921 Retrieves fill parameters for a named fill.
1922
1923 =cut
1924
1925 sub _get_fill {
1926   my ($self, $name, $box, @depth) = @_;
1927
1928   push(@depth, $name);
1929   my $what;
1930   if ($name =~ /^(\w+)\.(\w+)$/) {
1931     $what = $self->{_style}{$1}{$2};
1932   }
1933   else {
1934     $what = $self->{_style}{$name};
1935   }
1936
1937   defined($what)
1938     or return $self->_error("no fill $name found");
1939
1940   return $self->_translate_fill($what, $box, @depth);
1941 }
1942
1943 =item _get_line($name)
1944
1945 Return color (and possibly other) parameters for drawing a line with
1946 the _line() method.
1947
1948 =cut
1949
1950 sub _get_line {
1951   my ($self, $name, @depth) = @_;
1952
1953   push (@depth, $name);
1954   my $what;
1955   if ($name =~ /^(\w+)\.(\w+)$/) {
1956     $what = $self->{_style}{$1}{$2};
1957   }
1958   else {
1959     $what = $self->{_style}{$name};
1960   }
1961
1962   defined($what)
1963     or return $self->_error("no line style $name found");
1964
1965   if (ref $what) {
1966     if (eval { $what->isa("Imager::Color") }) {
1967       return $what;
1968     }
1969     if (ref $what eq "HASH") {
1970       # allow each kep to be looked up
1971       my %work = %$what;
1972
1973       if ($work{color} =~ /^lookup\((.*)\)$/) {
1974         $work{color} = $self->_get_color($1, @depth);
1975       }
1976       for my $key (keys %work) {
1977         $key eq "color" and next;
1978
1979         if ($work{$key} =~ /^lookup\((.*)\)$/) {
1980           $work{$key} = $self->_get_thing($1);
1981         }
1982       }
1983
1984       return %work;
1985     }
1986     return ( color => Imager::Color->new(@$what) );
1987   }
1988   else {
1989     if ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) {
1990       @depth < MAX_DEPTH
1991         or return $self->_error("too many levels of recursion in lookup (@depth)");
1992       return $self->_get_line($1, @depth);
1993     }
1994     else {
1995       # presumably a text color
1996       my $color = Imager::Color->new($what)
1997         or return $self->_error("Could not translate $what as a color: ".Imager->errstr);
1998
1999       return ( color => $color );
2000     }
2001   }
2002 }
2003
2004 =item _make_img()
2005
2006 Builds the image object for the graph and fills it with the background
2007 fill.
2008
2009 =cut
2010
2011 sub _make_img {
2012   my ($self) = @_;
2013
2014   my $width = $self->_get_number('width') || 256;
2015   my $height = $self->_get_number('height') || 256;
2016   my $channels = $self->{_style}{channels};
2017
2018   $channels ||= 3;
2019
2020   my $img = Imager->new(xsize=>$width, ysize=>$height, channels=>$channels)
2021     or return $self->_error("Error creating image: " . Imager->errstr);
2022
2023   $img->box($self->_get_fill('back', [ 0, 0, $width-1, $height-1]));
2024
2025   $self->{_image} = $img;
2026
2027   return $img;
2028 }
2029
2030 sub _get_image {
2031   my $self = shift;
2032
2033   return $self->{'_image'};
2034 }
2035
2036 =item _text_style($name)
2037
2038 Returns parameters suitable for calls to Imager::Font's bounding_box()
2039 and draw() methods intended for use in defining text styles.
2040
2041 Returns an empty list on failure.
2042
2043 Returns the following attributes: font, color, size, aa, sizew
2044 (optionally)
2045
2046 =cut
2047
2048 sub _text_style {
2049   my ($self, $name) = @_;
2050
2051   my %work;
2052
2053   if ($self->{_style}{$name}) {
2054     %work = %{$self->{_style}{$name}};
2055   }
2056   else {
2057     %work = %{$self->{_style}{text}};
2058   }
2059   $work{font}
2060     or return $self->_error("$name has no font parameter");
2061
2062   $work{font} = $self->_get_thing("$name.font")
2063     or return $self->_error("No $name.font defined, either set $name.font or font to a font");
2064   UNIVERSAL::isa($work{font}, "Imager::Font")
2065       or return $self->_error("$name.font is not a font");
2066   if ($work{color} && !ref $work{color}) {
2067     $work{color} = $self->_get_color("$name.color")
2068       or return;
2069   }
2070   $work{size} = $self->_get_number("$name.size");
2071   $work{sizew} = $self->_get_number("$name.sizew")
2072     if $work{sizew};
2073   $work{aa} = $self->_get_number("$name.aa");
2074
2075   %work;
2076 }
2077
2078 =item _text_bbox($text, $name)
2079
2080 Returns a bounding box for the specified $text as styled by $name.
2081
2082 Returns an empty list on failure.
2083
2084 =cut
2085
2086 sub _text_bbox {
2087   my ($self, $text, $name) = @_;
2088
2089   my %text_info = $self->_text_style($name)
2090     or return;
2091
2092   my @bbox = $text_info{font}->bounding_box(%text_info, string=>$text,
2093                                             canon=>1);
2094
2095   return @bbox[0..3];
2096 }
2097
2098 =item _line_style($name)
2099
2100 Return parameters suitable for calls to Imager's line(), polyline(),
2101 and box() methods.
2102
2103 For now this returns only color and aa parameters, but future releases
2104 of Imager may support extra parameters.
2105
2106 =cut
2107
2108 sub _line_style {
2109   my ($self, $name) = @_;
2110
2111   my %line;
2112   $line{color} = $self->_get_color("$name.line")
2113     or return;
2114   $line{aa} = $self->_get_number("$name.lineaa");
2115   defined $line{aa} or $line{aa} = $self->_get_number("aa");
2116
2117   return %line;
2118 }
2119
2120 sub _align_box {
2121   my ($self, $box, $chart_box, $name) = @_;
2122
2123   my $halign = $self->{_style}{$name}{halign}
2124     or $self->_error("no halign for $name");
2125   my $valign = $self->{_style}{$name}{valign};
2126
2127   if ($halign eq 'right') {
2128     $box->[0] += $chart_box->[2] - $box->[2];
2129   }
2130   elsif ($halign eq 'left') {
2131     $box->[0] = $chart_box->[0];
2132   }
2133   elsif ($halign eq 'center' || $halign eq 'centre') {
2134     $box->[0] = ($chart_box->[0] + $chart_box->[2] - $box->[2])/2;
2135   }
2136   else {
2137     return $self->_error("invalid halign $halign for $name");
2138   }
2139
2140   if ($valign eq 'top') {
2141     $box->[1] = $chart_box->[1];
2142   }
2143   elsif ($valign eq 'bottom') {
2144     $box->[1] = $chart_box->[3] - $box->[3];
2145   }
2146   elsif ($valign eq 'center' || $valign eq 'centre') {
2147     $box->[1] = ($chart_box->[1] + $chart_box->[3] - $box->[3])/2;
2148   }
2149   else {
2150     return $self->_error("invalid valign $valign for $name");
2151   }
2152   $box->[2] += $box->[0];
2153   $box->[3] += $box->[1];
2154 }
2155
2156 sub _remove_box {
2157   my ($self, $chart_box, $object_box) = @_;
2158
2159   my $areax;
2160   my $areay;
2161   if ($object_box->[0] - $chart_box->[0] 
2162       < $chart_box->[2] - $object_box->[2]) {
2163     $areax = ($object_box->[2] - $chart_box->[0]) 
2164       * ($chart_box->[3] - $chart_box->[1]);
2165   }
2166   else {
2167     $areax = ($chart_box->[2] - $object_box->[0]) 
2168       * ($chart_box->[3] - $chart_box->[1]);
2169   }
2170
2171   if ($object_box->[1] - $chart_box->[1] 
2172       < $chart_box->[3] - $object_box->[3]) {
2173     $areay = ($object_box->[3] - $chart_box->[1]) 
2174       * ($chart_box->[2] - $chart_box->[0]);
2175   }
2176   else {
2177     $areay = ($chart_box->[3] - $object_box->[1]) 
2178       * ($chart_box->[2] - $chart_box->[0]);
2179   }
2180
2181   if ($areay < $areax) {
2182     if ($object_box->[1] - $chart_box->[1] 
2183         < $chart_box->[3] - $object_box->[3]) {
2184       $chart_box->[1] = $object_box->[3];
2185     }
2186     else {
2187       $chart_box->[3] = $object_box->[1];
2188     }
2189   }
2190   else {
2191     if ($object_box->[0] - $chart_box->[0] 
2192         < $chart_box->[2] - $object_box->[2]) {
2193       $chart_box->[0] = $object_box->[2];
2194     }
2195     else {
2196       $chart_box->[2] = $object_box->[0];
2197     }
2198   }
2199 }
2200
2201 sub _draw_legend {
2202   my ($self, $img, $labels, $chart_box) = @_;
2203
2204   my $orient = $self->_get_thing('legend.orientation');
2205   defined $orient or $orient = 'vertical';
2206
2207   if ($orient eq 'vertical') {
2208     return $self->_draw_legend_vertical($img, $labels, $chart_box);
2209   }
2210   elsif ($orient eq 'horizontal') {
2211     return $self->_draw_legend_horizontal($img, $labels, $chart_box);
2212   }
2213   else {
2214     return $self->_error("Unknown legend.orientation $orient");
2215   }
2216 }
2217
2218 sub _draw_legend_horizontal {
2219   my ($self, $img, $labels, $chart_box) = @_;
2220
2221   defined(my $padding = $self->_get_integer('legend.padding'))
2222     or return;
2223   my $patchsize = $self->_get_integer('legend.patchsize')
2224     or return;
2225   defined(my $gap = $self->_get_integer('legend.patchgap'))
2226     or return;
2227
2228   my $minrowsize = $patchsize + $gap;
2229   my ($width, $height) = (0,0);
2230   my $row_height = $minrowsize;
2231   my $pos = 0;
2232   my @sizes;
2233   my @offsets;
2234   for my $label (@$labels) {
2235     my @text_box = $self->_text_bbox($label, 'legend')
2236       or return;
2237     push(@sizes, \@text_box);
2238     my $entry_width = $patchsize + $gap + $text_box[2];
2239     if ($pos == 0) {
2240       # never re-wrap the first entry
2241       push @offsets, [ 0, $height ];
2242     }
2243     else {
2244       if ($pos + $gap + $entry_width > $chart_box->[2]) {
2245         $pos = 0;
2246         $height += $row_height;
2247       }
2248       push @offsets, [ $pos, $height ];
2249     }
2250     my $entry_right = $pos + $entry_width;
2251     $pos += $gap + $entry_width;
2252     $entry_right > $width and $width = $entry_right;
2253     if ($text_box[3] > $row_height) {
2254       $row_height = $text_box[3];
2255     }
2256   }
2257   $height += $row_height;
2258   my @box = ( 0, 0, $width + $padding * 2, $height + $padding * 2 );
2259   my $outsidepadding = 0;
2260   if ($self->{_style}{legend}{border}) {
2261     defined($outsidepadding = $self->_get_integer('legend.outsidepadding'))
2262       or return;
2263     $box[2] += 2 * $outsidepadding;
2264     $box[3] += 2 * $outsidepadding;
2265   }
2266   $self->_align_box(\@box, $chart_box, 'legend')
2267     or return;
2268   if ($self->{_style}{legend}{fill}) {
2269     $img->box(xmin=>$box[0]+$outsidepadding, 
2270               ymin=>$box[1]+$outsidepadding, 
2271               xmax=>$box[2]-$outsidepadding, 
2272               ymax=>$box[3]-$outsidepadding,
2273              $self->_get_fill('legend.fill', \@box));
2274   }
2275   $box[0] += $outsidepadding;
2276   $box[1] += $outsidepadding;
2277   $box[2] -= $outsidepadding;
2278   $box[3] -= $outsidepadding;
2279   my %text_info = $self->_text_style('legend')
2280     or return;
2281   my $patchborder;
2282   if ($self->{_style}{legend}{patchborder}) {
2283     $patchborder = $self->_get_color('legend.patchborder')
2284       or return;
2285   }
2286   
2287   my $dataindex = 0;
2288   for my $label (@$labels) {
2289     my ($left, $top) = @{$offsets[$dataindex]};
2290     $left += $box[0] + $padding;
2291     $top += $box[1] + $padding;
2292     my $textpos = $left + $patchsize + $gap;
2293     my @patchbox = ( $left, $top,
2294                      $left + $patchsize, $top + $patchsize );
2295     my @fill = $self->_data_fill($dataindex, \@patchbox)
2296       or return;
2297     $img->box(xmin=>$left, ymin=>$top, xmax=>$left + $patchsize,
2298                ymax=>$top + $patchsize, @fill);
2299     if ($self->{_style}{legend}{patchborder}) {
2300       $img->box(xmin=>$left, ymin=>$top, xmax=>$left + $patchsize,
2301                 ymax=>$top + $patchsize,
2302                 color=>$patchborder);
2303     }
2304     $img->string(%text_info, x=>$textpos, 'y'=>$top + $patchsize, 
2305                  text=>$label);
2306
2307     ++$dataindex;
2308   }
2309   if ($self->{_style}{legend}{border}) {
2310     my $border_color = $self->_get_color('legend.border')
2311       or return;
2312     $img->box(xmin=>$box[0], ymin=>$box[1], xmax=>$box[2], ymax=>$box[3],
2313               color=>$border_color);
2314   }
2315   $self->_remove_box($chart_box, \@box);
2316   1;
2317 }
2318
2319 sub _draw_legend_vertical {
2320   my ($self, $img, $labels, $chart_box) = @_;
2321
2322   defined(my $padding = $self->_get_integer('legend.padding'))
2323     or return;
2324   my $patchsize = $self->_get_integer('legend.patchsize')
2325     or return;
2326   defined(my $gap = $self->_get_integer('legend.patchgap'))
2327     or return;
2328   my $minrowsize = $patchsize + $gap;
2329   my ($width, $height) = (0,0);
2330   my @sizes;
2331   for my $label (@$labels) {
2332     my @box = $self->_text_bbox($label, 'legend')
2333       or return;
2334     push(@sizes, \@box);
2335     $width = $box[2] if $box[2] > $width;
2336     if ($minrowsize > $box[3]) {
2337       $height += $minrowsize;
2338     }
2339     else {
2340       $height += $box[3];
2341     }
2342   }
2343   my @box = (0, 0, 
2344              $width + $patchsize + $padding * 2 + $gap,
2345              $height + $padding * 2 - $gap);
2346   my $outsidepadding = 0;
2347   if ($self->{_style}{legend}{border}) {
2348     defined($outsidepadding = $self->_get_integer('legend.outsidepadding'))
2349       or return;
2350     $box[2] += 2 * $outsidepadding;
2351     $box[3] += 2 * $outsidepadding;
2352   }
2353   $self->_align_box(\@box, $chart_box, 'legend')
2354     or return;
2355   if ($self->{_style}{legend}{fill}) {
2356     $img->box(xmin=>$box[0]+$outsidepadding, 
2357               ymin=>$box[1]+$outsidepadding, 
2358               xmax=>$box[2]-$outsidepadding, 
2359               ymax=>$box[3]-$outsidepadding,
2360              $self->_get_fill('legend.fill', \@box));
2361   }
2362   $box[0] += $outsidepadding;
2363   $box[1] += $outsidepadding;
2364   $box[2] -= $outsidepadding;
2365   $box[3] -= $outsidepadding;
2366   my $ypos = $box[1] + $padding;
2367   my $patchpos = $box[0]+$padding;
2368   my $textpos = $patchpos + $patchsize + $gap;
2369   my %text_info = $self->_text_style('legend')
2370     or return;
2371   my $patchborder;
2372   if ($self->{_style}{legend}{patchborder}) {
2373     $patchborder = $self->_get_color('legend.patchborder')
2374       or return;
2375   }
2376   my $dataindex = 0;
2377   for my $label (@$labels) {
2378     my @patchbox = ( $patchpos - $patchsize/2, $ypos - $patchsize/2,
2379                      $patchpos + $patchsize * 3 / 2, $ypos + $patchsize*3/2 );
2380
2381     my @fill;
2382     if ($self->_draw_flat_legend()) {
2383       @fill = (color => $self->_data_color($dataindex), filled => 1);
2384     }
2385     else {
2386       @fill = $self->_data_fill($dataindex, \@patchbox)
2387         or return;
2388     }
2389     $img->box(xmin=>$patchpos, ymin=>$ypos, xmax=>$patchpos + $patchsize,
2390                ymax=>$ypos + $patchsize, @fill);
2391     if ($self->{_style}{legend}{patchborder}) {
2392       $img->box(xmin=>$patchpos, ymin=>$ypos, xmax=>$patchpos + $patchsize,
2393                 ymax=>$ypos + $patchsize,
2394                 color=>$patchborder);
2395     }
2396     $img->string(%text_info, x=>$textpos, 'y'=>$ypos + $patchsize, 
2397                  text=>$label);
2398
2399     my $step = $patchsize + $gap;
2400     if ($minrowsize < $sizes[$dataindex][3]) {
2401       $ypos += $sizes[$dataindex][3];
2402     }
2403     else {
2404       $ypos += $minrowsize;
2405     }
2406     ++$dataindex;
2407   }
2408   if ($self->{_style}{legend}{border}) {
2409     my $border_color = $self->_get_color('legend.border')
2410       or return;
2411     $img->box(xmin=>$box[0], ymin=>$box[1], xmax=>$box[2], ymax=>$box[3],
2412               color=>$border_color);
2413   }
2414   $self->_remove_box($chart_box, \@box);
2415   1;
2416 }
2417
2418 sub _draw_title {
2419   my ($self, $img, $chart_box) = @_;
2420
2421   my $title = $self->{_style}{title}{text};
2422   my @box = $self->_text_bbox($title, 'title')
2423     or return;
2424   my $yoff = $box[1];
2425   @box[0,1] = (0,0);
2426   $self->_align_box(\@box, $chart_box, 'title');
2427   my %text_info = $self->_text_style('title')
2428     or return;
2429   $img->string(%text_info, x=>$box[0], 'y'=>$box[3] + $yoff, text=>$title);
2430   $self->_remove_box($chart_box, \@box);
2431   1;
2432 }
2433
2434 sub _small_extent {
2435   my ($self, $box) = @_;
2436
2437   if ($box->[2] - $box->[0] > $box->[3] - $box->[1]) {
2438     return $box->[3] - $box->[1];
2439   }
2440   else {
2441     return $box->[2] - $box->[0];
2442   }
2443 }
2444
2445 sub _draw_flat_legend {
2446   return 0;
2447 }
2448
2449 =item _composite()
2450
2451 Returns a list of style fields that are stored as composites, and
2452 should be merged instead of just being replaced.
2453
2454 =cut
2455
2456 sub _composite {
2457   qw(title legend text label dropshadow outline callout graph);
2458 }
2459
2460 sub _filter_region {
2461   my ($self, $img, $left, $top, $right, $bottom, $filter) = @_;
2462
2463   unless (ref $filter) {
2464     my $name = $filter;
2465     $filter = $self->_get_thing($name)
2466       or return;
2467     $filter->{type}
2468       or return $self->_error("no type for filter $name");
2469   }
2470
2471   $left > 0 or $left = 0;
2472   $top > 0 or $top = 0;
2473
2474   my $masked = $img->masked(left=>$left, top=>$top,
2475                             right=>$right, bottom=>$bottom);
2476   $masked->filter(%$filter);
2477 }
2478
2479 =item _line(x1 => $x1, y1 => $y1, ..., style => $style)
2480
2481 Wrapper for line drawing, implements styles Imager doesn't.
2482
2483 Currently styles are limited to horizontal and vertical lines.
2484
2485 =cut
2486
2487 sub _line {
2488   my ($self, %opts) = @_;
2489
2490   my $img = delete $opts{img}
2491     or die "No img supplied to _line()";
2492   my $style = delete $opts{style} || "solid";
2493
2494   if ($style eq "solid" || ($opts{x1} != $opts{x2} && $opts{y1} != $opts{y2})) {
2495     return $img->line(%opts);
2496   }
2497   elsif ($style eq 'dashed' || $style eq 'dotted') {
2498     my ($x1, $y1, $x2, $y2) = delete @opts{qw/x1 y1 x2 y2/};
2499     # the line is vertical or horizontal, so swapping doesn't hurt
2500     $x1 > $x2 and ($x1, $x2) = ($x2, $x1);
2501     $y1 > $y2 and ($y1, $y2) = ($y2, $y1);
2502     my ($stepx, $stepy) = ( 0, 0 );
2503     my $step_size = $style eq "dashed" ? 8 : 2;
2504     my ($counter, $count_end);
2505     if ($x1 == $x2) {
2506       $stepy = $step_size;
2507       ($counter, $count_end) = ($y1, $y2);
2508     }
2509     else {
2510       $stepx = $step_size;
2511       ($counter, $count_end) = ($x1, $x2);
2512     }
2513     my ($x, $y) = ($x1, $y1);
2514     while ($counter < $count_end) {
2515       if ($style eq "dotted") {
2516         $img->setpixel(x => $x, y => $y, color => $opts{color});
2517       }
2518       else {
2519         my $xe = $stepx ? $x + $stepx / 2 - 1 : $x;
2520         $xe > $x2 and $xe = $x2;
2521         my $ye = $stepy ? $y + $stepy / 2 - 1 : $y;
2522         $ye > $y2 and $ye = $y2;
2523         $img->line(x1 => $x, y1 => $y, x2 => $xe, y2 => $ye, %opts);
2524       }
2525       $counter += $step_size;
2526       $x += $stepx;
2527       $y += $stepy;
2528     }
2529
2530     return 1;
2531   }
2532   else {
2533     $self->_error("Unknown line style $style");
2534     return;
2535   }
2536 }
2537
2538 =item _box(xmin ..., style => $style)
2539
2540 A wrapper for drawing styled box outlines.
2541
2542 =cut
2543
2544 sub _box {
2545   my ($self, %opts) = @_;
2546
2547   my $style = delete $opts{style} || "solid";
2548   my $img = delete $opts{img}
2549     or die "No img supplied to _box";
2550
2551   if ($style eq "solid") {
2552     return $img->box(%opts);
2553   }
2554   else {
2555     my $box = delete $opts{box};
2556     # replicate Imager's defaults
2557     my %work_opts = ( xmin => 0, ymin => 0, xmax => $img->getwidth() - 1, ymax => $img->getheight() -1, %opts, style => $style, img => $img );
2558     my ($xmin, $ymin, $xmax, $ymax) = delete @work_opts{qw/xmin ymin xmax ymax/};
2559     if ($box) {
2560       ($xmin, $ymin, $xmax, $ymax) = @$box;
2561     }
2562     $xmin > $xmax and ($xmin, $xmax) = ($xmax, $xmin);
2563     $ymin > $ymax and ($ymin, $ymax) = ($ymax, $ymin);
2564
2565     if ($xmax - $xmin > 1) {
2566       $self->_line(x1 => $xmin+1, y1 => $ymin, x2 => $xmax-1, y2 => $ymin, %work_opts);
2567       $self->_line(x1 => $xmin+1, y1 => $ymax, x2 => $xmax-1, y2 => $ymax, %work_opts);
2568     }
2569     $self->_line(x1 => $xmin, y1 => $ymin, x2 => $xmin, y2 => $ymax, %work_opts);
2570     return $self->_line(x1 => $xmax, y1 => $ymin, x2 => $xmax, y2 => $ymax, %work_opts);
2571   }
2572 }
2573
2574 =item _feature_enabled($feature_name)
2575
2576 Check if the given feature is enabled in the work style.
2577
2578 =cut
2579
2580 sub _feature_enabled {
2581   my ($self, $name) = @_;
2582
2583   return $self->{_style}{features}{$name};
2584 }
2585
2586 sub _line_marker {
2587   my ($self, $index) = @_;
2588
2589   my $markers = $self->{'_style'}{'line_markers'};
2590   if (!$markers) {
2591     return;
2592   }
2593   my $marker = $markers->[$index % @$markers];
2594
2595   return $marker;
2596 }
2597
2598 sub _draw_line_marker {
2599   my $self = shift;
2600   my ($x1, $y1, $series_counter) = @_;
2601
2602   my $img = $self->_get_image();
2603
2604   my $style = $self->_line_marker($series_counter);
2605   return unless $style;
2606
2607   my $type = $style->{'shape'};
2608   my $radius = $style->{'radius'};
2609
2610   my $line_aa = $self->_get_number("lineaa");
2611   my $fill_aa = $self->_get_number("fill.aa");
2612
2613   if ($type eq 'circle') {
2614     my @fill = $self->_data_fill($series_counter, [$x1 - $radius, $y1 - $radius, $x1 + $radius, $y1 + $radius]);
2615     $img->circle(x => $x1, y => $y1, r => $radius, aa => $fill_aa, filled => 1, @fill);
2616   }
2617   elsif ($type eq 'open_circle') {
2618     my $color = $self->_data_color($series_counter);
2619     $img->circle(x => $x1, y => $y1, r => $radius, aa => $fill_aa, filled => 0, color => $color);
2620   }
2621   elsif ($type eq 'open_square') {
2622     my $color = $self->_data_color($series_counter);
2623     $img->box(xmin => $x1 - $radius, ymin => $y1 - $radius, xmax => $x1 + $radius, ymax => $y1 + $radius, filled => 0, color => $color);
2624   }
2625   elsif ($type eq 'open_triangle') {
2626     my $color = $self->_data_color($series_counter);
2627     $img->polyline(
2628         points => [
2629                     [$x1 - $radius, $y1 + $radius],
2630                     [$x1 + $radius, $y1 + $radius],
2631                     [$x1, $y1 - $radius],
2632                     [$x1 - $radius, $y1 + $radius],
2633                   ],
2634         color => $color, aa => $line_aa);
2635   }
2636   elsif ($type eq 'open_diamond') {
2637     my $color = $self->_data_color($series_counter);
2638     $img->polyline(
2639         points => [
2640                     [$x1 - $radius, $y1],
2641                     [$x1, $y1 + $radius],
2642                     [$x1 + $radius, $y1],
2643                     [$x1, $y1 - $radius],
2644                     [$x1 - $radius, $y1],
2645                   ],
2646                   color => $color, aa => $line_aa);
2647   }
2648   elsif ($type eq 'square') {
2649     my @fill = $self->_data_fill($series_counter, [$x1 - $radius, $y1 - $radius, $x1 + $radius, $y1 + $radius]);
2650     $img->box(xmin => $x1 - $radius, ymin => $y1 - $radius, xmax => $x1 + $radius, ymax => $y1 + $radius, @fill);
2651   }
2652   elsif ($type eq 'diamond') {
2653     # The gradient really doesn't work for diamond
2654     my $color = $self->_data_color($series_counter);
2655     $img->polygon(
2656         points => [
2657                     [$x1 - $radius, $y1],
2658                     [$x1, $y1 + $radius],
2659                     [$x1 + $radius, $y1],
2660                     [$x1, $y1 - $radius],
2661                   ],
2662         filled => 1, color => $color, aa => $fill_aa);
2663   }
2664   elsif ($type eq 'triangle') {
2665     # The gradient really doesn't work for triangle
2666     my $color = $self->_data_color($series_counter);
2667     $img->polygon(
2668         points => [
2669                     [$x1 - $radius, $y1 + $radius],
2670                     [$x1 + $radius, $y1 + $radius],
2671                     [$x1, $y1 - $radius],
2672                   ],
2673         filled => 1, color => $color, aa => $fill_aa);
2674
2675   }
2676   elsif ($type eq 'x') {
2677     my $color = $self->_data_color($series_counter);
2678     $img->line(x1 => $x1 - $radius, y1 => $y1 -$radius, x2 => $x1 + $radius, y2 => $y1+$radius, aa => $line_aa, color => $color) || die $img->errstr;
2679     $img->line(x1 => $x1 + $radius, y1 => $y1 -$radius, x2 => $x1 - $radius, y2 => $y1+$radius, aa => $line_aa, color => $color) || die $img->errstr;
2680   }
2681   elsif ($type eq 'plus') {
2682     my $color = $self->_data_color($series_counter);
2683     $img->line(x1 => $x1, y1 => $y1 -$radius, x2 => $x1, y2 => $y1+$radius, aa => $line_aa, color => $color) || die $img->errstr;
2684     $img->line(x1 => $x1 + $radius, y1 => $y1, x2 => $x1 - $radius, y2 => $y1, aa => $line_aa, color => $color) || die $img->errstr;
2685   }
2686 }
2687
2688 1;
2689
2690 __END__
2691
2692 =back
2693
2694 =head1 SEE ALSO
2695
2696 Imager::Graph::Pie(3), Imager(3), perl(1).
2697
2698 =head1 AUTHOR
2699
2700 Tony Cook <tony@develop-help.com>
2701
2702 =head1 LICENSE
2703
2704 Imager::Graph is licensed under the same terms as perl itself.
2705
2706 =head1 BLAME
2707
2708 Addi for producing a cool imaging module. :)
2709
2710 =cut