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