]> git.imager.perl.org - imager-graph.git/blame - Graph.pm
Adds two tests for horizontal graphs, and fixes some warnings exposed by them
[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
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
aac2cfef 32$VERSION = '0.07';
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
621various items that are displayed in the graph area. Some common
2eac77fc 622methods are:
623
624=over
625
626=item show_legend()
627
628adds a box containing boxes filled with the data filess, with
629the labels provided to the draw method. The legend will only be
630displayed if both the legend feature is enabled and labels are
631supplied.
632
633=cut
634
635sub show_legend {
636 $_[0]->{'custom_style'}->{'features'}->{'legend'} = 1;
637}
638
639=item show_outline()
640
641draws a border around the data areas.
642
643=cut
644
645sub show_outline {
646 $_[0]->{'custom_style'}->{'features'}->{'outline'} = 1;
647}
648
649=item show_labels()
650
651labels each data fill, usually by including text inside the data fill.
652If the text does not fit in the fill, they could be displayed in some
653other form, eg. as callouts in a pie graph. There usually isn't much
654point in including both labels and a legend.
655
656=cut
657
658sub show_labels {
659 $_[0]->{'custom_style'}->{'features'}->{'labels'} = 1;
660}
661
662=item show_drop_shadow()
663
664a simple drop shadow is shown behind some of the graph elements.
665
666=cut
667
668sub show_drop_shadow {
669 $_[0]->{'custom_style'}->{'features'}->{'dropshadow'} = 1;
670}
671
672=item reset_features()
673
674Unsets all of the features
675
676=cut
677
678sub reset_features {
679 $_[0]->{'custom_style'}->{'features'} = {};
680 $_[0]->{'custom_style'}->{'features'}->{'reset'} = 1;
681}
682
683=back
684
685Additionally, features can be set by passing them into the draw() method:
35574351
TC
686
687=over
688
689=item legend
690
691adds a box containing boxes filled with the data filess, with
692the labels provided to the draw method. The legend will only be
693displayed if both the legend feature is enabled and labels are
694supplied.
695
696=item labels
697
698labels each data fill, usually by including text inside the data fill.
699If the text does not fit in the fill, they could be displayed in some
700other form, eg. as callouts in a pie graph. There usually isn't much
701point in including both labels and a legend.
702
703=item dropshadow
704
705a simple drop shadow is shown behind some of the graph elements.
706
707=back
708
709Each graph also has features specific to that graph.
710
711=head1 COMMON PARAMETERS
712
713When referring to a single sub-value this documentation will refer to
714'title.color' rather than 'the color element of title'.
715
716Normally, except for the font parameter, these are controlled by
717styles, but these are the style parameters I'd mostly likely expect
718you want to use:
719
720=over
721
722=item font
723
724the Imager font object used to draw text on the chart.
725
726=item back
727
728the background fill for the graph. Default depends on the style.
729
730=item size
731
732the base size of the graph image. Default: 256
733
734=item width
735
736the width of the graph image. Default: 1.5 * size (384)
737
738=item height
739
740the height of the graph image. Default: size (256)
741
742=item channels
743
744the number of channels in the image. Default: 3 (the 'mono' style
745sets this to 1).
746
747=item line
748
749the color used for drawing lines, such as outlines or callouts.
750Default depends on the current style. Set to undef to remove the
751outline from a style.
752
753=item title
754
755the text used for a graph title. Default: no title. Note: this is
756the same as the title=>{ text => ... } field.
757
758=over
759
760=item halign
761
762horizontal alignment of the title in the graph, one of 'left',
763'center' or 'right'. Default: center
764
765=item valign
766
767vertical alignment of the title, one of 'top', 'center' or 'right'.
768Default: top. It's probably a bad idea to set this to 'center' unless
769you have a very short title.
770
771=back
772
773=item text
774
775This contains basic defaults used in drawing text.
776
777=over
778
779=item color
780
781the default color used for all text, defaults to the fg color.
782
783=item size
784
785the base size used for text, also used to scale many graph elements.
786Default: 14.
787
788=back
789
790=back
791
792=head1 BEYOND STYLES
793
794In most cases you will want to use just the styles, but you may want
795to exert more control over the way your chart looks. This section
796describes the options you can use to control the way your chart looks.
797
798Hopefully you don't need to read this.
799
800=over
801
802=item back
803
804The background of the graph.
805
806=item bg
807
808=item fg
809
810Used to define basic background and foreground colors for the graph.
811The bg color may be used for the background of the graph, and is used
812as a default for the background of hatcheed fills. The fg is used as
813the default for line and text colors.
814
815=item font
816
817The default font used by the graph. Normally you should supply this
818if your graph as any text.
819
820=item line
821
822The default line color.
823
824=item text
825
826defaults for drawing text. Other textual graph elements will inherit
827or modify these values.
828
829=over
830
831=item color
832
833default text color, defaults to the I<fg> color.
834
835=item size
836
837default text size. Default: 14. This is used to scale many graph
838elements, including padding and leader sizes. Other text elements
839will either use or scale this value.
840
841=item font
842
843default font object. Inherited from I<font>, which should have been
844supplied by the caller.
845
846=back
847
848=item title
849
850If you supply a scalar value for this element, it will be stored in
851the I<text> field.
852
853Defines the text, font and layout information for the title.
854
855=over
856
857=item color
858
859The color of the title, inherited from I<text.color>.
860
861=item font
862
863The font object used for the title, inherited from I<text.font>.
864
865=item size
866
867size of the title text. Default: double I<text.size>
868
869=item halign
870
871=item valign
872
873The horizontal and vertical alignment of the title.
874
875=back
876
877=item legend
878
879defines attributes of the graph legend, if present.
880
881=over
882
883=item color
884
885=item font
886
887=item size
888
889text attributes for the labels used in the legend.
890
891=item patchsize
892
893the width and height of the color patch in the legend. Defaults to
89490% of the legend text size.
895
896=item patchgap
897
898the minimum gap between patches in pixels. Defaults to 30% of the
899patchsize.
900
901=item patchborder
902
903the color of the border drawn around each patch. Inherited from I<line>.
904
905=item halign
906
907=item valign
908
909the horizontal and vertical alignment of the legend within the graph.
910Defaults to 'right' and 'top'.
911
912=item padding
913
914the gap between the legend patches and text and the outside of it's
915box, or to the legend border, if any.
916
917=item outsidepadding
918
919the gap between the border and the outside of the legend's box. This
920is only used if the I<legend.border> attribute is defined.
921
922=item fill
923
924the background fill for the legend. Default: none
925
926=item border
927
928the border color of the legend. Default: none (no border is drawn
929around the legend.)
930
33a928b7
TC
931=item orientation
932
933The orientation of the legend. If this is C<vertical> the the patches
934and labels are stacked on top of each other. If this is C<horizontal>
935the patchs and labels are word wrapped across the image. Default:
936vertical.
937
35574351
TC
938=back
939
33a928b7
TC
940For example to create a horizontal legend with borderless patches,
941darker than the background, you might do:
942
943 my $im = $chart->draw
944 (...,
945 legend =>
946 {
947 patchborder => undef,
948 orientation => 'horizontal',
949 fill => { solid => Imager::Color->new(0, 0, 0, 32), }
950 },
951 ...);
952
35574351
TC
953=item callout
954
955defines attributes for graph callouts, if any are present. eg. if the
956pie graph cannot fit the label into the pie graph segement it will
957present it as a callout.
958
959=over
960
961=item color
962
963=item font
964
965=item size
966
967the text attributes of the callout label. Inherited from I<text>.
968
969=item line
970
971the color of the callout lines. Inherited from I<line>
972
973=item inside
974
975=item outside
976
977the length of the leader on the inside and the outside of the fill,
978usually at some angle. Both default to the size of the callout text.
979
980=item leadlen
981
982the length of the horizontal portion of the leader. Default:
983I<callout.size>.
984
985=item gap
986
987the gap between the callout leader and the callout text. Defaults to
98830% of the text callout size.
989
990=back
991
992=item label
993
994defines attributes for labels drawn into the data areas of a graph.
995
996=over
997
998=item color
999
1000=item font
1001
1002=item size
1003
1004The text attributes of the labels. Inherited from I<text>.
1005
1006=back
1007
1008=item dropshadow
1009
1010the attributes of the graph's drop shadow
1011
1012=over
1013
1014=item fill
1015
1016the fill used for the drop shadow. Default: '404040' (dark gray)
1017
1018=item off
1019
1020the offset of the drop shadow. A convenience value inherited by offx
1021and offy. Default: 40% of I<text.size>.
1022
1023=item offx
1024
1025=item offy
1026
1027the horizontal and vertical offsets of the drop shadow. Both
1028inherited from I<dropshadow.off>.
1029
1030=item filter
1031
1032the filter description passed to Imager's filter method to blur the
1033drop shadow. Default: an 11 element convolution filter.
1034
1035=back
1036
1037=item outline
1038
1039describes the lines drawn around filled data areas, such as the
1040segments of a pie chart.
1041
1042=over
1043
1044=item line
1045
1046the line color of the outlines, inherited from I<line>.
1047
1048=back
1049
1050=item fills
1051
1052a reference to an array containing fills for each data item.
1053
1054You can mix fill types, ie. using a simple color for the first item, a
1055hatched fill for the second and a fountain fill for the next.
1056
1057=back
1058
1059=head1 HOW VALUES WORK
1060
1061Internally rather than specifying literal color, fill, or font objects
1062or literal sizes for each element, Imager::Graph uses a number of
1063special values to inherit or modify values taken from other graph
1064element names.
1065
1066=head2 Specifying colors
1067
1068You can specify colors by either supplying an Imager::Color object, by
1069supplying lookup of another color, or by supplying a single value that
1070Imager::Color::new can use as an initializer. The most obvious is
1071just a 6 or 8 digit hex value representing the red, green, blue and
1072optionally alpha channels of the image.
1073
1074You can lookup another color by using the lookup() "function", for
1075example if you give a color as "lookup(fg)" then Imager::Graph will
1076look for the fg element in the current style (or as overridden by
1077you.) This is used internally by Imager::Graph to set up the
1078relationships between the colors of various elements, for example the
1079default style information contains:
1080
1081 text=>{
d7fd5863 1082 color=>'lookup(fg)',
35574351
TC
1083 ...
1084 },
1085 legend =>{
d7fd5863 1086 color=>'lookup(text.color)',
35574351
TC
1087 ...
1088 },
1089
1090So by setting the I<fg> color, you also set the default text color,
1091since each text element uses lookup(text.color) as its value.
1092
1093=head2 Specifying fills
1094
1095Fills can be used for the graph background color, the background color
1096for the legend block and for the fills used for each data element.
1097
1098You can specify a fill as a L<color value|Specifying colors> or as a
33a928b7 1099general fill, see L<Imager::Fill> for details.
35574351
TC
1100
1101You don't need (or usually want) to call Imager::Fill::new yourself,
1102since the various fill functions will call it for you, and
1103Imager::Graph provides some hooks to make them more useful.
1104
1105=over
1106
1107=item *
1108
1109with hatched fills, if you don't supply a 'fg' or 'bg' parameter,
1110Imager::Graph will supply the current graph fg and bg colors.
1111
1112=item *
1113
1114with fountain fill, you can supply the xa_ratio, ya_ratio, xb_ratio
1115and yb_ratio parameters, and they will be scaled in the fill area to
1116define the fountain fills xa, ya, xb and yb parameters.
1117
1118=back
1119
1120As with colors, you can use lookup(name) or lookup(name1.name2) to
1121have one element to inherit the fill of another.
1122
33a928b7
TC
1123Imager::Graph defaults the fill combine value to C<'normal'>. This
1124doesn't apply to simple color fills.
1125
35574351
TC
1126=head2 Specifying numbers
1127
1128You can specify various numbers, usually representing the size of
1129something, commonly text, but sometimes the length of a line or the
1130size of a gap.
1131
1132You can use the same lookup mechanism as with colors and fills, but
1133you can also scale values. For example, 'scale(0.5,text.size)' will
1134return half the size of the normal text size.
1135
1136As with colors, this is used internally to scale graph elements based
1137on the base text size. If you change the base text size then other
1138graph elements will scale as well.
1139
1140=head2 Specifying other elements
1141
1142Other elements, such as fonts, or parameters for a filter, can also
1143use the lookup(name) mechanism.
1144
1145=head1 INTERNAL METHODS
1146
1147Only useful if you need to fix bugs, add features or create a new
1148graph class.
1149
1150=over
1151
1152=cut
1153
1154my %style_defs =
1155 (
1156 back=> 'lookup(bg)',
1157 line=> 'lookup(fg)',
49a35584 1158 aa => 1,
35574351 1159 text=>{
d7fd5863 1160 color => 'lookup(fg)',
35574351 1161 font => 'lookup(font)',
d7fd5863 1162 size => 14,
49a35584 1163 aa => 'lookup(aa)',
d7fd5863 1164 },
35574351 1165 title=>{
d7fd5863 1166 color => 'lookup(text.color)',
35574351 1167 font => 'lookup(text.font)',
d7fd5863
TC
1168 halign => 'center',
1169 valign => 'top',
1170 size => 'scale(text.size,2.0)',
49a35584 1171 aa => 'lookup(text.aa)',
d7fd5863 1172 },
35574351 1173 legend =>{
d7fd5863 1174 color => 'lookup(text.color)',
35574351 1175 font => 'lookup(text.font)',
49a35584 1176 aa => 'lookup(text.aa)',
d7fd5863
TC
1177 size => 'lookup(text.size)',
1178 patchsize => 'scale(legend.size,0.9)',
1179 patchgap => 'scale(legend.patchsize,0.3)',
1180 patchborder => 'lookup(line)',
1181 halign => 'right',
1182 valign => 'top',
1183 padding => 'scale(legend.size,0.3)',
1184 outsidepadding => 'scale(legend.padding,0.4)',
1185 },
35574351 1186 callout => {
d7fd5863 1187 color => 'lookup(text.color)',
35574351 1188 font => 'lookup(text.font)',
d7fd5863
TC
1189 size => 'lookup(text.size)',
1190 line => 'lookup(line)',
1191 inside => 'lookup(callout.size)',
1192 outside => 'lookup(callout.size)',
1193 leadlen => 'scale(0.8,callout.size)',
1194 gap => 'scale(callout.size,0.3)',
49a35584
TC
1195 aa => 'lookup(text.aa)',
1196 lineaa => 'lookup(lineaa)',
d7fd5863 1197 },
35574351
TC
1198 label => {
1199 font => 'lookup(text.font)',
d7fd5863
TC
1200 size => 'lookup(text.size)',
1201 color => 'lookup(text.color)',
35574351
TC
1202 hpad => 'lookup(label.pad)',
1203 vpad => 'lookup(label.pad)',
1204 pad => 'scale(label.size,0.2)',
1205 pcformat => sub { sprintf "%s (%.0f%%)", $_[0], $_[1] },
1206 pconlyformat => sub { sprintf "%.1f%%", $_[0] },
49a35584
TC
1207 aa => 'lookup(text.aa)',
1208 lineaa => 'lookup(lineaa)',
d7fd5863 1209 },
35574351 1210 dropshadow => {
320f5a49 1211 fill => { solid => Imager::Color->new(0, 0, 0, 96) },
35574351
TC
1212 off => 'scale(0.4,text.size)',
1213 offx => 'lookup(dropshadow.off)',
1214 offy => 'lookup(dropshadow.off)',
1215 filter => { type=>'conv',
1216 # this needs a fairly heavy blur
1217 coef=>[0.1, 0.2, 0.4, 0.6, 0.7, 0.9, 1.2,
1218 0.9, 0.7, 0.6, 0.4, 0.2, 0.1 ] },
1219 },
1220 outline => {
1221 line =>'lookup(line)',
49a35584 1222 lineaa => 'lookup(lineaa)',
35574351
TC
1223 },
1224 size=>256,
1225 width=>'scale(1.5,size)',
1226 height=>'lookup(size)',
49a35584
TC
1227
1228 # yes, the handling of fill and line AA is inconsistent, lack of
1229 # forethought, unfortunately
1230 fill => {
1231 aa => 'lookup(aa)',
1232 },
1233 lineaa => 'lookup(aa)',
35574351
TC
1234 );
1235
1236=item _error($message)
1237
1238Sets the error field of the object and returns an empty list or undef,
1239depending on context. Should be used for error handling, since it may
1240provide some user hooks at some point.
1241
f68db40f
TC
1242The intended usage is:
1243
1244 some action
1245 or return $self->_error("error description");
1246
1247You should almost always return the result of _error() or return
1248immediately afterwards.
1249
35574351
TC
1250=cut
1251
1252sub _error {
1253 my ($self, $error) = @_;
1254
1255 $self->{_errstr} = $error;
1256
1257 return;
1258}
1259
1260
1261=item _style_defs()
1262
1263Returns the style defaults, such as the relationships between line
1264color and text color.
1265
1266Intended to be over-ridden by base classes to provide graph specific
1267defaults.
1268
1269=cut
1270
1271sub _style_defs {
1272 \%style_defs;
1273}
1274
81453d28 1275# Let's make the default something that looks really good, so folks will be interested enough to customize the style.
1276my $def_style = 'fount_lin';
35574351
TC
1277
1278my %styles =
1279 (
7b94e723
TC
1280 primary =>
1281 {
1282 fills=>
1283 [
1284 qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF)
1285 ],
1286 fg=>'000000',
2eac77fc 1287 negative_bg=>'EEEEEE',
7b94e723
TC
1288 bg=>'E0E0E0',
1289 legend=>
1290 {
1291 #patchborder=>'000000'
1292 },
1293 },
35574351
TC
1294 primary_red =>
1295 {
1296 fills=>
1297 [
1298 qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF)
1299 ],
1300 fg=>'000000',
2eac77fc 1301 negative_bg=>'EEEEEE',
35574351
TC
1302 bg=>'C08080',
1303 legend=>
1304 {
1305 patchborder=>'000000'
1306 },
1307 },
1308 mono =>
1309 {
1310 fills=>
1311 [
1312 { hatch=>'slash2' },
1313 { hatch=>'slosh2' },
1314 { hatch=>'vline2' },
1315 { hatch=>'hline2' },
1316 { hatch=>'cross2' },
1317 { hatch=>'grid2' },
1318 { hatch=>'stipple3' },
1319 { hatch=>'stipple2' },
1320 ],
1321 channels=>1,
1322 bg=>'FFFFFF',
1323 fg=>'000000',
2eac77fc 1324 negative_bg=>'EEEEEE',
35574351
TC
1325 features=>{ outline=>1 },
1326 pie =>{
1327 blur=>undef,
1328 },
49a35584 1329 aa => 0,
35574351 1330 },
bb0de914 1331 fount_lin =>
35574351
TC
1332 {
1333 fills=>
1334 [
1335 { fountain=>'linear',
1336 xa_ratio=>0.13, ya_ratio=>0.13, xb_ratio=>0.87, yb_ratio=>0.87,
35574351 1337 segments => Imager::Fountain->simple(positions=>[0, 1],
d7fd5863 1338 colors=>[ NC('FFC0C0'), NC('FF0000') ]),
35574351
TC
1339 },
1340 { fountain=>'linear',
1341 xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1342 segments => Imager::Fountain->simple(positions=>[0, 1],
d7fd5863 1343 colors=>[ NC('C0FFC0'), NC('00FF00') ]),
35574351
TC
1344 },
1345 { fountain=>'linear',
1346 xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1347 segments => Imager::Fountain->simple(positions=>[0, 1],
d7fd5863 1348 colors=>[ NC('C0C0FF'), NC('0000FF') ]),
35574351
TC
1349 },
1350 { fountain=>'linear',
1351 xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1352 segments => Imager::Fountain->simple(positions=>[0, 1],
d7fd5863 1353 colors=>[ NC('FFFFC0'), NC('FFFF00') ]),
35574351
TC
1354 },
1355 { fountain=>'linear',
1356 xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1357 segments => Imager::Fountain->simple(positions=>[0, 1],
d7fd5863 1358 colors=>[ NC('C0FFFF'), NC('00FFFF') ]),
35574351
TC
1359 },
1360 { fountain=>'linear',
1361 xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1362 segments => Imager::Fountain->simple(positions=>[0, 1],
d7fd5863 1363 colors=>[ NC('FFC0FF'), NC('FF00FF') ]),
35574351
TC
1364 },
1365 ],
dfd889da 1366 colors => [
1367 qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF)
1368 ],
8e140388
TC
1369 line_markers =>[
1370 { shape => 'circle', radius => 4 },
1371 { shape => 'square', radius => 4 },
1372 { shape => 'diamond', radius => 4 },
1373 { shape => 'triangle', radius => 4 },
1374 { shape => 'x', radius => 4 },
1375 { shape => 'plus', radius => 4 },
1376 ],
35574351
TC
1377 back=>{ fountain=>'linear',
1378 xa_ratio=>0, ya_ratio=>0,
1379 xb_ratio=>1.0, yb_ratio=>1.0,
1380 segments=>Imager::Fountain->simple
1381 ( positions=>[0, 1],
1382 colors=>[ NC('6060FF'), NC('60FF60') ]) },
1383 fg=>'000000',
2eac77fc 1384 negative_bg=>'EEEEEE',
35574351
TC
1385 bg=>'FFFFFF',
1386 features=>{ dropshadow=>1 },
bb0de914
TC
1387 },
1388 fount_rad =>
1389 {
35574351
TC
1390 fills=>
1391 [
1392 { fountain=>'radial',
1393 xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
1394 segments => Imager::Fountain->simple(positions=>[0, 1],
d7fd5863 1395 colors=>[ NC('FF8080'), NC('FF0000') ]),
35574351
TC
1396 },
1397 { fountain=>'radial',
1398 xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
1399 segments => Imager::Fountain->simple(positions=>[0, 1],
d7fd5863 1400 colors=>[ NC('80FF80'), NC('00FF00') ]),
35574351
TC
1401 },
1402 { fountain=>'radial',
1403 xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
1404 segments => Imager::Fountain->simple(positions=>[0, 1],
d7fd5863 1405 colors=>[ NC('808080FF'), NC('0000FF') ]),
35574351
TC
1406 },
1407 { fountain=>'radial',
1408 xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
1409 segments => Imager::Fountain->simple(positions=>[0, 1],
d7fd5863 1410 colors=>[ NC('FFFF80'), NC('FFFF00') ]),
35574351
TC
1411 },
1412 { fountain=>'radial',
1413 xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
1414 segments => Imager::Fountain->simple(positions=>[0, 1],
d7fd5863 1415 colors=>[ NC('80FFFF'), NC('00FFFF') ]),
35574351
TC
1416 },
1417 { fountain=>'radial',
1418 xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
1419 segments => Imager::Fountain->simple(positions=>[0, 1],
d7fd5863 1420 colors=>[ NC('FF80FF'), NC('FF00FF') ]),
35574351
TC
1421 },
1422 ],
dfd889da 1423 colors => [
1424 qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF)
1425 ],
35574351
TC
1426 back=>{ fountain=>'linear',
1427 xa_ratio=>0, ya_ratio=>0,
1428 xb_ratio=>1.0, yb_ratio=>1.0,
1429 segments=>Imager::Fountain->simple
1430 ( positions=>[0, 1],
1431 colors=>[ NC('6060FF'), NC('60FF60') ]) },
1432 fg=>'000000',
2eac77fc 1433 negative_bg=>'EEEEEE',
35574351 1434 bg=>'FFFFFF',
bb0de914
TC
1435 }
1436 );
35574351 1437
2eac77fc 1438$styles{'ocean'} = {
1439 fills => [
1440 {
1441 fountain =>'linear',
1442 xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1443 segments => Imager::Fountain->simple(
1444 positions=>[0, 1],
7422650e 1445 colors=>[ NC('EFEDCF'), NC('E6E2AF') ]),
2eac77fc 1446 },
1447 {
1448 fountain =>'linear',
1449 xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1450 segments => Imager::Fountain->simple(
1451 positions=>[0, 1],
7422650e 1452 colors=>[ NC('DCD7AB'), NC('A7A37E') ]),
2eac77fc 1453 },
1454 {
1455 fountain =>'linear',
1456 xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1457 segments => Imager::Fountain->simple(
1458 positions=>[0, 1],
7422650e 1459 colors=>[ NC('B2E5D4'), NC('80B4A2') ]),
2eac77fc 1460 },
1461 {
1462 fountain =>'linear',
1463 xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1464 segments => Imager::Fountain->simple(
1465 positions=>[0, 1],
7422650e 1466 colors=>[ NC('7aaab9'), NC('046380') ]),
2eac77fc 1467 },
1468 {
1469 fountain =>'linear',
1470 xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1471 segments => Imager::Fountain->simple(
1472 positions=>[0, 1],
7422650e 1473 colors=>[ NC('c3b8e9'), NC('877EA7') ]),
2eac77fc 1474 },
1475 {
1476 fountain =>'linear',
1477 xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1478 segments => Imager::Fountain->simple(
1479 positions=>[0, 1],
7422650e 1480 colors=>[ NC('A3DF9A'), NC('67A35E') ]),
2eac77fc 1481 },
1482 {
1483 fountain =>'linear',
1484 xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1485 segments => Imager::Fountain->simple(
1486 positions=>[0, 1],
7422650e 1487 colors=>[ NC('E19C98'), NC('B4726F') ]),
2eac77fc 1488 },
1489 ],
1490 colors => [
1491 qw(E6E2AF A7A37E 80B4A2 046380 877EA7 67A35E B4726F)
1492 ],
1493 fg=>'000000',
1494 negative_bg=>'EEEEEE',
1495 bg=>'FFFFFF',
1496 features=>{ dropshadow=>1 },
1497
1498};
1499
7422650e 1500$styles{'ocean_flat'} = {
1501 fills=>
1502 [
1503 qw(E6E2AF A7A37E 80B4A2 046380 877EA7 67A35E B4726F)
1504 ],
1505 colors => [
1506 qw(E6E2AF A7A37E 80B4A2 046380 877EA7 67A35E B4726F)
1507 ],
1508 fg=>'000000',
1509 negative_bg=>'EEEEEE',
1510 bg=>'FFFFFF',
1511 features=>{ dropshadow=>1 },
1512
1513};
1514
1515
35574351
TC
1516=item $self->_style_setup(\%opts)
1517
1518Uses the values from %opts to build a customized hash describing the
1519way the graph should be drawn.
1520
1521=cut
1522
1523sub _style_setup {
1524 my ($self, $opts) = @_;
1525 my $style_defs = $self->_style_defs;
1526 my $style;
dfd889da 1527
2eac77fc 1528 my $pre_def_style = $self->_get_style($opts);
1529 my $api_style = $self->{'custom_style'} || {};
dfd889da 1530 $style = $styles{$pre_def_style} if $pre_def_style;
1531
35574351
TC
1532 $style ||= $styles{$def_style};
1533
2eac77fc 1534 my @search_list = ( $style_defs, $style, $api_style, $opts);
35574351
TC
1535 my %work;
1536
1537 my @composite = $self->_composite();
1538 my %composite;
1539 @composite{@composite} = @composite;
1540
1541 for my $src (@search_list) {
1542 for my $key (keys %$src) {
1543 if ($composite{$key}) {
1544 $work{$key} = {} unless exists $work{$key};
1545 if (ref $src->{$key}) {
1546 # some keys have sub values, especially text
1547 @{$work{$key}}{keys %{$src->{$key}}} = values %{$src->{$key}};
1548 }
1549 else {
1550 # assume it's the text for a title or something
1551 $work{$key}{text} = $src->{$key};
1552 }
1553 }
1554 else {
a17e870a
TC
1555 $work{$key} = $src->{$key}
1556 if defined $src->{$key}; # $opts with pmichauds new accessor handling
35574351
TC
1557 }
1558 }
1559 }
1560
1561 # features are handled specially
1562 $work{features} = {};
1563 for my $src (@search_list) {
1564 if ($src->{features}) {
1565 if (ref $src->{features}) {
1566 if (ref($src->{features}) =~ /ARRAY/) {
1567 # just set those features
1568 for my $feature (@{$src->{features}}) {
1569 $work{features}{$feature} = 1;
1570 }
1571 }
1572 elsif (ref($src->{features}) =~ /HASH/) {
1573 if ($src->{features}{reset}) {
1574 $work{features} = {}; # only the ones the user specifies
1575 }
1576 @{$work{features}}{keys %{$src->{features}}} =
1577 values(%{$src->{features}});
1578 }
1579 }
1580 else {
1581 # just set that single feature
1582 $work{features}{$src->{features}} = 1;
1583 }
1584 }
1585 }
1586 #use Data::Dumper;
1587 #print Dumper(\%work);
1588
1589 $self->{_style} = \%work;
1590}
1591
1592=item $self->_get_thing($name)
1593
1594Retrieve some general 'thing'.
1595
1596Supports the 'lookup(foo)' mechanism.
1597
f68db40f
TC
1598Returns an empty list on failure.
1599
35574351
TC
1600=cut
1601
1602sub _get_thing {
1603 my ($self, $name, @depth) = @_;
1604
1605 push(@depth, $name);
1606 my $what;
1607 if ($name =~ /^(\w+)\.(\w+)$/) {
1608 $what = $self->{_style}{$1}{$2};
1609 }
1610 else {
1611 $what = $self->{_style}{$name};
1612 }
1613 defined $what or
1614 return;
1615 if (ref $what) {
1616 return $what;
1617 }
1618 elsif ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) {
1619 @depth < MAX_DEPTH
1620 or return $self->_error("too many levels of recursion in lookup(@depth)");
1621 return $self->_get_thing($1, @depth);
1622 }
1623 else {
1624 return $what;
1625 }
1626}
1627
1628=item $self->_get_number($name)
1629
1630Retrieves a number from the style. The value in the style can be the
1631number, or one of two functions:
1632
1633=over
1634
1635=item lookup(newname)
1636
1637Recursively looks up I<newname> in the style.
1638
1639=item scale(value1,value2)
1640
33a928b7 1641Each value can be a number or a name. Names are recursively looked up
35574351
TC
1642in the style and the product is returned.
1643
1644=back
1645
1646=cut
bb0de914 1647
35574351
TC
1648sub _get_number {
1649 my ($self, $name, @depth) = @_;
1650
1651 push(@depth, $name);
1652 my $what;
1653 if ($name =~ /^(\w+)\.(\w+)$/) {
1654 $what = $self->{_style}{$1}{$2};
1655 }
1656 else {
1657 $what = $self->{_style}{$name};
1658 }
1659 defined $what or
1660 return $self->_error("$name is undef (@depth)");
1661
1662 if (ref $what) {
1663 if ($what =~ /CODE/) {
1664 $what = $what->($self, $name);
1665 }
1666 }
1667 else {
1668 if ($what =~ /^lookup\(([\w.]+)\)$/) {
1669 @depth < MAX_DEPTH
d7fd5863 1670 or return $self->_error("too many levels of recursion in lookup (@depth)");
35574351
TC
1671 return $self->_get_number($1, @depth);
1672 }
1673 elsif ($what =~ /^scale\(
d7fd5863 1674 ((?:[a-z][\w.]*)|$NUM_RE)
35574351 1675 ,
d7fd5863 1676 ((?:[a-z][\w.]*)|$NUM_RE)\)$/x) {
35574351
TC
1677 my ($left, $right) = ($1, $2);
1678 unless ($left =~ /^$NUM_RE$/) {
d7fd5863
TC
1679 @depth < MAX_DEPTH
1680 or return $self->_error("too many levels of recursion in scale (@depth)");
1681 $left = $self->_get_number($left, @depth);
35574351
TC
1682 }
1683 unless ($right =~ /^$NUM_RE$/) {
d7fd5863
TC
1684 @depth < MAX_DEPTH
1685 or return $self->_error("too many levels of recursion in scale (@depth)");
1686 $right = $self->_get_number($right, @depth);
35574351
TC
1687 }
1688 return $left * $right;
1689 }
1690 else {
1691 return $what+0;
1692 }
1693 }
1694}
1695
379c5b02
TC
1696=item $self->_get_integer($name)
1697
1698Retrieves an integer from the style. This is a simple wrapper around
1699_get_number() that rounds the result to an integer.
1700
f68db40f
TC
1701Returns an empty list on failure.
1702
379c5b02
TC
1703=cut
1704
1705sub _get_integer {
1706 my ($self, $name, @depth) = @_;
1707
1708 my $number = $self->_get_number($name, @depth)
1709 or return;
1710
1711 return sprintf("%.0f", $number);
1712}
1713
35574351
TC
1714=item _get_color($name)
1715
1716Returns a color object of the given name from the style hash.
1717
1718Uses Imager::Color->new to translate normal scalars into color objects.
1719
1720Allows the lookup(name) mechanism.
1721
f68db40f
TC
1722Returns an empty list on failure.
1723
35574351
TC
1724=cut
1725
1726sub _get_color {
1727 my ($self, $name, @depth) = @_;
1728
1729 push(@depth, $name);
1730 my $what;
1731 if ($name =~ /^(\w+)\.(\w+)$/) {
1732 $what = $self->{_style}{$1}{$2};
1733 }
1734 else {
1735 $what = $self->{_style}{$name};
1736 }
1737
1738 defined($what)
1739 or return $self->_error("$name was undefined (@depth)");
1740
1741 unless (ref $what) {
1742 if ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) {
1743 @depth < MAX_DEPTH or
d7fd5863 1744 return $self->_error("too many levels of recursion in lookup (@depth)");
35574351
TC
1745
1746 return $self->_get_color($1, @depth);
1747 }
1748 $what = Imager::Color->new($what);
1749 }
1750
1751 $what;
1752}
1753
1754=item _translate_fill($what, $box)
1755
1756Given the value of a fill, either attempts to convert it into a fill
1757list (one of C<<color=>$color_value, filled=>1>> or C<<fill=>{ fill
1758parameters }>>), or to lookup another fill that is referred to with
1759the 'lookup(name)' mechanism.
1760
1761This function does the fg and bg initialization for hatched fills, and
1762translation of *_ratio for fountain fills (using the $box parameter).
1763
f68db40f
TC
1764Returns an empty list on failure.
1765
35574351
TC
1766=cut
1767
1768sub _translate_fill {
1769 my ($self, $what, $box, @depth) = @_;
1770
1771 if (ref $what) {
1772 if (UNIVERSAL::isa($what, "Imager::Color")) {
1773 return ( color=>Imager::Color->new($what), filled=>1 );
1774 }
1775 else {
1776 # a general fill
33a928b7
TC
1777 # default to normal combine mode
1778 my %work = ( combine => 'normal', %$what );
35574351 1779 if ($what->{hatch}) {
d7fd5863
TC
1780 if (!$work{fg}) {
1781 $work{fg} = $self->_get_color('fg')
1782 or return;
1783 }
1784 if (!$work{bg}) {
1785 $work{bg} = $self->_get_color('bg')
1786 or return;
1787 }
1788 return ( fill=>\%work );
35574351
TC
1789 }
1790 elsif ($what->{fountain}) {
d7fd5863
TC
1791 for my $key (qw(xa ya xb yb)) {
1792 if (exists $work{"${key}_ratio"}) {
1793 if ($key =~ /^x/) {
1794 $work{$key} = $box->[0] + $work{"${key}_ratio"}
1795 * ($box->[2] - $box->[0]);
1796 }
1797 else {
1798 $work{$key} = $box->[1] + $work{"${key}_ratio"}
1799 * ($box->[3] - $box->[1]);
1800 }
1801 }
1802 }
1803 return ( fill=>\%work );
35574351
TC
1804 }
1805 else {
d7fd5863 1806 return ( fill=> \%work );
35574351
TC
1807 }
1808 }
1809 }
1810 else {
1811 if ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) {
1812 return $self->_get_fill($1, $box, @depth);
1813 }
1814 else {
1815 # assumed to be an Imager::Color single value
1816 return ( color=>Imager::Color->new($what), filled=>1 );
1817 }
1818 }
1819}
1820
1821=item _data_fill($index, $box)
1822
1823Retrieves the fill parameters for a data area fill.
1824
1825=cut
1826
1827sub _data_fill {
1828 my ($self, $index, $box) = @_;
1829
1830 my $fills = $self->{_style}{fills};
1831 return $self->_translate_fill($fills->[$index % @$fills], $box,
1832 "data.$index");
1833}
1834
dfd889da 1835sub _data_color {
1836 my ($self, $index) = @_;
1837
1838 my $colors = $self->{'_style'}{'colors'} || [];
1839 my $fills = $self->{'_style'}{'fills'} || [];
1840
1841 # Try to just use a fill, so non-fountain styles don't need
1842 # to have a duplicated set of fills and colors
1843 my $fill = $fills->[$index % @$fills];
1844 if (!ref $fill) {
1845 return $fill;
1846 }
1847
1848 if (@$colors) {
1849 return $colors->[$index % @$colors] || '000000';
1850 }
1851 return '000000';
1852}
1853
35574351
TC
1854=item _get_fill($index, $box)
1855
1856Retrieves fill parameters for a named fill.
1857
1858=cut
1859
1860sub _get_fill {
1861 my ($self, $name, $box, @depth) = @_;
1862
1863 push(@depth, $name);
1864 my $what;
1865 if ($name =~ /^(\w+)\.(\w+)$/) {
1866 $what = $self->{_style}{$1}{$2};
1867 }
1868 else {
1869 $what = $self->{_style}{$name};
1870 }
1871
1872 defined($what)
1873 or return $self->_error("no fill $name found");
1874
1875 return $self->_translate_fill($what, $box, @depth);
1876}
1877
1878=item _make_img()
1879
1880Builds the image object for the graph and fills it with the background
1881fill.
1882
1883=cut
1884
1885sub _make_img {
1886 my ($self) = @_;
35574351 1887
81453d28 1888 my $width = $self->_get_number('width') || 256;
1889 my $height = $self->_get_number('height') || 256;
35574351
TC
1890 my $channels = $self->{_style}{channels};
1891
1892 $channels ||= 3;
1893
1894 my $img = Imager->new(xsize=>$width, ysize=>$height, channels=>$channels);
1895
1896 $img->box($self->_get_fill('back', [ 0, 0, $width-1, $height-1]));
1897
1898 $img;
1899}
1900
2eac77fc 1901sub _get_image {
1902 my $self = shift;
1903
1904 if (!$self->{'_image'}) {
1905 $self->{'_image'} = $self->_make_img();
1906 }
1907 return $self->{'_image'};
1908}
1909
f68db40f
TC
1910=item _text_style($name)
1911
1912Returns parameters suitable for calls to Imager::Font's bounding_box()
1913and draw() methods intended for use in defining text styles.
1914
1915Returns an empty list on failure.
1916
49a35584
TC
1917Returns the following attributes: font, color, size, aa, sizew
1918(optionally)
1919
f68db40f
TC
1920=cut
1921
35574351
TC
1922sub _text_style {
1923 my ($self, $name) = @_;
1924
1925 my %work;
1926
1927 if ($self->{_style}{$name}) {
1928 %work = %{$self->{_style}{$name}};
1929 }
1930 else {
1931 %work = %{$self->{_style}{text}};
1932 }
1933 $work{font}
5d622bb8 1934 or return $self->_error("$name has no font parameter");
35574351
TC
1935
1936 $work{font} = $self->_get_thing("$name.font")
5d622bb8 1937 or return $self->_error("No $name.font defined, either set $name.font or font to a font");
35574351
TC
1938 UNIVERSAL::isa($work{font}, "Imager::Font")
1939 or return $self->_error("$name.font is not a font");
1940 if ($work{color} && !ref $work{color}) {
1941 $work{color} = $self->_get_color("$name.color")
1942 or return;
1943 }
1944 $work{size} = $self->_get_number("$name.size");
1945 $work{sizew} = $self->_get_number("$name.sizew")
1946 if $work{sizew};
49a35584 1947 $work{aa} = $self->_get_number("$name.aa");
35574351
TC
1948
1949 %work;
1950}
1951
f68db40f
TC
1952=item _text_bbox($text, $name)
1953
1954Returns a bounding box for the specified $text as styled by $name.
1955
1956Returns an empty list on failure.
1957
1958=cut
1959
35574351
TC
1960sub _text_bbox {
1961 my ($self, $text, $name) = @_;
1962
5d622bb8
TC
1963 my %text_info = $self->_text_style($name)
1964 or return;
35574351
TC
1965
1966 my @bbox = $text_info{font}->bounding_box(%text_info, string=>$text,
d7fd5863 1967 canon=>1);
35574351
TC
1968
1969 return @bbox[0..3];
1970}
1971
49a35584
TC
1972=item _line_style($name)
1973
1974Return parameters suitable for calls to Imager's line(), polyline(),
1975and box() methods.
1976
1977For now this returns only color and aa parameters, but future releases
1978of Imager may support extra parameters.
1979
1980=cut
1981
1982sub _line_style {
1983 my ($self, $name) = @_;
1984
1985 my %line;
1986 $line{color} = $self->_get_color("$name.line")
1987 or return;
1988 $line{aa} = $self->_get_number("$name.lineaa");
1989 defined $line{aa} or $line{aa} = $self->_get_number("aa");
1990
1991 return %line;
1992}
1993
35574351
TC
1994sub _align_box {
1995 my ($self, $box, $chart_box, $name) = @_;
1996
1997 my $halign = $self->{_style}{$name}{halign}
1998 or $self->_error("no halign for $name");
1999 my $valign = $self->{_style}{$name}{valign};
2000
2001 if ($halign eq 'right') {
2002 $box->[0] += $chart_box->[2] - $box->[2];
2003 }
2004 elsif ($halign eq 'left') {
2005 $box->[0] = $chart_box->[0];
2006 }
2007 elsif ($halign eq 'center' || $halign eq 'centre') {
2008 $box->[0] = ($chart_box->[0] + $chart_box->[2] - $box->[2])/2;
2009 }
2010 else {
2011 return $self->_error("invalid halign $halign for $name");
2012 }
2013
2014 if ($valign eq 'top') {
2015 $box->[1] = $chart_box->[1];
2016 }
2017 elsif ($valign eq 'bottom') {
2018 $box->[1] = $chart_box->[3] - $box->[3];
2019 }
2020 elsif ($valign eq 'center' || $valign eq 'centre') {
2021 $box->[1] = ($chart_box->[1] + $chart_box->[3] - $box->[3])/2;
2022 }
2023 else {
2024 return $self->_error("invalid valign $valign for $name");
2025 }
2026 $box->[2] += $box->[0];
2027 $box->[3] += $box->[1];
2028}
2029
2030sub _remove_box {
2031 my ($self, $chart_box, $object_box) = @_;
2032
2033 my $areax;
2034 my $areay;
2035 if ($object_box->[0] - $chart_box->[0]
2036 < $chart_box->[2] - $object_box->[2]) {
2037 $areax = ($object_box->[2] - $chart_box->[0])
2038 * ($chart_box->[3] - $chart_box->[1]);
2039 }
2040 else {
2041 $areax = ($chart_box->[2] - $object_box->[0])
2042 * ($chart_box->[3] - $chart_box->[1]);
2043 }
2044
2045 if ($object_box->[1] - $chart_box->[1]
2046 < $chart_box->[3] - $object_box->[3]) {
2047 $areay = ($object_box->[3] - $chart_box->[1])
2048 * ($chart_box->[2] - $chart_box->[0]);
2049 }
2050 else {
2051 $areay = ($chart_box->[3] - $object_box->[1])
2052 * ($chart_box->[2] - $chart_box->[0]);
2053 }
2054
2055 if ($areay < $areax) {
2056 if ($object_box->[1] - $chart_box->[1]
d7fd5863 2057 < $chart_box->[3] - $object_box->[3]) {
35574351
TC
2058 $chart_box->[1] = $object_box->[3];
2059 }
2060 else {
2061 $chart_box->[3] = $object_box->[1];
2062 }
2063 }
2064 else {
2065 if ($object_box->[0] - $chart_box->[0]
d7fd5863 2066 < $chart_box->[2] - $object_box->[2]) {
35574351
TC
2067 $chart_box->[0] = $object_box->[2];
2068 }
2069 else {
2070 $chart_box->[2] = $object_box->[0];
2071 }
2072 }
2073}
2074
2075sub _draw_legend {
2076 my ($self, $img, $labels, $chart_box) = @_;
2077
33a928b7
TC
2078 my $orient = $self->_get_thing('legend.orientation');
2079 defined $orient or $orient = 'vertical';
2080
2081 if ($orient eq 'vertical') {
2082 return $self->_draw_legend_vertical($img, $labels, $chart_box);
2083 }
2084 elsif ($orient eq 'horizontal') {
2085 return $self->_draw_legend_horizontal($img, $labels, $chart_box);
2086 }
2087 else {
2088 return $self->_error("Unknown legend.orientation $orient");
2089 }
2090}
2091
2092sub _draw_legend_horizontal {
2093 my ($self, $img, $labels, $chart_box) = @_;
2094
2095 defined(my $padding = $self->_get_integer('legend.padding'))
2096 or return;
2097 my $patchsize = $self->_get_integer('legend.patchsize')
2098 or return;
2099 defined(my $gap = $self->_get_integer('legend.patchgap'))
2100 or return;
2101
2102 my $minrowsize = $patchsize + $gap;
2103 my ($width, $height) = (0,0);
2104 my $row_height = $minrowsize;
2105 my $pos = 0;
2106 my @sizes;
2107 my @offsets;
2108 for my $label (@$labels) {
5d622bb8
TC
2109 my @text_box = $self->_text_bbox($label, 'legend')
2110 or return;
33a928b7
TC
2111 push(@sizes, \@text_box);
2112 my $entry_width = $patchsize + $gap + $text_box[2];
2113 if ($pos == 0) {
2114 # never re-wrap the first entry
2115 push @offsets, [ 0, $height ];
2116 }
2117 else {
2118 if ($pos + $gap + $entry_width > $chart_box->[2]) {
d7fd5863
TC
2119 $pos = 0;
2120 $height += $row_height;
33a928b7
TC
2121 }
2122 push @offsets, [ $pos, $height ];
2123 }
2124 my $entry_right = $pos + $entry_width;
2125 $pos += $gap + $entry_width;
2126 $entry_right > $width and $width = $entry_right;
2127 if ($text_box[3] > $row_height) {
2128 $row_height = $text_box[3];
2129 }
2130 }
2131 $height += $row_height;
2132 my @box = ( 0, 0, $width + $padding * 2, $height + $padding * 2 );
2133 my $outsidepadding = 0;
2134 if ($self->{_style}{legend}{border}) {
2135 defined($outsidepadding = $self->_get_integer('legend.outsidepadding'))
2136 or return;
2137 $box[2] += 2 * $outsidepadding;
2138 $box[3] += 2 * $outsidepadding;
2139 }
2140 $self->_align_box(\@box, $chart_box, 'legend')
2141 or return;
2142 if ($self->{_style}{legend}{fill}) {
2143 $img->box(xmin=>$box[0]+$outsidepadding,
2144 ymin=>$box[1]+$outsidepadding,
2145 xmax=>$box[2]-$outsidepadding,
2146 ymax=>$box[3]-$outsidepadding,
d7fd5863 2147 $self->_get_fill('legend.fill', \@box));
33a928b7
TC
2148 }
2149 $box[0] += $outsidepadding;
2150 $box[1] += $outsidepadding;
2151 $box[2] -= $outsidepadding;
2152 $box[3] -= $outsidepadding;
2153 my %text_info = $self->_text_style('legend')
2154 or return;
2155 my $patchborder;
2156 if ($self->{_style}{legend}{patchborder}) {
2157 $patchborder = $self->_get_color('legend.patchborder')
2158 or return;
2159 }
2160
2161 my $dataindex = 0;
2162 for my $label (@$labels) {
2163 my ($left, $top) = @{$offsets[$dataindex]};
2164 $left += $box[0] + $padding;
2165 $top += $box[1] + $padding;
2166 my $textpos = $left + $patchsize + $gap;
2167 my @patchbox = ( $left, $top,
2168 $left + $patchsize, $top + $patchsize );
2169 my @fill = $self->_data_fill($dataindex, \@patchbox)
2170 or return;
2171 $img->box(xmin=>$left, ymin=>$top, xmax=>$left + $patchsize,
d7fd5863 2172 ymax=>$top + $patchsize, @fill);
33a928b7
TC
2173 if ($self->{_style}{legend}{patchborder}) {
2174 $img->box(xmin=>$left, ymin=>$top, xmax=>$left + $patchsize,
d7fd5863
TC
2175 ymax=>$top + $patchsize,
2176 color=>$patchborder);
33a928b7
TC
2177 }
2178 $img->string(%text_info, x=>$textpos, 'y'=>$top + $patchsize,
2179 text=>$label);
2180
2181 ++$dataindex;
2182 }
2183 if ($self->{_style}{legend}{border}) {
2184 my $border_color = $self->_get_color('legend.border')
2185 or return;
2186 $img->box(xmin=>$box[0], ymin=>$box[1], xmax=>$box[2], ymax=>$box[3],
d7fd5863 2187 color=>$border_color);
33a928b7
TC
2188 }
2189 $self->_remove_box($chart_box, \@box);
2190 1;
2191}
2192
2193sub _draw_legend_vertical {
2194 my ($self, $img, $labels, $chart_box) = @_;
2195
379c5b02 2196 defined(my $padding = $self->_get_integer('legend.padding'))
35574351 2197 or return;
379c5b02 2198 my $patchsize = $self->_get_integer('legend.patchsize')
35574351 2199 or return;
379c5b02 2200 defined(my $gap = $self->_get_integer('legend.patchgap'))
35574351
TC
2201 or return;
2202 my $minrowsize = $patchsize + $gap;
2203 my ($width, $height) = (0,0);
2204 my @sizes;
2205 for my $label (@$labels) {
5d622bb8
TC
2206 my @box = $self->_text_bbox($label, 'legend')
2207 or return;
35574351
TC
2208 push(@sizes, \@box);
2209 $width = $box[2] if $box[2] > $width;
2210 if ($minrowsize > $box[3]) {
2211 $height += $minrowsize;
2212 }
2213 else {
2214 $height += $box[3];
2215 }
2216 }
2217 my @box = (0, 0,
d7fd5863
TC
2218 $width + $patchsize + $padding * 2 + $gap,
2219 $height + $padding * 2 - $gap);
35574351
TC
2220 my $outsidepadding = 0;
2221 if ($self->{_style}{legend}{border}) {
33a928b7 2222 defined($outsidepadding = $self->_get_integer('legend.outsidepadding'))
35574351
TC
2223 or return;
2224 $box[2] += 2 * $outsidepadding;
2225 $box[3] += 2 * $outsidepadding;
2226 }
2227 $self->_align_box(\@box, $chart_box, 'legend')
2228 or return;
2229 if ($self->{_style}{legend}{fill}) {
2230 $img->box(xmin=>$box[0]+$outsidepadding,
2231 ymin=>$box[1]+$outsidepadding,
2232 xmax=>$box[2]-$outsidepadding,
2233 ymax=>$box[3]-$outsidepadding,
d7fd5863 2234 $self->_get_fill('legend.fill', \@box));
35574351
TC
2235 }
2236 $box[0] += $outsidepadding;
2237 $box[1] += $outsidepadding;
2238 $box[2] -= $outsidepadding;
2239 $box[3] -= $outsidepadding;
2240 my $ypos = $box[1] + $padding;
2241 my $patchpos = $box[0]+$padding;
2242 my $textpos = $patchpos + $patchsize + $gap;
2243 my %text_info = $self->_text_style('legend')
2244 or return;
2245 my $patchborder;
2246 if ($self->{_style}{legend}{patchborder}) {
2247 $patchborder = $self->_get_color('legend.patchborder')
2248 or return;
2249 }
2250 my $dataindex = 0;
2251 for my $label (@$labels) {
2252 my @patchbox = ( $patchpos - $patchsize/2, $ypos - $patchsize/2,
2253 $patchpos + $patchsize * 3 / 2, $ypos + $patchsize*3/2 );
2eac77fc 2254
2255 my @fill;
2256 if ($self->_draw_flat_legend()) {
2257 @fill = (color => $self->_data_color($dataindex), filled => 1);
2258 }
2259 else {
2260 @fill = $self->_data_fill($dataindex, \@patchbox)
2261 or return;
2262 }
35574351 2263 $img->box(xmin=>$patchpos, ymin=>$ypos, xmax=>$patchpos + $patchsize,
d7fd5863 2264 ymax=>$ypos + $patchsize, @fill);
35574351
TC
2265 if ($self->{_style}{legend}{patchborder}) {
2266 $img->box(xmin=>$patchpos, ymin=>$ypos, xmax=>$patchpos + $patchsize,
d7fd5863
TC
2267 ymax=>$ypos + $patchsize,
2268 color=>$patchborder);
35574351
TC
2269 }
2270 $img->string(%text_info, x=>$textpos, 'y'=>$ypos + $patchsize,
2271 text=>$label);
2272
2273 my $step = $patchsize + $gap;
2274 if ($minrowsize < $sizes[$dataindex][3]) {
2275 $ypos += $sizes[$dataindex][3];
2276 }
2277 else {
2278 $ypos += $minrowsize;
2279 }
2280 ++$dataindex;
2281 }
2282 if ($self->{_style}{legend}{border}) {
2283 my $border_color = $self->_get_color('legend.border')
2284 or return;
2285 $img->box(xmin=>$box[0], ymin=>$box[1], xmax=>$box[2], ymax=>$box[3],
d7fd5863 2286 color=>$border_color);
35574351
TC
2287 }
2288 $self->_remove_box($chart_box, \@box);
2289 1;
2290}
2291
2292sub _draw_title {
2293 my ($self, $img, $chart_box) = @_;
2294
2295 my $title = $self->{_style}{title}{text};
5d622bb8
TC
2296 my @box = $self->_text_bbox($title, 'title')
2297 or return;
35574351
TC
2298 my $yoff = $box[1];
2299 @box[0,1] = (0,0);
2300 $self->_align_box(\@box, $chart_box, 'title');
5d622bb8
TC
2301 my %text_info = $self->_text_style('title')
2302 or return;
35574351
TC
2303 $img->string(%text_info, x=>$box[0], 'y'=>$box[3] + $yoff, text=>$title);
2304 $self->_remove_box($chart_box, \@box);
2305 1;
2306}
2307
2308sub _small_extent {
2309 my ($self, $box) = @_;
2310
2311 if ($box->[2] - $box->[0] > $box->[3] - $box->[1]) {
2312 return $box->[3] - $box->[1];
2313 }
2314 else {
2315 return $box->[2] - $box->[0];
2316 }
2317}
2318
2eac77fc 2319sub _draw_flat_legend {
2320 return 0;
2321}
2322
35574351
TC
2323=item _composite()
2324
2325Returns a list of style fields that are stored as composites, and
2326should be merged instead of just being replaced.
2327
2328=cut
2329
2330sub _composite {
2331 qw(title legend text label dropshadow outline callout);
2332}
2333
2334sub _filter_region {
2335 my ($self, $img, $left, $top, $right, $bottom, $filter) = @_;
2336
2337 unless (ref $filter) {
2338 my $name = $filter;
2339 $filter = $self->_get_thing($name)
2340 or return;
2341 $filter->{type}
2342 or return $self->_error("no type for filter $name");
2343 }
2344
2345 $left > 0 or $left = 0;
2346 $top > 0 or $top = 0;
2347
2348 # newer versions of Imager let you work on just part of an image
2349 if ($img->can('masked') && !$self->{_style}{features}{_debugblur}) {
2350 my $masked = $img->masked(left=>$left, top=>$top,
2351 right=>$right, bottom=>$bottom);
2352 $masked->filter(%$filter);
2353 }
2354 else {
2355 # for older versions of Imager
2356 my $subset = $img->crop(left=>$left, top=>$top,
2357 right=>$right, bottom=>$bottom);
2358 $subset->filter(%$filter);
2359 $img->paste(left=>$left, top=>$top, img=>$subset);
2360 }
2361}
2362
23631;
2364__END__
2365
2366=back
2367
2368=head1 SEE ALSO
2369
2370Imager::Graph::Pie(3), Imager(3), perl(1).
2371
2372=head1 AUTHOR
2373
2374Tony Cook <tony@develop-help.com>
2375
54ada35d
TC
2376=head1 LICENSE
2377
2378Imager::Graph is licensed under the same terms as perl itself.
2379
35574351
TC
2380=head1 BLAME
2381
2382Addi for producing a cool imaging module. :)
2383
2384=cut