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