remove more ancient Imager cruft
[imager-graph.git] / Graph.pm
CommitLineData
35574351 1package Imager::Graph;
54ada35d 2require 5.005;
35574351
TC
3
4=head1 NAME
5
6Imager::Graph - Perl extension for producing Graphs using the Imager library.
7
8=head1 SYNOPSIS
9
10 use Imager::Graph::SubClass;
11 my $chart = Imager::Graph::SubClass->new;
12 my $img = $chart->draw(data=>..., ...)
13 or die $chart->error;
14
15=head1 DESCRIPTION
16
17Imager::Graph provides style information to its base classes. It
18defines the colors, text display information and fills based on both
19built-in styles and modifications supplied by the user to the draw()
20method.
21
35574351
TC
22=over
23
24=cut
25
26use strict;
27use vars qw($VERSION);
28use Imager qw(:handy);
bb0de914 29use Imager::Fountain;
35574351 30
f041f3f9 31$VERSION = '0.05';
35574351 32
35574351
TC
33# the maximum recursion depth in determining a color, fill or number
34use constant MAX_DEPTH => 10;
35
36my $NUM_RE = '(?:[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:[eE][+-]\d+?)?)';
37
38=item new
39
40This is a simple constructor. No parameters required.
41
42=cut
43
44sub new {
45 bless {}, $_[0];
46}
47
48=item error
49
50Returns an error message. Only value if the draw() method returns false.
51
52=cut
53
54sub error {
55 $_[0]->{_errstr};
56}
57
58=item draw
59
60Creates a new image, draws the chart onto that image and returns it.
61
62Typically you will need to supply a C<data> parameter in the format
63required by that particular graph, and if your graph will use any
64text, a C<font> parameter
65
66You can also supply many different parameters which control the way
67the graph looks. These are supplied as keyword, value pairs, where
68the value can be a hashref containing sub values.
69
70The C<style> parameter will selects a basic color set, and possibly
71sets other related parameters. See L</"STYLES">.
72
73 my $img = $graph->draw(data=>\@data,
74 title=>{ text=>"Hello, World!",
75 size=>36,
76 color=>'FF0000' });
77
78When referring to a single sub-value this documentation will refer to
79'title.color' rather than 'the color element of title'.
80
81Returns the graph image on success, or false on failure.
82
83=back
84
85=head1 STYLES
86
87The currently defined styles are:
88
89=over
90
91=item primary_red
92
93a light red background with no outlines. Uses primary colors for the
94data fills. This style is compatible with all versions of Imager.
95
96Graphs drawn using this style should save well as a gif, even though
97some graphs may perform a slight blur.
98
99This is the default style.
100
101=item mono
102
103designed for monochrome output, such as most laser printers, this uses
104hatched fills for the data, and no colors. The returned image is a
105one channel image (which can be overridden with the C<channels>
106parameter.)
107
108You can also override the colors used by all components for background
109or drawing by supplying C<fg> and/or C<bg> parameters. ie. if you
110supply C<<fg=>'FF0000', channels=>3>> then the hash fills and anything
111else will be drawn in red. Another use might be to set a transparent
112background, by supplying C<<bg=>'00000000', channels=>4>>.
113
114This style outlines the legend if present and outlines the hashed fills.
115
116This and following styles require versions of Imager after 0.38.
117
118=item fount_lin
119
120designed as a "pretty" style this uses linear fountain fills for the
121background and data fills, and adds a drop shadow.
122
123You can override the value used for text and outlines by setting the
124C<fg> parameter.
125
126=item fount_rad
127
128also designed as a "pretty" style this uses radial fountain fills for
129the data and a linear blue to green fill for the background.
130
131=back
132
133=head1 FEATURES
134
135Each graph type has a number of features. These are used to add
136various items that are displayed in the graph area. Some common
137features are:
138
139=over
140
141=item legend
142
143adds a box containing boxes filled with the data filess, with
144the labels provided to the draw method. The legend will only be
145displayed if both the legend feature is enabled and labels are
146supplied.
147
148=item labels
149
150labels each data fill, usually by including text inside the data fill.
151If the text does not fit in the fill, they could be displayed in some
152other form, eg. as callouts in a pie graph. There usually isn't much
153point in including both labels and a legend.
154
155=item dropshadow
156
157a simple drop shadow is shown behind some of the graph elements.
158
159=back
160
161Each graph also has features specific to that graph.
162
163=head1 COMMON PARAMETERS
164
165When referring to a single sub-value this documentation will refer to
166'title.color' rather than 'the color element of title'.
167
168Normally, except for the font parameter, these are controlled by
169styles, but these are the style parameters I'd mostly likely expect
170you want to use:
171
172=over
173
174=item font
175
176the Imager font object used to draw text on the chart.
177
178=item back
179
180the background fill for the graph. Default depends on the style.
181
182=item size
183
184the base size of the graph image. Default: 256
185
186=item width
187
188the width of the graph image. Default: 1.5 * size (384)
189
190=item height
191
192the height of the graph image. Default: size (256)
193
194=item channels
195
196the number of channels in the image. Default: 3 (the 'mono' style
197sets this to 1).
198
199=item line
200
201the color used for drawing lines, such as outlines or callouts.
202Default depends on the current style. Set to undef to remove the
203outline from a style.
204
205=item title
206
207the text used for a graph title. Default: no title. Note: this is
208the same as the title=>{ text => ... } field.
209
210=over
211
212=item halign
213
214horizontal alignment of the title in the graph, one of 'left',
215'center' or 'right'. Default: center
216
217=item valign
218
219vertical alignment of the title, one of 'top', 'center' or 'right'.
220Default: top. It's probably a bad idea to set this to 'center' unless
221you have a very short title.
222
223=back
224
225=item text
226
227This contains basic defaults used in drawing text.
228
229=over
230
231=item color
232
233the default color used for all text, defaults to the fg color.
234
235=item size
236
237the base size used for text, also used to scale many graph elements.
238Default: 14.
239
240=back
241
242=back
243
244=head1 BEYOND STYLES
245
246In most cases you will want to use just the styles, but you may want
247to exert more control over the way your chart looks. This section
248describes the options you can use to control the way your chart looks.
249
250Hopefully you don't need to read this.
251
252=over
253
254=item back
255
256The background of the graph.
257
258=item bg
259
260=item fg
261
262Used to define basic background and foreground colors for the graph.
263The bg color may be used for the background of the graph, and is used
264as a default for the background of hatcheed fills. The fg is used as
265the default for line and text colors.
266
267=item font
268
269The default font used by the graph. Normally you should supply this
270if your graph as any text.
271
272=item line
273
274The default line color.
275
276=item text
277
278defaults for drawing text. Other textual graph elements will inherit
279or modify these values.
280
281=over
282
283=item color
284
285default text color, defaults to the I<fg> color.
286
287=item size
288
289default text size. Default: 14. This is used to scale many graph
290elements, including padding and leader sizes. Other text elements
291will either use or scale this value.
292
293=item font
294
295default font object. Inherited from I<font>, which should have been
296supplied by the caller.
297
298=back
299
300=item title
301
302If you supply a scalar value for this element, it will be stored in
303the I<text> field.
304
305Defines the text, font and layout information for the title.
306
307=over
308
309=item color
310
311The color of the title, inherited from I<text.color>.
312
313=item font
314
315The font object used for the title, inherited from I<text.font>.
316
317=item size
318
319size of the title text. Default: double I<text.size>
320
321=item halign
322
323=item valign
324
325The horizontal and vertical alignment of the title.
326
327=back
328
329=item legend
330
331defines attributes of the graph legend, if present.
332
333=over
334
335=item color
336
337=item font
338
339=item size
340
341text attributes for the labels used in the legend.
342
343=item patchsize
344
345the width and height of the color patch in the legend. Defaults to
34690% of the legend text size.
347
348=item patchgap
349
350the minimum gap between patches in pixels. Defaults to 30% of the
351patchsize.
352
353=item patchborder
354
355the color of the border drawn around each patch. Inherited from I<line>.
356
357=item halign
358
359=item valign
360
361the horizontal and vertical alignment of the legend within the graph.
362Defaults to 'right' and 'top'.
363
364=item padding
365
366the gap between the legend patches and text and the outside of it's
367box, or to the legend border, if any.
368
369=item outsidepadding
370
371the gap between the border and the outside of the legend's box. This
372is only used if the I<legend.border> attribute is defined.
373
374=item fill
375
376the background fill for the legend. Default: none
377
378=item border
379
380the border color of the legend. Default: none (no border is drawn
381around the legend.)
382
383=back
384
385=item callout
386
387defines attributes for graph callouts, if any are present. eg. if the
388pie graph cannot fit the label into the pie graph segement it will
389present it as a callout.
390
391=over
392
393=item color
394
395=item font
396
397=item size
398
399the text attributes of the callout label. Inherited from I<text>.
400
401=item line
402
403the color of the callout lines. Inherited from I<line>
404
405=item inside
406
407=item outside
408
409the length of the leader on the inside and the outside of the fill,
410usually at some angle. Both default to the size of the callout text.
411
412=item leadlen
413
414the length of the horizontal portion of the leader. Default:
415I<callout.size>.
416
417=item gap
418
419the gap between the callout leader and the callout text. Defaults to
42030% of the text callout size.
421
422=back
423
424=item label
425
426defines attributes for labels drawn into the data areas of a graph.
427
428=over
429
430=item color
431
432=item font
433
434=item size
435
436The text attributes of the labels. Inherited from I<text>.
437
438=back
439
440=item dropshadow
441
442the attributes of the graph's drop shadow
443
444=over
445
446=item fill
447
448the fill used for the drop shadow. Default: '404040' (dark gray)
449
450=item off
451
452the offset of the drop shadow. A convenience value inherited by offx
453and offy. Default: 40% of I<text.size>.
454
455=item offx
456
457=item offy
458
459the horizontal and vertical offsets of the drop shadow. Both
460inherited from I<dropshadow.off>.
461
462=item filter
463
464the filter description passed to Imager's filter method to blur the
465drop shadow. Default: an 11 element convolution filter.
466
467=back
468
469=item outline
470
471describes the lines drawn around filled data areas, such as the
472segments of a pie chart.
473
474=over
475
476=item line
477
478the line color of the outlines, inherited from I<line>.
479
480=back
481
482=item fills
483
484a reference to an array containing fills for each data item.
485
486You can mix fill types, ie. using a simple color for the first item, a
487hatched fill for the second and a fountain fill for the next.
488
489=back
490
491=head1 HOW VALUES WORK
492
493Internally rather than specifying literal color, fill, or font objects
494or literal sizes for each element, Imager::Graph uses a number of
495special values to inherit or modify values taken from other graph
496element names.
497
498=head2 Specifying colors
499
500You can specify colors by either supplying an Imager::Color object, by
501supplying lookup of another color, or by supplying a single value that
502Imager::Color::new can use as an initializer. The most obvious is
503just a 6 or 8 digit hex value representing the red, green, blue and
504optionally alpha channels of the image.
505
506You can lookup another color by using the lookup() "function", for
507example if you give a color as "lookup(fg)" then Imager::Graph will
508look for the fg element in the current style (or as overridden by
509you.) This is used internally by Imager::Graph to set up the
510relationships between the colors of various elements, for example the
511default style information contains:
512
513 text=>{
514 color=>'lookup(fg)',
515 ...
516 },
517 legend =>{
518 color=>'lookup(text.color)',
519 ...
520 },
521
522So by setting the I<fg> color, you also set the default text color,
523since each text element uses lookup(text.color) as its value.
524
525=head2 Specifying fills
526
527Fills can be used for the graph background color, the background color
528for the legend block and for the fills used for each data element.
529
530You can specify a fill as a L<color value|Specifying colors> or as a
531general fill, see L<Imager::Fill> for details. To use a general fill
532you need a version of Imager after 0.38.
533
534You don't need (or usually want) to call Imager::Fill::new yourself,
535since the various fill functions will call it for you, and
536Imager::Graph provides some hooks to make them more useful.
537
538=over
539
540=item *
541
542with hatched fills, if you don't supply a 'fg' or 'bg' parameter,
543Imager::Graph will supply the current graph fg and bg colors.
544
545=item *
546
547with fountain fill, you can supply the xa_ratio, ya_ratio, xb_ratio
548and yb_ratio parameters, and they will be scaled in the fill area to
549define the fountain fills xa, ya, xb and yb parameters.
550
551=back
552
553As with colors, you can use lookup(name) or lookup(name1.name2) to
554have one element to inherit the fill of another.
555
556=head2 Specifying numbers
557
558You can specify various numbers, usually representing the size of
559something, commonly text, but sometimes the length of a line or the
560size of a gap.
561
562You can use the same lookup mechanism as with colors and fills, but
563you can also scale values. For example, 'scale(0.5,text.size)' will
564return half the size of the normal text size.
565
566As with colors, this is used internally to scale graph elements based
567on the base text size. If you change the base text size then other
568graph elements will scale as well.
569
570=head2 Specifying other elements
571
572Other elements, such as fonts, or parameters for a filter, can also
573use the lookup(name) mechanism.
574
575=head1 INTERNAL METHODS
576
577Only useful if you need to fix bugs, add features or create a new
578graph class.
579
580=over
581
582=cut
583
584my %style_defs =
585 (
586 back=> 'lookup(bg)',
587 line=> 'lookup(fg)',
588 text=>{
589 color => 'lookup(fg)',
590 font => 'lookup(font)',
591 size => 14,
592 },
593 title=>{
594 color => 'lookup(text.color)',
595 font => 'lookup(text.font)',
596 halign => 'center',
597 valign => 'top',
598 size => 'scale(text.size,2.0)',
599 },
600 legend =>{
601 color => 'lookup(text.color)',
602 font => 'lookup(text.font)',
603 size => 'lookup(text.size)',
604 patchsize => 'scale(legend.size,0.9)',
605 patchgap => 'scale(legend.patchsize,0.3)',
606 patchborder => 'lookup(line)',
607 halign => 'right',
608 valign => 'top',
609 padding => 'scale(legend.size,0.3)',
610 outsidepadding => 'scale(legend.padding,0.4)',
611 },
612 callout => {
613 color => 'lookup(text.color)',
614 font => 'lookup(text.font)',
615 size => 'lookup(text.size)',
616 line => 'lookup(line)',
617 inside => 'lookup(callout.size)',
618 outside => 'lookup(callout.size)',
619 leadlen => 'scale(0.8,callout.size)',
620 gap => 'scale(callout.size,0.3)',
621 },
622 label => {
623 font => 'lookup(text.font)',
624 size => 'lookup(text.size)',
625 color => 'lookup(text.color)',
626 hpad => 'lookup(label.pad)',
627 vpad => 'lookup(label.pad)',
628 pad => 'scale(label.size,0.2)',
629 pcformat => sub { sprintf "%s (%.0f%%)", $_[0], $_[1] },
630 pconlyformat => sub { sprintf "%.1f%%", $_[0] },
631 },
632 dropshadow => {
633 fill => '404040',
634 off => 'scale(0.4,text.size)',
635 offx => 'lookup(dropshadow.off)',
636 offy => 'lookup(dropshadow.off)',
637 filter => { type=>'conv',
638 # this needs a fairly heavy blur
639 coef=>[0.1, 0.2, 0.4, 0.6, 0.7, 0.9, 1.2,
640 0.9, 0.7, 0.6, 0.4, 0.2, 0.1 ] },
641 },
642 outline => {
643 line =>'lookup(line)',
644 },
645 size=>256,
646 width=>'scale(1.5,size)',
647 height=>'lookup(size)',
648 );
649
650=item _error($message)
651
652Sets the error field of the object and returns an empty list or undef,
653depending on context. Should be used for error handling, since it may
654provide some user hooks at some point.
655
656=cut
657
658sub _error {
659 my ($self, $error) = @_;
660
661 $self->{_errstr} = $error;
662
663 return;
664}
665
666
667=item _style_defs()
668
669Returns the style defaults, such as the relationships between line
670color and text color.
671
672Intended to be over-ridden by base classes to provide graph specific
673defaults.
674
675=cut
676
677sub _style_defs {
678 \%style_defs;
679}
680
681my $def_style = 'primary_red';
682
683my %styles =
684 (
685 primary_red =>
686 {
687 fills=>
688 [
689 qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF)
690 ],
691 fg=>'000000',
692 bg=>'C08080',
693 legend=>
694 {
695 patchborder=>'000000'
696 },
697 },
698 mono =>
699 {
700 fills=>
701 [
702 { hatch=>'slash2' },
703 { hatch=>'slosh2' },
704 { hatch=>'vline2' },
705 { hatch=>'hline2' },
706 { hatch=>'cross2' },
707 { hatch=>'grid2' },
708 { hatch=>'stipple3' },
709 { hatch=>'stipple2' },
710 ],
711 channels=>1,
712 bg=>'FFFFFF',
713 fg=>'000000',
714 features=>{ outline=>1 },
715 pie =>{
716 blur=>undef,
717 },
718 },
bb0de914 719 fount_lin =>
35574351
TC
720 {
721 fills=>
722 [
723 { fountain=>'linear',
724 xa_ratio=>0.13, ya_ratio=>0.13, xb_ratio=>0.87, yb_ratio=>0.87,
725 repeat=>'sawtooth',
726 segments => Imager::Fountain->simple(positions=>[0, 1],
727 colors=>[ NC('FFC0C0'), NC('FF0000') ]),
728 },
729 { fountain=>'linear',
730 xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
731 segments => Imager::Fountain->simple(positions=>[0, 1],
732 colors=>[ NC('C0FFC0'), NC('00FF00') ]),
733 },
734 { fountain=>'linear',
735 xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
736 segments => Imager::Fountain->simple(positions=>[0, 1],
737 colors=>[ NC('C0C0FF'), NC('0000FF') ]),
738 },
739 { fountain=>'linear',
740 xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
741 segments => Imager::Fountain->simple(positions=>[0, 1],
742 colors=>[ NC('FFFFC0'), NC('FFFF00') ]),
743 },
744 { fountain=>'linear',
745 xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
746 segments => Imager::Fountain->simple(positions=>[0, 1],
747 colors=>[ NC('C0FFFF'), NC('00FFFF') ]),
748 },
749 { fountain=>'linear',
750 xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
751 segments => Imager::Fountain->simple(positions=>[0, 1],
752 colors=>[ NC('FFC0FF'), NC('FF00FF') ]),
753 },
754 ],
755 back=>{ fountain=>'linear',
756 xa_ratio=>0, ya_ratio=>0,
757 xb_ratio=>1.0, yb_ratio=>1.0,
758 segments=>Imager::Fountain->simple
759 ( positions=>[0, 1],
760 colors=>[ NC('6060FF'), NC('60FF60') ]) },
761 fg=>'000000',
762 bg=>'FFFFFF',
763 features=>{ dropshadow=>1 },
bb0de914
TC
764 },
765 fount_rad =>
766 {
35574351
TC
767 fills=>
768 [
769 { fountain=>'radial',
770 xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
771 segments => Imager::Fountain->simple(positions=>[0, 1],
772 colors=>[ NC('FF8080'), NC('FF0000') ]),
773 },
774 { fountain=>'radial',
775 xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
776 segments => Imager::Fountain->simple(positions=>[0, 1],
777 colors=>[ NC('80FF80'), NC('00FF00') ]),
778 },
779 { fountain=>'radial',
780 xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
781 segments => Imager::Fountain->simple(positions=>[0, 1],
782 colors=>[ NC('808080FF'), NC('0000FF') ]),
783 },
784 { fountain=>'radial',
785 xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
786 segments => Imager::Fountain->simple(positions=>[0, 1],
787 colors=>[ NC('FFFF80'), NC('FFFF00') ]),
788 },
789 { fountain=>'radial',
790 xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
791 segments => Imager::Fountain->simple(positions=>[0, 1],
792 colors=>[ NC('80FFFF'), NC('00FFFF') ]),
793 },
794 { fountain=>'radial',
795 xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
796 segments => Imager::Fountain->simple(positions=>[0, 1],
797 colors=>[ NC('FF80FF'), NC('FF00FF') ]),
798 },
799 ],
800 back=>{ fountain=>'linear',
801 xa_ratio=>0, ya_ratio=>0,
802 xb_ratio=>1.0, yb_ratio=>1.0,
803 segments=>Imager::Fountain->simple
804 ( positions=>[0, 1],
805 colors=>[ NC('6060FF'), NC('60FF60') ]) },
806 fg=>'000000',
807 bg=>'FFFFFF',
bb0de914
TC
808 }
809 );
35574351
TC
810
811=item $self->_style_setup(\%opts)
812
813Uses the values from %opts to build a customized hash describing the
814way the graph should be drawn.
815
816=cut
817
818sub _style_setup {
819 my ($self, $opts) = @_;
820 my $style_defs = $self->_style_defs;
821 my $style;
822 $style = $styles{$opts->{style}} if $opts->{style};
823 $style ||= $styles{$def_style};
824
825 my @search_list = ( $style_defs, $style, $opts);
826 my %work;
827
828 my @composite = $self->_composite();
829 my %composite;
830 @composite{@composite} = @composite;
831
832 for my $src (@search_list) {
833 for my $key (keys %$src) {
834 if ($composite{$key}) {
835 $work{$key} = {} unless exists $work{$key};
836 if (ref $src->{$key}) {
837 # some keys have sub values, especially text
838 @{$work{$key}}{keys %{$src->{$key}}} = values %{$src->{$key}};
839 }
840 else {
841 # assume it's the text for a title or something
842 $work{$key}{text} = $src->{$key};
843 }
844 }
845 else {
846 $work{$key} = $src->{$key};
847 }
848 }
849 }
850
851 # features are handled specially
852 $work{features} = {};
853 for my $src (@search_list) {
854 if ($src->{features}) {
855 if (ref $src->{features}) {
856 if (ref($src->{features}) =~ /ARRAY/) {
857 # just set those features
858 for my $feature (@{$src->{features}}) {
859 $work{features}{$feature} = 1;
860 }
861 }
862 elsif (ref($src->{features}) =~ /HASH/) {
863 if ($src->{features}{reset}) {
864 $work{features} = {}; # only the ones the user specifies
865 }
866 @{$work{features}}{keys %{$src->{features}}} =
867 values(%{$src->{features}});
868 }
869 }
870 else {
871 # just set that single feature
872 $work{features}{$src->{features}} = 1;
873 }
874 }
875 }
876 #use Data::Dumper;
877 #print Dumper(\%work);
878
879 $self->{_style} = \%work;
880}
881
882=item $self->_get_thing($name)
883
884Retrieve some general 'thing'.
885
886Supports the 'lookup(foo)' mechanism.
887
888=cut
889
890sub _get_thing {
891 my ($self, $name, @depth) = @_;
892
893 push(@depth, $name);
894 my $what;
895 if ($name =~ /^(\w+)\.(\w+)$/) {
896 $what = $self->{_style}{$1}{$2};
897 }
898 else {
899 $what = $self->{_style}{$name};
900 }
901 defined $what or
902 return;
903 if (ref $what) {
904 return $what;
905 }
906 elsif ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) {
907 @depth < MAX_DEPTH
908 or return $self->_error("too many levels of recursion in lookup(@depth)");
909 return $self->_get_thing($1, @depth);
910 }
911 else {
912 return $what;
913 }
914}
915
916=item $self->_get_number($name)
917
918Retrieves a number from the style. The value in the style can be the
919number, or one of two functions:
920
921=over
922
923=item lookup(newname)
924
925Recursively looks up I<newname> in the style.
926
927=item scale(value1,value2)
928
929Each value can be a number or a name. Names are recursively looks up
930in the style and the product is returned.
931
932=back
933
934=cut
bb0de914 935
35574351
TC
936sub _get_number {
937 my ($self, $name, @depth) = @_;
938
939 push(@depth, $name);
940 my $what;
941 if ($name =~ /^(\w+)\.(\w+)$/) {
942 $what = $self->{_style}{$1}{$2};
943 }
944 else {
945 $what = $self->{_style}{$name};
946 }
947 defined $what or
948 return $self->_error("$name is undef (@depth)");
949
950 if (ref $what) {
951 if ($what =~ /CODE/) {
952 $what = $what->($self, $name);
953 }
954 }
955 else {
956 if ($what =~ /^lookup\(([\w.]+)\)$/) {
957 @depth < MAX_DEPTH
958 or return $self->_error("too many levels of recursion in lookup (@depth)");
959 return $self->_get_number($1, @depth);
960 }
961 elsif ($what =~ /^scale\(
962 ((?:[a-z][\w.]*)|$NUM_RE)
963 ,
964 ((?:[a-z][\w.]*)|$NUM_RE)\)$/x) {
965 my ($left, $right) = ($1, $2);
966 unless ($left =~ /^$NUM_RE$/) {
967 @depth < MAX_DEPTH
968 or return $self->_error("too many levels of recursion in scale (@depth)");
969 $left = $self->_get_number($left, @depth);
970 }
971 unless ($right =~ /^$NUM_RE$/) {
972 @depth < MAX_DEPTH
973 or return $self->_error("too many levels of recursion in scale (@depth)");
974 $right = $self->_get_number($right, @depth);
975 }
976 return $left * $right;
977 }
978 else {
979 return $what+0;
980 }
981 }
982}
983
984=item _get_color($name)
985
986Returns a color object of the given name from the style hash.
987
988Uses Imager::Color->new to translate normal scalars into color objects.
989
990Allows the lookup(name) mechanism.
991
992=cut
993
994sub _get_color {
995 my ($self, $name, @depth) = @_;
996
997 push(@depth, $name);
998 my $what;
999 if ($name =~ /^(\w+)\.(\w+)$/) {
1000 $what = $self->{_style}{$1}{$2};
1001 }
1002 else {
1003 $what = $self->{_style}{$name};
1004 }
1005
1006 defined($what)
1007 or return $self->_error("$name was undefined (@depth)");
1008
1009 unless (ref $what) {
1010 if ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) {
1011 @depth < MAX_DEPTH or
1012 return $self->_error("too many levels of recursion in lookup (@depth)");
1013
1014 return $self->_get_color($1, @depth);
1015 }
1016 $what = Imager::Color->new($what);
1017 }
1018
1019 $what;
1020}
1021
1022=item _translate_fill($what, $box)
1023
1024Given the value of a fill, either attempts to convert it into a fill
1025list (one of C<<color=>$color_value, filled=>1>> or C<<fill=>{ fill
1026parameters }>>), or to lookup another fill that is referred to with
1027the 'lookup(name)' mechanism.
1028
1029This function does the fg and bg initialization for hatched fills, and
1030translation of *_ratio for fountain fills (using the $box parameter).
1031
1032=cut
1033
1034sub _translate_fill {
1035 my ($self, $what, $box, @depth) = @_;
1036
1037 if (ref $what) {
1038 if (UNIVERSAL::isa($what, "Imager::Color")) {
1039 return ( color=>Imager::Color->new($what), filled=>1 );
1040 }
1041 else {
1042 # a general fill
1043 if ($what->{hatch}) {
1044 my %work = %$what;
1045 if (!$work{fg}) {
1046 $work{fg} = $self->_get_color('fg')
1047 or return;
1048 }
1049 if (!$work{bg}) {
1050 $work{bg} = $self->_get_color('bg')
1051 or return;
1052 }
1053 return ( fill=>\%work );
1054 }
1055 elsif ($what->{fountain}) {
1056 my %work = %$what;
1057 for my $key (qw(xa ya xb yb)) {
1058 if (exists $work{"${key}_ratio"}) {
1059 if ($key =~ /^x/) {
1060 $work{$key} = $box->[0] + $work{"${key}_ratio"}
1061 * ($box->[2] - $box->[0]);
1062 }
1063 else {
1064 $work{$key} = $box->[1] + $work{"${key}_ratio"}
1065 * ($box->[3] - $box->[1]);
1066 }
1067 }
1068 }
1069 return ( fill=>\%work );
1070 }
1071 else {
1072 return ( fill=> $what );
1073 }
1074 }
1075 }
1076 else {
1077 if ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) {
1078 return $self->_get_fill($1, $box, @depth);
1079 }
1080 else {
1081 # assumed to be an Imager::Color single value
1082 return ( color=>Imager::Color->new($what), filled=>1 );
1083 }
1084 }
1085}
1086
1087=item _data_fill($index, $box)
1088
1089Retrieves the fill parameters for a data area fill.
1090
1091=cut
1092
1093sub _data_fill {
1094 my ($self, $index, $box) = @_;
1095
1096 my $fills = $self->{_style}{fills};
1097 return $self->_translate_fill($fills->[$index % @$fills], $box,
1098 "data.$index");
1099}
1100
1101=item _get_fill($index, $box)
1102
1103Retrieves fill parameters for a named fill.
1104
1105=cut
1106
1107sub _get_fill {
1108 my ($self, $name, $box, @depth) = @_;
1109
1110 push(@depth, $name);
1111 my $what;
1112 if ($name =~ /^(\w+)\.(\w+)$/) {
1113 $what = $self->{_style}{$1}{$2};
1114 }
1115 else {
1116 $what = $self->{_style}{$name};
1117 }
1118
1119 defined($what)
1120 or return $self->_error("no fill $name found");
1121
1122 return $self->_translate_fill($what, $box, @depth);
1123}
1124
1125=item _make_img()
1126
1127Builds the image object for the graph and fills it with the background
1128fill.
1129
1130=cut
1131
1132sub _make_img {
1133 my ($self) = @_;
1134
1135 my ($width, $height) = (256, 256);
1136
1137 $width = $self->_get_number('width');
1138 $height = $self->_get_number('height');
1139 my $channels = $self->{_style}{channels};
1140
1141 $channels ||= 3;
1142
1143 my $img = Imager->new(xsize=>$width, ysize=>$height, channels=>$channels);
1144
1145 $img->box($self->_get_fill('back', [ 0, 0, $width-1, $height-1]));
1146
1147 $img;
1148}
1149
1150sub _text_style {
1151 my ($self, $name) = @_;
1152
1153 my %work;
1154
1155 if ($self->{_style}{$name}) {
1156 %work = %{$self->{_style}{$name}};
1157 }
1158 else {
1159 %work = %{$self->{_style}{text}};
1160 }
1161 $work{font}
1162 or return $self->_error("$name has no font parameter");
1163
1164 $work{font} = $self->_get_thing("$name.font")
1165 or return $self->_error("invalid font");
1166 UNIVERSAL::isa($work{font}, "Imager::Font")
1167 or return $self->_error("$name.font is not a font");
1168 if ($work{color} && !ref $work{color}) {
1169 $work{color} = $self->_get_color("$name.color")
1170 or return;
1171 }
1172 $work{size} = $self->_get_number("$name.size");
1173 $work{sizew} = $self->_get_number("$name.sizew")
1174 if $work{sizew};
1175
1176 %work;
1177}
1178
1179sub _text_bbox {
1180 my ($self, $text, $name) = @_;
1181
1182 my %text_info = $self->_text_style($name);
1183
1184 my @bbox = $text_info{font}->bounding_box(%text_info, string=>$text,
1185 canon=>1);
1186
1187 return @bbox[0..3];
1188}
1189
1190sub _align_box {
1191 my ($self, $box, $chart_box, $name) = @_;
1192
1193 my $halign = $self->{_style}{$name}{halign}
1194 or $self->_error("no halign for $name");
1195 my $valign = $self->{_style}{$name}{valign};
1196
1197 if ($halign eq 'right') {
1198 $box->[0] += $chart_box->[2] - $box->[2];
1199 }
1200 elsif ($halign eq 'left') {
1201 $box->[0] = $chart_box->[0];
1202 }
1203 elsif ($halign eq 'center' || $halign eq 'centre') {
1204 $box->[0] = ($chart_box->[0] + $chart_box->[2] - $box->[2])/2;
1205 }
1206 else {
1207 return $self->_error("invalid halign $halign for $name");
1208 }
1209
1210 if ($valign eq 'top') {
1211 $box->[1] = $chart_box->[1];
1212 }
1213 elsif ($valign eq 'bottom') {
1214 $box->[1] = $chart_box->[3] - $box->[3];
1215 }
1216 elsif ($valign eq 'center' || $valign eq 'centre') {
1217 $box->[1] = ($chart_box->[1] + $chart_box->[3] - $box->[3])/2;
1218 }
1219 else {
1220 return $self->_error("invalid valign $valign for $name");
1221 }
1222 $box->[2] += $box->[0];
1223 $box->[3] += $box->[1];
1224}
1225
1226sub _remove_box {
1227 my ($self, $chart_box, $object_box) = @_;
1228
1229 my $areax;
1230 my $areay;
1231 if ($object_box->[0] - $chart_box->[0]
1232 < $chart_box->[2] - $object_box->[2]) {
1233 $areax = ($object_box->[2] - $chart_box->[0])
1234 * ($chart_box->[3] - $chart_box->[1]);
1235 }
1236 else {
1237 $areax = ($chart_box->[2] - $object_box->[0])
1238 * ($chart_box->[3] - $chart_box->[1]);
1239 }
1240
1241 if ($object_box->[1] - $chart_box->[1]
1242 < $chart_box->[3] - $object_box->[3]) {
1243 $areay = ($object_box->[3] - $chart_box->[1])
1244 * ($chart_box->[2] - $chart_box->[0]);
1245 }
1246 else {
1247 $areay = ($chart_box->[3] - $object_box->[1])
1248 * ($chart_box->[2] - $chart_box->[0]);
1249 }
1250
1251 if ($areay < $areax) {
1252 if ($object_box->[1] - $chart_box->[1]
1253 < $chart_box->[3] - $object_box->[3]) {
1254 $chart_box->[1] = $object_box->[3];
1255 }
1256 else {
1257 $chart_box->[3] = $object_box->[1];
1258 }
1259 }
1260 else {
1261 if ($object_box->[0] - $chart_box->[0]
1262 < $chart_box->[2] - $object_box->[2]) {
1263 $chart_box->[0] = $object_box->[2];
1264 }
1265 else {
1266 $chart_box->[2] = $object_box->[0];
1267 }
1268 }
1269}
1270
1271sub _draw_legend {
1272 my ($self, $img, $labels, $chart_box) = @_;
1273
1274 defined(my $padding = $self->_get_number('legend.padding'))
1275 or return;
1276 my $patchsize = $self->_get_number('legend.patchsize')
1277 or return;
1278 defined(my $gap = $self->_get_number('legend.patchgap'))
1279 or return;
1280 my $minrowsize = $patchsize + $gap;
1281 my ($width, $height) = (0,0);
1282 my @sizes;
1283 for my $label (@$labels) {
1284 my @box = $self->_text_bbox($label, 'legend');
1285 push(@sizes, \@box);
1286 $width = $box[2] if $box[2] > $width;
1287 if ($minrowsize > $box[3]) {
1288 $height += $minrowsize;
1289 }
1290 else {
1291 $height += $box[3];
1292 }
1293 }
1294 my @box = (0, 0,
1295 $width + $patchsize + $padding * 2 + $gap,
1296 $height + $padding * 2 - $gap);
1297 my $outsidepadding = 0;
1298 if ($self->{_style}{legend}{border}) {
1299 defined($outsidepadding = $self->_get_number('legend.outsidepadding'))
1300 or return;
1301 $box[2] += 2 * $outsidepadding;
1302 $box[3] += 2 * $outsidepadding;
1303 }
1304 $self->_align_box(\@box, $chart_box, 'legend')
1305 or return;
1306 if ($self->{_style}{legend}{fill}) {
1307 $img->box(xmin=>$box[0]+$outsidepadding,
1308 ymin=>$box[1]+$outsidepadding,
1309 xmax=>$box[2]-$outsidepadding,
1310 ymax=>$box[3]-$outsidepadding,
1311 $self->_get_fill('legend.fill', \@box));
1312 }
1313 $box[0] += $outsidepadding;
1314 $box[1] += $outsidepadding;
1315 $box[2] -= $outsidepadding;
1316 $box[3] -= $outsidepadding;
1317 my $ypos = $box[1] + $padding;
1318 my $patchpos = $box[0]+$padding;
1319 my $textpos = $patchpos + $patchsize + $gap;
1320 my %text_info = $self->_text_style('legend')
1321 or return;
1322 my $patchborder;
1323 if ($self->{_style}{legend}{patchborder}) {
1324 $patchborder = $self->_get_color('legend.patchborder')
1325 or return;
1326 }
1327 my $dataindex = 0;
1328 for my $label (@$labels) {
1329 my @patchbox = ( $patchpos - $patchsize/2, $ypos - $patchsize/2,
1330 $patchpos + $patchsize * 3 / 2, $ypos + $patchsize*3/2 );
1331 my @fill = $self->_data_fill($dataindex, \@patchbox)
1332 or return;
1333 $img->box(xmin=>$patchpos, ymin=>$ypos, xmax=>$patchpos + $patchsize,
1334 ymax=>$ypos + $patchsize, @fill);
1335 if ($self->{_style}{legend}{patchborder}) {
1336 $img->box(xmin=>$patchpos, ymin=>$ypos, xmax=>$patchpos + $patchsize,
1337 ymax=>$ypos + $patchsize,
1338 color=>$patchborder);
1339 }
1340 $img->string(%text_info, x=>$textpos, 'y'=>$ypos + $patchsize,
1341 text=>$label);
1342
1343 my $step = $patchsize + $gap;
1344 if ($minrowsize < $sizes[$dataindex][3]) {
1345 $ypos += $sizes[$dataindex][3];
1346 }
1347 else {
1348 $ypos += $minrowsize;
1349 }
1350 ++$dataindex;
1351 }
1352 if ($self->{_style}{legend}{border}) {
1353 my $border_color = $self->_get_color('legend.border')
1354 or return;
1355 $img->box(xmin=>$box[0], ymin=>$box[1], xmax=>$box[2], ymax=>$box[3],
1356 color=>$border_color);
1357 }
1358 $self->_remove_box($chart_box, \@box);
1359 1;
1360}
1361
1362sub _draw_title {
1363 my ($self, $img, $chart_box) = @_;
1364
1365 my $title = $self->{_style}{title}{text};
1366 my @box = $self->_text_bbox($title, 'title');
1367 my $yoff = $box[1];
1368 @box[0,1] = (0,0);
1369 $self->_align_box(\@box, $chart_box, 'title');
1370 my %text_info = $self->_text_style('title');
1371 $img->string(%text_info, x=>$box[0], 'y'=>$box[3] + $yoff, text=>$title);
1372 $self->_remove_box($chart_box, \@box);
1373 1;
1374}
1375
1376sub _small_extent {
1377 my ($self, $box) = @_;
1378
1379 if ($box->[2] - $box->[0] > $box->[3] - $box->[1]) {
1380 return $box->[3] - $box->[1];
1381 }
1382 else {
1383 return $box->[2] - $box->[0];
1384 }
1385}
1386
1387=item _composite()
1388
1389Returns a list of style fields that are stored as composites, and
1390should be merged instead of just being replaced.
1391
1392=cut
1393
1394sub _composite {
1395 qw(title legend text label dropshadow outline callout);
1396}
1397
1398sub _filter_region {
1399 my ($self, $img, $left, $top, $right, $bottom, $filter) = @_;
1400
1401 unless (ref $filter) {
1402 my $name = $filter;
1403 $filter = $self->_get_thing($name)
1404 or return;
1405 $filter->{type}
1406 or return $self->_error("no type for filter $name");
1407 }
1408
1409 $left > 0 or $left = 0;
1410 $top > 0 or $top = 0;
1411
1412 # newer versions of Imager let you work on just part of an image
1413 if ($img->can('masked') && !$self->{_style}{features}{_debugblur}) {
1414 my $masked = $img->masked(left=>$left, top=>$top,
1415 right=>$right, bottom=>$bottom);
1416 $masked->filter(%$filter);
1417 }
1418 else {
1419 # for older versions of Imager
1420 my $subset = $img->crop(left=>$left, top=>$top,
1421 right=>$right, bottom=>$bottom);
1422 $subset->filter(%$filter);
1423 $img->paste(left=>$left, top=>$top, img=>$subset);
1424 }
1425}
1426
14271;
1428__END__
1429
1430=back
1431
1432=head1 SEE ALSO
1433
1434Imager::Graph::Pie(3), Imager(3), perl(1).
1435
1436=head1 AUTHOR
1437
1438Tony Cook <tony@develop-help.com>
1439
54ada35d
TC
1440=head1 LICENSE
1441
1442Imager::Graph is licensed under the same terms as perl itself.
1443
35574351
TC
1444=head1 BLAME
1445
1446Addi for producing a cool imaging module. :)
1447
1448=cut