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