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