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