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