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