=head1 SYNOPSIS
- use Imager::Graph::SubClass;
- my $chart = Imager::Graph::SubClass->new;
- my $img = $chart->draw(data=>..., ...)
+ use Imager::Graph::Sub_class;
+ my $chart = Imager::Graph::Sub_class->new;
+ my $img = $chart->draw(data=> \@data, ...)
or die $chart->error;
+ $img->write(file => 'image.png');
=head1 DESCRIPTION
use Imager qw(:handy);
use Imager::Fountain;
-$VERSION = '0.05';
+$VERSION = '0.07';
# the maximum recursion depth in determining a color, fill or number
use constant MAX_DEPTH => 10;
bless {}, $_[0];
}
+=item set_graph_size($size)
+
+Sets the size of the graph (in pixels) within the image. The size of the image defaults to 1.5 * $graph_size.
+
+=cut
+
+sub set_graph_size {
+ $_[0]->{'custom_style'}->{'size'} = $_[1];
+}
+
+=item set_image_width($width)
+
+Sets the width of the image in pixels.
+
+=cut
+
+sub set_image_width {
+ $_[0]->{'custom_style'}->{'width'} = $_[1];
+}
+
+=item set_image_height($height)
+
+Sets the height of the image in pixels.
+
+=cut
+
+sub set_image_height {
+ $_[0]->{'custom_style'}->{'height'} = $_[1];
+}
+
+=item add_data_series([8, 6, 7, 5, 3, 0, 9], 'Series Name');
+
+Adds a data series to the graph. For L<Imager::Graph::Pie>, only one data series can be added.
+
+=cut
+
+sub add_data_series {
+ my $self = shift;
+ my $data_ref = shift;
+ my $series_name = shift;
+
+ my $graph_data = $self->{'graph_data'} || [];
+
+ push @$graph_data, { data => $data_ref, series_name => $series_name };
+ if (defined $series_name) {
+ push @{$self->{'labels'}}, $series_name;
+ }
+
+ $self->{'graph_data'} = $graph_data;
+ return;
+}
+
+sub _get_data_series {
+ my ($self, $opts) = @_;
+
+ # return the data supplied to draw() if any.
+ if ($opts->{data}) {
+ # one or multiple series?
+ my $data = $opts->{data};
+ if (@$data && ref $data->[0] && ref $data->[0] =~ /ARRAY/) {
+ return $data;
+ }
+ else {
+ return [ { data => $data } ];
+ }
+ }
+
+ return $self->{'graph_data'};
+}
+
+=item set_labels(['label1', 'label2' ... ])
+
+Labels the specific data points. For line/bar graphs, this is the x-axis. For pie graphs, it is the label for the wedges.
+
+=cut
+
+sub set_labels {
+ $_[0]->{'labels'} = $_[1];
+}
+
+sub _get_labels {
+ my ($self, $opts) = @_;
+
+ $opts->{labels}
+ and return $opts->{labels};
+
+ return $_[0]->{'labels'}
+}
+
+=item set_title($title)
+
+Sets the title of the graph. Requires setting a font.
+
+=cut
+
+sub set_title {
+ $_[0]->{'custom_style'}->{'title'}->{'text'} = $_[1];
+}
+
+=item set_font($font)
+
+Sets the font to use for text. Takes an L<Imager::Font> object.
+
+=cut
+
+sub set_font {
+ $_[0]->{'custom_style'}->{'font'} = $_[1];
+}
+
+=item set_style($style_name)
+
+Sets the style to be used for the graph. Imager::Graph comes with several pre-defined styles: fount_lin (default), fount_rad, mono, primary_red, and primary.
+
+=cut
+
+sub set_style {
+ $_[0]->{'style'} = $_[1];
+}
+
+sub _get_style {
+ my ($self, $opts) = @_;
+
+ $opts->{style}
+ and return $opts->{style};
+
+ return $self->{'style'};
+}
+
=item error
-Returns an error message. Only value if the draw() method returns false.
+Returns an error message. Only valid if the draw() method returns false.
=cut
Creates a new image, draws the chart onto that image and returns it.
-Typically you will need to supply a C<data> parameter in the format
+Optionally, instead of using the api methods to configure your chart,
+you can supply a C<data> parameter in the format
required by that particular graph, and if your graph will use any
text, a C<font> parameter
The C<style> parameter will selects a basic color set, and possibly
sets other related parameters. See L</"STYLES">.
- my $img = $graph->draw(data=>\@data,
- title=>{ text=>"Hello, World!",
- size=>36,
- color=>'FF0000' });
+ my $font = Imager::Font->new(file => 'ImUgly.ttf');
+ my $img = $chart->draw(
+ data => \@data,
+ font => $font,
+ title => {
+ text => "Hello, World!",
+ size => 36,
+ color => 'FF0000'
+ }
+ );
When referring to a single sub-value this documentation will refer to
'title.color' rather than 'the color element of title'.
=over
+=item primary
+
+a light grey background with no outlines. Uses primary colors for the
+data fills.
+
=item primary_red
a light red background with no outlines. Uses primary colors for the
-data fills. This style is compatible with all versions of Imager.
+data fills.
Graphs drawn using this style should save well as a gif, even though
some graphs may perform a slight blur.
-This is the default style.
+This was the default style, but the red was too loud.
=item mono
This style outlines the legend if present and outlines the hashed fills.
-This and following styles require versions of Imager after 0.38.
-
=item fount_lin
designed as a "pretty" style this uses linear fountain fills for the
You can override the value used for text and outlines by setting the
C<fg> parameter.
+This is the default style.
+
=item fount_rad
also designed as a "pretty" style this uses radial fountain fills for
=back
+=head1 Style API
+
+To set or override styles, you can use the following methods:
+
+=over 4
+
+=item set_image_background
+
+=cut
+
+sub set_image_background {
+ $_[0]->{'custom_style'}->{'back'} = $_[1];
+}
+
+=item set_channels
+
+=cut
+
+sub set_channels {
+ $_[0]->{'custom_style'}->{'channels'} = $_[1];
+}
+
+=item set_line_color
+
+=cut
+
+sub set_line_color {
+ $_[0]->{'custom_style'}->{'line'} = $_[1];
+}
+
+=item set_title_font_size
+
+=cut
+
+sub set_title_font_size {
+ $_[0]->{'custom_style'}->{'title'}->{'size'} = $_[1];
+}
+
+=item set_title_font_color
+
+=cut
+
+sub set_title_font_color {
+ $_[0]->{'custom_style'}->{'title'}->{'color'} = $_[1];
+}
+
+=item set_title_horizontal_align
+
+=cut
+
+sub set_title_horizontal_align {
+ $_[0]->{'custom_style'}->{'title'}->{'halign'} = $_[1];
+}
+
+=item set_title_vertical_align
+
+=cut
+
+sub set_title_vertical_align {
+ $_[0]->{'custom_style'}->{'title'}->{'valign'} = $_[1];
+}
+
+=item set_text_font_color
+
+=cut
+
+sub set_text_font_color {
+ $_[0]->{'custom_style'}->{'text'}->{'color'} = $_[1];
+}
+
+=item set_text_font_size
+
+=cut
+
+sub set_text_font_size {
+ $_[0]->{'custom_style'}->{'text'}->{'size'} = $_[1];
+}
+
+=item set_graph_background_color
+
+=cut
+
+sub set_graph_background_color {
+ $_[0]->{'custom_style'}->{'bg'} = $_[1];
+}
+
+=item set_graph_foreground_color
+
+=cut
+
+sub set_graph_foreground_color {
+ $_[0]->{'custom_style'}->{'fg'} = $_[1];
+}
+
+=item set_legend_font_color
+
+=cut
+
+sub set_legend_font_color {
+ $_[0]->{'custom_style'}->{'legend'}->{'color'} = $_[1];
+}
+
+=item set_legend_font
+
+=cut
+
+sub set_legend_font {
+ $_[0]->{'custom_style'}->{'legend'}->{'font'} = $_[1];
+}
+
+=item set_legend_font_size
+
+=cut
+
+sub set_legend_font_size {
+ $_[0]->{'custom_style'}->{'legend'}->{'size'} = $_[1];
+}
+
+=item set_legend_patch_size
+
+=cut
+
+sub set_legend_patch_size {
+ $_[0]->{'custom_style'}->{'legend'}->{'patchsize'} = $_[1];
+}
+
+=item set_legend_patch_gap
+
+=cut
+
+sub set_legend_patch_gap {
+ $_[0]->{'custom_style'}->{'legend'}->{'patchgap'} = $_[1];
+}
+
+=item set_legend_horizontal_align
+
+=cut
+
+sub set_legend_horizontal_align {
+ $_[0]->{'custom_style'}->{'legend'}->{'halign'} = $_[1];
+}
+
+=item set_legend_vertical_align
+
+=cut
+
+sub set_legend_vertical_align {
+ $_[0]->{'custom_style'}->{'legend'}->{'valign'} = $_[1];
+}
+
+=item set_legend_padding
+
+=cut
+
+sub set_legend_padding {
+ $_[0]->{'custom_style'}->{'legend'}->{'padding'} = $_[1];
+}
+
+=item set_legend_outside_padding
+
+=cut
+
+sub set_legend_outside_padding {
+ $_[0]->{'custom_style'}->{'legend'}->{'outsidepadding'} = $_[1];
+}
+
+=item set_legend_fill
+
+=cut
+
+sub set_legend_fill {
+ $_[0]->{'custom_style'}->{'legend'}->{'fill'} = $_[1];
+}
+
+=item set_legend_border
+
+=cut
+
+sub set_legend_border {
+ $_[0]->{'custom_style'}->{'legend'}->{'border'} = $_[1];
+}
+
+=item set_legend_orientation
+
+=cut
+
+sub set_legend_orientation {
+ $_[0]->{'custom_style'}->{'legend'}->{'orientation'} = $_[1];
+}
+
+=item set_callout_font_color
+
+=cut
+
+sub set_callout_font_color {
+ $_[0]->{'custom_style'}->{'callout'}->{'color'} = $_[1];
+}
+
+=item set_callout_font
+
+=cut
+
+sub set_callout_font {
+ $_[0]->{'custom_style'}->{'callout'}->{'font'} = $_[1];
+}
+
+=item set_callout_font_size
+
+=cut
+
+sub set_callout_font_size {
+ $_[0]->{'custom_style'}->{'callout'}->{'size'} = $_[1];
+}
+
+=item set_callout_line_color
+
+=cut
+
+sub set_callout_line_color {
+ $_[0]->{'custom_style'}->{'callout'}->{'line'} = $_[1];
+}
+
+=item set_callout_leader_inside_length
+
+=cut
+
+sub set_callout_leader_inside_length {
+ $_[0]->{'custom_style'}->{'callout'}->{'inside'} = $_[1];
+}
+
+=item set_callout_leader_outside_length
+
+=cut
+
+sub set_callout_leader_outside_length {
+ $_[0]->{'custom_style'}->{'callout'}->{'outside'} = $_[1];
+}
+
+=item set_callout_leader_length
+
+=cut
+
+sub set_callout_leader_length {
+ $_[0]->{'custom_style'}->{'callout'}->{'leadlen'} = $_[1];
+}
+
+=item set_callout_gap
+
+=cut
+
+sub set_callout_gap {
+ $_[0]->{'custom_style'}->{'callout'}->{'gap'} = $_[1];
+}
+
+=item set_label_font_color
+
+=cut
+
+sub set_label_font_color {
+ $_[0]->{'custom_style'}->{'label'}->{'color'} = $_[1];
+}
+
+=item set_label_font
+
+=cut
+
+sub set_label_font {
+ $_[0]->{'custom_style'}->{'label'}->{'font'} = $_[1];
+}
+
+=item set_label_font_size
+
+=cut
+
+sub set_label_font_size {
+ $_[0]->{'custom_style'}->{'label'}->{'size'} = $_[1];
+}
+
+=item set_drop_shadow_fill_color
+
+=cut
+
+sub set_drop_shadow_fill_color {
+ $_[0]->{'custom_style'}->{'dropshadow'}->{'fill'} = $_[1];
+}
+
+=item set_drop_shadow_offset
+
+=cut
+
+sub set_drop_shadow_offset {
+ $_[0]->{'custom_style'}->{'dropshadow'}->{'off'} = $_[1];
+}
+
+=item set_drop_shadowXOffset
+
+=cut
+
+sub set_drop_shadowXOffset {
+ $_[0]->{'custom_style'}->{'dropshadow'}->{'offx'} = $_[1];
+}
+
+=item set_drop_shadowYOffset
+
+=cut
+
+sub set_drop_shadowYOffset {
+ $_[0]->{'custom_style'}->{'dropshadow'}->{'offy'} = $_[1];
+}
+
+=item set_drop_shadow_filter
+
+=cut
+
+sub set_drop_shadow_filter {
+ $_[0]->{'custom_style'}->{'dropshadow'}->{'filter'} = $_[1];
+}
+
+=item set_outline_color
+
+=cut
+
+sub set_outline_color {
+ $_[0]->{'custom_style'}->{'outline'}->{'line'} = $_[1];
+}
+
+=item set_data_area_fills
+
+=cut
+
+sub set_data_area_fills {
+ $_[0]->{'custom_style'}->{'fills'} = $_[1];
+}
+
+=item set_data_line_colors
+
+=cut
+
+sub set_data_line_colors {
+ $_[0]->{'custom_style'}->{'colors'} = $_[1];
+}
+
+=back
+
=head1 FEATURES
Each graph type has a number of features. These are used to add
-various items that are displayed in the graph area. Some common
-features are:
+various items that are displayed in the graph area.
+
+Features can be controlled by calling methods on the graph object, or
+by passing a C<features> parameter to draw().
+
+Some common features are:
=over
-=item legend
+=item show_legend()
-adds a box containing boxes filled with the data filess, with
+Feature: legend
+X<legend><features, legend>
+
+adds a box containing boxes filled with the data fills, with
the labels provided to the draw method. The legend will only be
displayed if both the legend feature is enabled and labels are
supplied.
-=item labels
+=cut
+
+sub show_legend {
+ $_[0]->{'custom_style'}->{'features'}->{'legend'} = 1;
+}
+
+=item show_outline()
+
+Feature: outline
+X<outline>X<features, outline>
+
+If enabled, draw a border around the elements representing data in the
+graph, eg. around each pie segments on a pie chart, around each bar on
+a bar chart.
+
+=cut
+
+sub show_outline {
+ $_[0]->{'custom_style'}->{'features'}->{'outline'} = 1;
+}
+
+=item show_labels()
+
+Feature: labels
+X<labels>X<features, labels>
labels each data fill, usually by including text inside the data fill.
If the text does not fit in the fill, they could be displayed in some
-other form, eg. as callouts in a pie graph. There usually isn't much
-point in including both labels and a legend.
+other form, eg. as callouts in a pie graph.
-=item dropshadow
+For pie charts there isn't much point in enabling both the C<legend>
+and C<labels> features.
+
+For other charts, the labels label the independent variable, while the
+legend describes the color used to plot the dependent variables.
+
+=cut
+
+sub show_labels {
+ $_[0]->{'custom_style'}->{'features'}->{'labels'} = 1;
+}
+
+=item show_drop_shadow()
+
+Feature: dropshadow
+X<dropshadow>X<features, dropshadow>
a simple drop shadow is shown behind some of the graph elements.
+=cut
+
+sub show_drop_shadow {
+ $_[0]->{'custom_style'}->{'features'}->{'dropshadow'} = 1;
+}
+
+=item reset_features()
+
+Unsets all of the features.
+
+Note: this disables all features, even those enabled by default for a
+style. They can then be enabled by calling feature methods or by
+supplying a C<feature> parameter to the draw() method.
+
+=cut
+
+sub reset_features {
+ $_[0]->{'custom_style'}->{'features'} = {};
+ $_[0]->{'custom_style'}->{'features'}->{'reset'} = 1;
+}
+
+=back
+
+Additionally, features can be set by passing them into the draw()
+method, named as above:
+
+=over
+
+=item *
+
+if supplied as an array reference, then any element C<no>I<featurename> will
+disable that feature, while an element I<featurename> will enable it.
+
+=item *
+
+if supplied as a scalar, it is treated as if it were a reference to
+an array containing only that scalar.
+
+=item *
+
+if supplied as a hash reference, then a C<reset> key with a true value
+will avoid inheriting any default features, a key I<feature> with a
+false value will disable that feature and a key I<feature> with a true
+value will enable that feature.
+
=back
Each graph also has features specific to that graph.
Used to define basic background and foreground colors for the graph.
The bg color may be used for the background of the graph, and is used
-as a default for the background of hatcheed fills. The fg is used as
+as a default for the background of hatched fills. The fg is used as
the default for line and text colors.
=item font
=item padding
-the gap between the legend patches and text and the outside of it's
+the gap between the legend patches and text and the outside of its
box, or to the legend border, if any.
=item outsidepadding
the border color of the legend. Default: none (no border is drawn
around the legend.)
+=item orientation
+
+The orientation of the legend. If this is C<vertical> the the patches
+and labels are stacked on top of each other. If this is C<horizontal>
+the patchs and labels are word wrapped across the image. Default:
+vertical.
+
=back
+For example to create a horizontal legend with borderless patches,
+darker than the background, you might do:
+
+ my $im = $chart->draw
+ (...,
+ legend =>
+ {
+ patchborder => undef,
+ orientation => 'horizontal',
+ fill => { solid => Imager::Color->new(0, 0, 0, 32), }
+ },
+ ...);
+
=item callout
defines attributes for graph callouts, if any are present. eg. if the
default style information contains:
text=>{
- color=>'lookup(fg)',
+ color=>'lookup(fg)',
...
},
legend =>{
- color=>'lookup(text.color)',
+ color=>'lookup(text.color)',
...
},
for the legend block and for the fills used for each data element.
You can specify a fill as a L<color value|Specifying colors> or as a
-general fill, see L<Imager::Fill> for details. To use a general fill
-you need a version of Imager after 0.38.
+general fill, see L<Imager::Fill> for details.
You don't need (or usually want) to call Imager::Fill::new yourself,
since the various fill functions will call it for you, and
As with colors, you can use lookup(name) or lookup(name1.name2) to
have one element to inherit the fill of another.
+Imager::Graph defaults the fill combine value to C<'normal'>. This
+doesn't apply to simple color fills.
+
=head2 Specifying numbers
You can specify various numbers, usually representing the size of
(
back=> 'lookup(bg)',
line=> 'lookup(fg)',
+ aa => 1,
text=>{
- color => 'lookup(fg)',
+ color => 'lookup(fg)',
font => 'lookup(font)',
- size => 14,
- },
+ size => 14,
+ aa => 'lookup(aa)',
+ },
title=>{
- color => 'lookup(text.color)',
+ color => 'lookup(text.color)',
font => 'lookup(text.font)',
- halign => 'center',
- valign => 'top',
- size => 'scale(text.size,2.0)',
- },
+ halign => 'center',
+ valign => 'top',
+ size => 'scale(text.size,2.0)',
+ aa => 'lookup(text.aa)',
+ },
legend =>{
- color => 'lookup(text.color)',
+ color => 'lookup(text.color)',
font => 'lookup(text.font)',
- size => 'lookup(text.size)',
- patchsize => 'scale(legend.size,0.9)',
- patchgap => 'scale(legend.patchsize,0.3)',
- patchborder => 'lookup(line)',
- halign => 'right',
- valign => 'top',
- padding => 'scale(legend.size,0.3)',
- outsidepadding => 'scale(legend.padding,0.4)',
- },
+ aa => 'lookup(text.aa)',
+ size => 'lookup(text.size)',
+ patchsize => 'scale(legend.size,0.9)',
+ patchgap => 'scale(legend.patchsize,0.3)',
+ patchborder => 'lookup(line)',
+ halign => 'right',
+ valign => 'top',
+ padding => 'scale(legend.size,0.3)',
+ outsidepadding => 'scale(legend.padding,0.4)',
+ },
callout => {
- color => 'lookup(text.color)',
+ color => 'lookup(text.color)',
font => 'lookup(text.font)',
- size => 'lookup(text.size)',
- line => 'lookup(line)',
- inside => 'lookup(callout.size)',
- outside => 'lookup(callout.size)',
- leadlen => 'scale(0.8,callout.size)',
- gap => 'scale(callout.size,0.3)',
- },
+ size => 'lookup(text.size)',
+ line => 'lookup(line)',
+ inside => 'lookup(callout.size)',
+ outside => 'lookup(callout.size)',
+ leadlen => 'scale(0.8,callout.size)',
+ gap => 'scale(callout.size,0.3)',
+ aa => 'lookup(text.aa)',
+ lineaa => 'lookup(lineaa)',
+ },
label => {
font => 'lookup(text.font)',
- size => 'lookup(text.size)',
- color => 'lookup(text.color)',
+ size => 'lookup(text.size)',
+ color => 'lookup(text.color)',
hpad => 'lookup(label.pad)',
vpad => 'lookup(label.pad)',
pad => 'scale(label.size,0.2)',
pcformat => sub { sprintf "%s (%.0f%%)", $_[0], $_[1] },
pconlyformat => sub { sprintf "%.1f%%", $_[0] },
- },
+ aa => 'lookup(text.aa)',
+ lineaa => 'lookup(lineaa)',
+ },
dropshadow => {
- fill => '404040',
+ fill => { solid => Imager::Color->new(0, 0, 0, 96) },
off => 'scale(0.4,text.size)',
offx => 'lookup(dropshadow.off)',
offy => 'lookup(dropshadow.off)',
coef=>[0.1, 0.2, 0.4, 0.6, 0.7, 0.9, 1.2,
0.9, 0.7, 0.6, 0.4, 0.2, 0.1 ] },
},
+ # controls the outline of graph elements representing data, eg. pie
+ # slices, bars or columns
outline => {
line =>'lookup(line)',
+ lineaa => 'lookup(lineaa)',
},
+ # controls the outline and background of the data area of the chart
+ graph =>
+ {
+ fill => "lookup(bg)",
+ outline => "lookup(fg)",
+ },
size=>256,
width=>'scale(1.5,size)',
height=>'lookup(size)',
+
+ # yes, the handling of fill and line AA is inconsistent, lack of
+ # forethought, unfortunately
+ fill => {
+ aa => 'lookup(aa)',
+ },
+ lineaa => 'lookup(aa)',
);
=item _error($message)
depending on context. Should be used for error handling, since it may
provide some user hooks at some point.
+The intended usage is:
+
+ some action
+ or return $self->_error("error description");
+
+You should almost always return the result of _error() or return
+immediately afterwards.
+
=cut
sub _error {
\%style_defs;
}
-my $def_style = 'primary_red';
+# Let's make the default something that looks really good, so folks will be interested enough to customize the style.
+my $def_style = 'fount_lin';
my %styles =
(
+ primary =>
+ {
+ fills=>
+ [
+ qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF)
+ ],
+ fg=>'000000',
+ negative_bg=>'EEEEEE',
+ bg=>'E0E0E0',
+ legend=>
+ {
+ #patchborder=>'000000'
+ },
+ },
primary_red =>
{
fills=>
qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF)
],
fg=>'000000',
+ negative_bg=>'EEEEEE',
bg=>'C08080',
legend=>
{
channels=>1,
bg=>'FFFFFF',
fg=>'000000',
+ negative_bg=>'EEEEEE',
features=>{ outline=>1 },
pie =>{
blur=>undef,
},
+ aa => 0,
+ line_markers =>
+ [
+ { shape => "x", radius => 4 },
+ { shape => "plus", radius => 4 },
+ { shape => "open_circle", radius => 4 },
+ { shape => "open_diamond", radius => 5 },
+ { shape => "open_square", radius => 4 },
+ { shape => "open_triangle", radius => 4 },
+ { shape => "x", radius => 8 },
+ { shape => "plus", radius => 8 },
+ { shape => "open_circle", radius => 8 },
+ { shape => "open_diamond", radius => 10 },
+ { shape => "open_square", radius => 8 },
+ { shape => "open_triangle", radius => 8 },
+ ],
},
fount_lin =>
{
[
{ fountain=>'linear',
xa_ratio=>0.13, ya_ratio=>0.13, xb_ratio=>0.87, yb_ratio=>0.87,
- repeat=>'sawtooth',
segments => Imager::Fountain->simple(positions=>[0, 1],
- colors=>[ NC('FFC0C0'), NC('FF0000') ]),
+ colors=>[ NC('FFC0C0'), NC('FF0000') ]),
},
{ fountain=>'linear',
xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
segments => Imager::Fountain->simple(positions=>[0, 1],
- colors=>[ NC('C0FFC0'), NC('00FF00') ]),
+ colors=>[ NC('C0FFC0'), NC('00FF00') ]),
},
{ fountain=>'linear',
xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
segments => Imager::Fountain->simple(positions=>[0, 1],
- colors=>[ NC('C0C0FF'), NC('0000FF') ]),
+ colors=>[ NC('C0C0FF'), NC('0000FF') ]),
},
{ fountain=>'linear',
xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
segments => Imager::Fountain->simple(positions=>[0, 1],
- colors=>[ NC('FFFFC0'), NC('FFFF00') ]),
+ colors=>[ NC('FFFFC0'), NC('FFFF00') ]),
},
{ fountain=>'linear',
xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
segments => Imager::Fountain->simple(positions=>[0, 1],
- colors=>[ NC('C0FFFF'), NC('00FFFF') ]),
+ colors=>[ NC('C0FFFF'), NC('00FFFF') ]),
},
{ fountain=>'linear',
xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
segments => Imager::Fountain->simple(positions=>[0, 1],
- colors=>[ NC('FFC0FF'), NC('FF00FF') ]),
+ colors=>[ NC('FFC0FF'), NC('FF00FF') ]),
},
],
+ colors => [
+ qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF)
+ ],
+ line_markers =>[
+ { shape => 'circle', radius => 4 },
+ { shape => 'square', radius => 4 },
+ { shape => 'diamond', radius => 4 },
+ { shape => 'triangle', radius => 4 },
+ { shape => 'x', radius => 4 },
+ { shape => 'plus', radius => 4 },
+ ],
back=>{ fountain=>'linear',
xa_ratio=>0, ya_ratio=>0,
xb_ratio=>1.0, yb_ratio=>1.0,
( positions=>[0, 1],
colors=>[ NC('6060FF'), NC('60FF60') ]) },
fg=>'000000',
+ negative_bg=>'EEEEEE',
bg=>'FFFFFF',
features=>{ dropshadow=>1 },
},
{ fountain=>'radial',
xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
segments => Imager::Fountain->simple(positions=>[0, 1],
- colors=>[ NC('FF8080'), NC('FF0000') ]),
+ colors=>[ NC('FF8080'), NC('FF0000') ]),
},
{ fountain=>'radial',
xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
segments => Imager::Fountain->simple(positions=>[0, 1],
- colors=>[ NC('80FF80'), NC('00FF00') ]),
+ colors=>[ NC('80FF80'), NC('00FF00') ]),
},
{ fountain=>'radial',
xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
segments => Imager::Fountain->simple(positions=>[0, 1],
- colors=>[ NC('808080FF'), NC('0000FF') ]),
+ colors=>[ NC('808080FF'), NC('0000FF') ]),
},
{ fountain=>'radial',
xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
segments => Imager::Fountain->simple(positions=>[0, 1],
- colors=>[ NC('FFFF80'), NC('FFFF00') ]),
+ colors=>[ NC('FFFF80'), NC('FFFF00') ]),
},
{ fountain=>'radial',
xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
segments => Imager::Fountain->simple(positions=>[0, 1],
- colors=>[ NC('80FFFF'), NC('00FFFF') ]),
+ colors=>[ NC('80FFFF'), NC('00FFFF') ]),
},
{ fountain=>'radial',
xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
segments => Imager::Fountain->simple(positions=>[0, 1],
- colors=>[ NC('FF80FF'), NC('FF00FF') ]),
+ colors=>[ NC('FF80FF'), NC('FF00FF') ]),
},
],
+ colors => [
+ qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF)
+ ],
back=>{ fountain=>'linear',
xa_ratio=>0, ya_ratio=>0,
xb_ratio=>1.0, yb_ratio=>1.0,
( positions=>[0, 1],
colors=>[ NC('6060FF'), NC('60FF60') ]) },
fg=>'000000',
+ negative_bg=>'EEEEEE',
bg=>'FFFFFF',
}
);
+$styles{'ocean'} = {
+ fills => [
+ {
+ fountain =>'linear',
+ xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
+ segments => Imager::Fountain->simple(
+ positions=>[0, 1],
+ colors=>[ NC('EFEDCF'), NC('E6E2AF') ]),
+ },
+ {
+ fountain =>'linear',
+ xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
+ segments => Imager::Fountain->simple(
+ positions=>[0, 1],
+ colors=>[ NC('DCD7AB'), NC('A7A37E') ]),
+ },
+ {
+ fountain =>'linear',
+ xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
+ segments => Imager::Fountain->simple(
+ positions=>[0, 1],
+ colors=>[ NC('B2E5D4'), NC('80B4A2') ]),
+ },
+ {
+ fountain =>'linear',
+ xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
+ segments => Imager::Fountain->simple(
+ positions=>[0, 1],
+ colors=>[ NC('7aaab9'), NC('046380') ]),
+ },
+ {
+ fountain =>'linear',
+ xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
+ segments => Imager::Fountain->simple(
+ positions=>[0, 1],
+ colors=>[ NC('c3b8e9'), NC('877EA7') ]),
+ },
+ {
+ fountain =>'linear',
+ xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
+ segments => Imager::Fountain->simple(
+ positions=>[0, 1],
+ colors=>[ NC('A3DF9A'), NC('67A35E') ]),
+ },
+ {
+ fountain =>'linear',
+ xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
+ segments => Imager::Fountain->simple(
+ positions=>[0, 1],
+ colors=>[ NC('E19C98'), NC('B4726F') ]),
+ },
+ ],
+ colors => [
+ qw(E6E2AF A7A37E 80B4A2 046380 877EA7 67A35E B4726F)
+ ],
+ fg=>'000000',
+ negative_bg=>'EEEEEE',
+ bg=>'FFFFFF',
+ features=>{ dropshadow=>1 },
+
+};
+
+$styles{'ocean_flat'} = {
+ fills=>
+ [
+ qw(E6E2AF A7A37E 80B4A2 046380 877EA7 67A35E B4726F)
+ ],
+ colors => [
+ qw(E6E2AF A7A37E 80B4A2 046380 877EA7 67A35E B4726F)
+ ],
+ fg=>'000000',
+ negative_bg=>'EEEEEE',
+ bg=>'FFFFFF',
+ features=>{ dropshadow=>1 },
+
+};
+
+
=item $self->_style_setup(\%opts)
-Uses the values from %opts to build a customized hash describing the
-way the graph should be drawn.
+Uses the values from %opts, the custom style set by methods, the style
+set by the style parameter or the set_style() method and the built in
+chart defaults to build a working style.
+
+The working style features member is also populated with the active
+features for the chart.
+
+The working style is stored in the C<_style> member of $self.
=cut
my ($self, $opts) = @_;
my $style_defs = $self->_style_defs;
my $style;
- $style = $styles{$opts->{style}} if $opts->{style};
+
+ my $pre_def_style = $self->_get_style($opts);
+ my $api_style = $self->{'custom_style'} || {};
+ $style = $styles{$pre_def_style} if $pre_def_style;
+
$style ||= $styles{$def_style};
- my @search_list = ( $style_defs, $style, $opts);
+ my @search_list = ( $style_defs, $style, $api_style, $opts);
my %work;
my @composite = $self->_composite();
}
}
else {
- $work{$key} = $src->{$key};
+ $work{$key} = $src->{$key}
+ if defined $src->{$key}; # $opts with pmichauds new accessor handling
}
}
}
# features are handled specially
- $work{features} = {};
+ my %features;
+ $work{features} = \%features;
for my $src (@search_list) {
if ($src->{features}) {
if (ref $src->{features}) {
if (ref($src->{features}) =~ /ARRAY/) {
# just set those features
for my $feature (@{$src->{features}}) {
- $work{features}{$feature} = 1;
+ if ($feature =~ /^no(.+)$/) {
+ delete $features{$1};
+ }
+ else {
+ $features{$feature} = 1;
+ }
}
}
elsif (ref($src->{features}) =~ /HASH/) {
}
else {
# just set that single feature
- $work{features}{$src->{features}} = 1;
+ if ($src->{features} =~ /^no(.+)$/) {
+ delete $features{$1};
+ }
+ else {
+ $features{$src->{features}} = 1;
+ }
}
}
}
- #use Data::Dumper;
- #print Dumper(\%work);
$self->{_style} = \%work;
}
Supports the 'lookup(foo)' mechanism.
+Returns an empty list on failure.
+
=cut
sub _get_thing {
=item scale(value1,value2)
-Each value can be a number or a name. Names are recursively looks up
+Each value can be a number or a name. Names are recursively looked up
in the style and the product is returned.
=back
else {
if ($what =~ /^lookup\(([\w.]+)\)$/) {
@depth < MAX_DEPTH
- or return $self->_error("too many levels of recursion in lookup (@depth)");
+ or return $self->_error("too many levels of recursion in lookup (@depth)");
return $self->_get_number($1, @depth);
}
elsif ($what =~ /^scale\(
- ((?:[a-z][\w.]*)|$NUM_RE)
+ ((?:[a-z][\w.]*)|$NUM_RE)
,
- ((?:[a-z][\w.]*)|$NUM_RE)\)$/x) {
+ ((?:[a-z][\w.]*)|$NUM_RE)\)$/x) {
my ($left, $right) = ($1, $2);
unless ($left =~ /^$NUM_RE$/) {
- @depth < MAX_DEPTH
- or return $self->_error("too many levels of recursion in scale (@depth)");
- $left = $self->_get_number($left, @depth);
+ @depth < MAX_DEPTH
+ or return $self->_error("too many levels of recursion in scale (@depth)");
+ $left = $self->_get_number($left, @depth);
}
unless ($right =~ /^$NUM_RE$/) {
- @depth < MAX_DEPTH
- or return $self->_error("too many levels of recursion in scale (@depth)");
- $right = $self->_get_number($right, @depth);
+ @depth < MAX_DEPTH
+ or return $self->_error("too many levels of recursion in scale (@depth)");
+ $right = $self->_get_number($right, @depth);
}
return $left * $right;
}
}
}
+=item $self->_get_integer($name)
+
+Retrieves an integer from the style. This is a simple wrapper around
+_get_number() that rounds the result to an integer.
+
+Returns an empty list on failure.
+
+=cut
+
+sub _get_integer {
+ my ($self, $name, @depth) = @_;
+
+ my $number = $self->_get_number($name, @depth)
+ or return;
+
+ return sprintf("%.0f", $number);
+}
+
=item _get_color($name)
Returns a color object of the given name from the style hash.
Allows the lookup(name) mechanism.
+Returns an empty list on failure.
+
=cut
sub _get_color {
unless (ref $what) {
if ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) {
@depth < MAX_DEPTH or
- return $self->_error("too many levels of recursion in lookup (@depth)");
+ return $self->_error("too many levels of recursion in lookup (@depth)");
return $self->_get_color($1, @depth);
}
This function does the fg and bg initialization for hatched fills, and
translation of *_ratio for fountain fills (using the $box parameter).
+Returns an empty list on failure.
+
=cut
sub _translate_fill {
}
else {
# a general fill
+ # default to normal combine mode
+ my %work = ( combine => 'normal', %$what );
if ($what->{hatch}) {
- my %work = %$what;
- if (!$work{fg}) {
- $work{fg} = $self->_get_color('fg')
- or return;
- }
- if (!$work{bg}) {
- $work{bg} = $self->_get_color('bg')
- or return;
- }
- return ( fill=>\%work );
+ if (!$work{fg}) {
+ $work{fg} = $self->_get_color('fg')
+ or return;
+ }
+ if (!$work{bg}) {
+ $work{bg} = $self->_get_color('bg')
+ or return;
+ }
+ return ( fill=>\%work );
}
elsif ($what->{fountain}) {
- my %work = %$what;
- for my $key (qw(xa ya xb yb)) {
- if (exists $work{"${key}_ratio"}) {
- if ($key =~ /^x/) {
- $work{$key} = $box->[0] + $work{"${key}_ratio"}
- * ($box->[2] - $box->[0]);
- }
- else {
- $work{$key} = $box->[1] + $work{"${key}_ratio"}
- * ($box->[3] - $box->[1]);
- }
- }
- }
- return ( fill=>\%work );
+ for my $key (qw(xa ya xb yb)) {
+ if (exists $work{"${key}_ratio"}) {
+ if ($key =~ /^x/) {
+ $work{$key} = $box->[0] + $work{"${key}_ratio"}
+ * ($box->[2] - $box->[0]);
+ }
+ else {
+ $work{$key} = $box->[1] + $work{"${key}_ratio"}
+ * ($box->[3] - $box->[1]);
+ }
+ }
+ }
+ return ( fill=>\%work );
}
else {
- return ( fill=> $what );
+ return ( fill=> \%work );
}
}
}
"data.$index");
}
-=item _get_fill($index, $box)
+sub _data_color {
+ my ($self, $index) = @_;
+
+ my $colors = $self->{'_style'}{'colors'} || [];
+ my $fills = $self->{'_style'}{'fills'} || [];
+
+ # Try to just use a fill, so non-fountain styles don't need
+ # to have a duplicated set of fills and colors
+ my $fill = $fills->[$index % @$fills];
+ if (!ref $fill) {
+ return $fill;
+ }
+
+ if (@$colors) {
+ return $colors->[$index % @$colors] || '000000';
+ }
+ return '000000';
+}
+
+=item _get_fill($name, $box)
Retrieves fill parameters for a named fill.
return $self->_translate_fill($what, $box, @depth);
}
+=item _get_line($name)
+
+Return color (and possibly other) parameters for drawing a line with
+the _line() method.
+
+=cut
+
+sub _get_line {
+ my ($self, $name, @depth) = @_;
+
+ push (@depth, $name);
+ my $what;
+ if ($name =~ /^(\w+)\.(\w+)$/) {
+ $what = $self->{_style}{$1}{$2};
+ }
+ else {
+ $what = $self->{_style}{$name};
+ }
+
+ defined($what)
+ or return $self->_error("no line style $name found");
+
+ if (ref $what) {
+ if (eval { $what->isa("Imager::Color") }) {
+ return $what;
+ }
+ if (ref $what eq "HASH") {
+ # allow each kep to be looked up
+ my %work = %$what;
+
+ if ($work{color} =~ /^lookup\((.*)\)$/) {
+ $work{color} = $self->_get_color($1, @depth);
+ }
+ for my $key (keys %work) {
+ $key eq "color" and next;
+
+ if ($work{$key} =~ /^lookup\((.*)\)$/) {
+ $work{$key} = $self->_get_thing($1);
+ }
+ }
+
+ return %work;
+ }
+ return ( color => Imager::Color->new(@$what) );
+ }
+ else {
+ if ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) {
+ @depth < MAX_DEPTH
+ or return $self->_error("too many levels of recursion in lookup (@depth)");
+ return $self->_get_line($1, @depth);
+ }
+ else {
+ # presumably a text color
+ my $color = Imager::Color->new($what)
+ or return $self->_error("Could not translate $what as a color: ".Imager->errstr);
+
+ return ( color => $color );
+ }
+ }
+}
+
=item _make_img()
Builds the image object for the graph and fills it with the background
sub _make_img {
my ($self) = @_;
-
- my ($width, $height) = (256, 256);
- $width = $self->_get_number('width');
- $height = $self->_get_number('height');
+ my $width = $self->_get_number('width') || 256;
+ my $height = $self->_get_number('height') || 256;
my $channels = $self->{_style}{channels};
$channels ||= 3;
- my $img = Imager->new(xsize=>$width, ysize=>$height, channels=>$channels);
+ my $img = Imager->new(xsize=>$width, ysize=>$height, channels=>$channels)
+ or return $self->_error("Error creating image: " . Imager->errstr);
$img->box($self->_get_fill('back', [ 0, 0, $width-1, $height-1]));
- $img;
+ $self->{_image} = $img;
+
+ return $img;
+}
+
+sub _get_image {
+ my $self = shift;
+
+ return $self->{'_image'};
}
+=item _text_style($name)
+
+Returns parameters suitable for calls to Imager::Font's bounding_box()
+and draw() methods intended for use in defining text styles.
+
+Returns an empty list on failure.
+
+Returns the following attributes: font, color, size, aa, sizew
+(optionally)
+
+=cut
+
sub _text_style {
my ($self, $name) = @_;
%work = %{$self->{_style}{text}};
}
$work{font}
- or return $self->_error("$name has no font parameter");
+ or return $self->_error("$name has no font parameter");
$work{font} = $self->_get_thing("$name.font")
- or return $self->_error("invalid font");
+ or return $self->_error("No $name.font defined, either set $name.font or font to a font");
UNIVERSAL::isa($work{font}, "Imager::Font")
or return $self->_error("$name.font is not a font");
if ($work{color} && !ref $work{color}) {
$work{size} = $self->_get_number("$name.size");
$work{sizew} = $self->_get_number("$name.sizew")
if $work{sizew};
+ $work{aa} = $self->_get_number("$name.aa");
%work;
}
+=item _text_bbox($text, $name)
+
+Returns a bounding box for the specified $text as styled by $name.
+
+Returns an empty list on failure.
+
+=cut
+
sub _text_bbox {
my ($self, $text, $name) = @_;
- my %text_info = $self->_text_style($name);
+ my %text_info = $self->_text_style($name)
+ or return;
my @bbox = $text_info{font}->bounding_box(%text_info, string=>$text,
- canon=>1);
+ canon=>1);
return @bbox[0..3];
}
+=item _line_style($name)
+
+Return parameters suitable for calls to Imager's line(), polyline(),
+and box() methods.
+
+For now this returns only color and aa parameters, but future releases
+of Imager may support extra parameters.
+
+=cut
+
+sub _line_style {
+ my ($self, $name) = @_;
+
+ my %line;
+ $line{color} = $self->_get_color("$name.line")
+ or return;
+ $line{aa} = $self->_get_number("$name.lineaa");
+ defined $line{aa} or $line{aa} = $self->_get_number("aa");
+
+ return %line;
+}
+
sub _align_box {
my ($self, $box, $chart_box, $name) = @_;
if ($areay < $areax) {
if ($object_box->[1] - $chart_box->[1]
- < $chart_box->[3] - $object_box->[3]) {
+ < $chart_box->[3] - $object_box->[3]) {
$chart_box->[1] = $object_box->[3];
}
else {
}
else {
if ($object_box->[0] - $chart_box->[0]
- < $chart_box->[2] - $object_box->[2]) {
+ < $chart_box->[2] - $object_box->[2]) {
$chart_box->[0] = $object_box->[2];
}
else {
sub _draw_legend {
my ($self, $img, $labels, $chart_box) = @_;
- defined(my $padding = $self->_get_number('legend.padding'))
+ my $orient = $self->_get_thing('legend.orientation');
+ defined $orient or $orient = 'vertical';
+
+ if ($orient eq 'vertical') {
+ return $self->_draw_legend_vertical($img, $labels, $chart_box);
+ }
+ elsif ($orient eq 'horizontal') {
+ return $self->_draw_legend_horizontal($img, $labels, $chart_box);
+ }
+ else {
+ return $self->_error("Unknown legend.orientation $orient");
+ }
+}
+
+sub _draw_legend_horizontal {
+ my ($self, $img, $labels, $chart_box) = @_;
+
+ defined(my $padding = $self->_get_integer('legend.padding'))
+ or return;
+ my $patchsize = $self->_get_integer('legend.patchsize')
+ or return;
+ defined(my $gap = $self->_get_integer('legend.patchgap'))
+ or return;
+
+ my $minrowsize = $patchsize + $gap;
+ my ($width, $height) = (0,0);
+ my $row_height = $minrowsize;
+ my $pos = 0;
+ my @sizes;
+ my @offsets;
+ for my $label (@$labels) {
+ my @text_box = $self->_text_bbox($label, 'legend')
+ or return;
+ push(@sizes, \@text_box);
+ my $entry_width = $patchsize + $gap + $text_box[2];
+ if ($pos == 0) {
+ # never re-wrap the first entry
+ push @offsets, [ 0, $height ];
+ }
+ else {
+ if ($pos + $gap + $entry_width > $chart_box->[2]) {
+ $pos = 0;
+ $height += $row_height;
+ }
+ push @offsets, [ $pos, $height ];
+ }
+ my $entry_right = $pos + $entry_width;
+ $pos += $gap + $entry_width;
+ $entry_right > $width and $width = $entry_right;
+ if ($text_box[3] > $row_height) {
+ $row_height = $text_box[3];
+ }
+ }
+ $height += $row_height;
+ my @box = ( 0, 0, $width + $padding * 2, $height + $padding * 2 );
+ my $outsidepadding = 0;
+ if ($self->{_style}{legend}{border}) {
+ defined($outsidepadding = $self->_get_integer('legend.outsidepadding'))
+ or return;
+ $box[2] += 2 * $outsidepadding;
+ $box[3] += 2 * $outsidepadding;
+ }
+ $self->_align_box(\@box, $chart_box, 'legend')
+ or return;
+ if ($self->{_style}{legend}{fill}) {
+ $img->box(xmin=>$box[0]+$outsidepadding,
+ ymin=>$box[1]+$outsidepadding,
+ xmax=>$box[2]-$outsidepadding,
+ ymax=>$box[3]-$outsidepadding,
+ $self->_get_fill('legend.fill', \@box));
+ }
+ $box[0] += $outsidepadding;
+ $box[1] += $outsidepadding;
+ $box[2] -= $outsidepadding;
+ $box[3] -= $outsidepadding;
+ my %text_info = $self->_text_style('legend')
+ or return;
+ my $patchborder;
+ if ($self->{_style}{legend}{patchborder}) {
+ $patchborder = $self->_get_color('legend.patchborder')
+ or return;
+ }
+
+ my $dataindex = 0;
+ for my $label (@$labels) {
+ my ($left, $top) = @{$offsets[$dataindex]};
+ $left += $box[0] + $padding;
+ $top += $box[1] + $padding;
+ my $textpos = $left + $patchsize + $gap;
+ my @patchbox = ( $left, $top,
+ $left + $patchsize, $top + $patchsize );
+ my @fill = $self->_data_fill($dataindex, \@patchbox)
+ or return;
+ $img->box(xmin=>$left, ymin=>$top, xmax=>$left + $patchsize,
+ ymax=>$top + $patchsize, @fill);
+ if ($self->{_style}{legend}{patchborder}) {
+ $img->box(xmin=>$left, ymin=>$top, xmax=>$left + $patchsize,
+ ymax=>$top + $patchsize,
+ color=>$patchborder);
+ }
+ $img->string(%text_info, x=>$textpos, 'y'=>$top + $patchsize,
+ text=>$label);
+
+ ++$dataindex;
+ }
+ if ($self->{_style}{legend}{border}) {
+ my $border_color = $self->_get_color('legend.border')
+ or return;
+ $img->box(xmin=>$box[0], ymin=>$box[1], xmax=>$box[2], ymax=>$box[3],
+ color=>$border_color);
+ }
+ $self->_remove_box($chart_box, \@box);
+ 1;
+}
+
+sub _draw_legend_vertical {
+ my ($self, $img, $labels, $chart_box) = @_;
+
+ defined(my $padding = $self->_get_integer('legend.padding'))
or return;
- my $patchsize = $self->_get_number('legend.patchsize')
+ my $patchsize = $self->_get_integer('legend.patchsize')
or return;
- defined(my $gap = $self->_get_number('legend.patchgap'))
+ defined(my $gap = $self->_get_integer('legend.patchgap'))
or return;
my $minrowsize = $patchsize + $gap;
my ($width, $height) = (0,0);
my @sizes;
for my $label (@$labels) {
- my @box = $self->_text_bbox($label, 'legend');
+ my @box = $self->_text_bbox($label, 'legend')
+ or return;
push(@sizes, \@box);
$width = $box[2] if $box[2] > $width;
if ($minrowsize > $box[3]) {
}
}
my @box = (0, 0,
- $width + $patchsize + $padding * 2 + $gap,
- $height + $padding * 2 - $gap);
+ $width + $patchsize + $padding * 2 + $gap,
+ $height + $padding * 2 - $gap);
my $outsidepadding = 0;
if ($self->{_style}{legend}{border}) {
- defined($outsidepadding = $self->_get_number('legend.outsidepadding'))
+ defined($outsidepadding = $self->_get_integer('legend.outsidepadding'))
or return;
$box[2] += 2 * $outsidepadding;
$box[3] += 2 * $outsidepadding;
ymin=>$box[1]+$outsidepadding,
xmax=>$box[2]-$outsidepadding,
ymax=>$box[3]-$outsidepadding,
- $self->_get_fill('legend.fill', \@box));
+ $self->_get_fill('legend.fill', \@box));
}
$box[0] += $outsidepadding;
$box[1] += $outsidepadding;
for my $label (@$labels) {
my @patchbox = ( $patchpos - $patchsize/2, $ypos - $patchsize/2,
$patchpos + $patchsize * 3 / 2, $ypos + $patchsize*3/2 );
- my @fill = $self->_data_fill($dataindex, \@patchbox)
- or return;
+
+ my @fill;
+ if ($self->_draw_flat_legend()) {
+ @fill = (color => $self->_data_color($dataindex), filled => 1);
+ }
+ else {
+ @fill = $self->_data_fill($dataindex, \@patchbox)
+ or return;
+ }
$img->box(xmin=>$patchpos, ymin=>$ypos, xmax=>$patchpos + $patchsize,
- ymax=>$ypos + $patchsize, @fill);
+ ymax=>$ypos + $patchsize, @fill);
if ($self->{_style}{legend}{patchborder}) {
$img->box(xmin=>$patchpos, ymin=>$ypos, xmax=>$patchpos + $patchsize,
- ymax=>$ypos + $patchsize,
- color=>$patchborder);
+ ymax=>$ypos + $patchsize,
+ color=>$patchborder);
}
$img->string(%text_info, x=>$textpos, 'y'=>$ypos + $patchsize,
text=>$label);
my $border_color = $self->_get_color('legend.border')
or return;
$img->box(xmin=>$box[0], ymin=>$box[1], xmax=>$box[2], ymax=>$box[3],
- color=>$border_color);
+ color=>$border_color);
}
$self->_remove_box($chart_box, \@box);
1;
my ($self, $img, $chart_box) = @_;
my $title = $self->{_style}{title}{text};
- my @box = $self->_text_bbox($title, 'title');
+ my @box = $self->_text_bbox($title, 'title')
+ or return;
my $yoff = $box[1];
@box[0,1] = (0,0);
$self->_align_box(\@box, $chart_box, 'title');
- my %text_info = $self->_text_style('title');
+ my %text_info = $self->_text_style('title')
+ or return;
$img->string(%text_info, x=>$box[0], 'y'=>$box[3] + $yoff, text=>$title);
$self->_remove_box($chart_box, \@box);
1;
}
}
+sub _draw_flat_legend {
+ return 0;
+}
+
=item _composite()
Returns a list of style fields that are stored as composites, and
=cut
sub _composite {
- qw(title legend text label dropshadow outline callout);
+ qw(title legend text label dropshadow outline callout graph);
}
sub _filter_region {
$left > 0 or $left = 0;
$top > 0 or $top = 0;
- # newer versions of Imager let you work on just part of an image
- if ($img->can('masked') && !$self->{_style}{features}{_debugblur}) {
- my $masked = $img->masked(left=>$left, top=>$top,
- right=>$right, bottom=>$bottom);
- $masked->filter(%$filter);
+ my $masked = $img->masked(left=>$left, top=>$top,
+ right=>$right, bottom=>$bottom);
+ $masked->filter(%$filter);
+}
+
+=item _line(x1 => $x1, y1 => $y1, ..., style => $style)
+
+Wrapper for line drawing, implements styles Imager doesn't.
+
+Currently styles are limited to horizontal and vertical lines.
+
+=cut
+
+sub _line {
+ my ($self, %opts) = @_;
+
+ my $img = delete $opts{img}
+ or die "No img supplied to _line()";
+ my $style = delete $opts{style} || "solid";
+
+ if ($style eq "solid" || ($opts{x1} != $opts{x2} && $opts{y1} != $opts{y2})) {
+ return $img->line(%opts);
+ }
+ elsif ($style eq 'dashed' || $style eq 'dotted') {
+ my ($x1, $y1, $x2, $y2) = delete @opts{qw/x1 y1 x2 y2/};
+ # the line is vertical or horizontal, so swapping doesn't hurt
+ $x1 > $x2 and ($x1, $x2) = ($x2, $x1);
+ $y1 > $y2 and ($y1, $y2) = ($y2, $y1);
+ my ($stepx, $stepy) = ( 0, 0 );
+ my $step_size = $style eq "dashed" ? 8 : 2;
+ my ($counter, $count_end);
+ if ($x1 == $x2) {
+ $stepy = $step_size;
+ ($counter, $count_end) = ($y1, $y2);
+ }
+ else {
+ $stepx = $step_size;
+ ($counter, $count_end) = ($x1, $x2);
+ }
+ my ($x, $y) = ($x1, $y1);
+ while ($counter < $count_end) {
+ if ($style eq "dotted") {
+ $img->setpixel(x => $x, y => $y, color => $opts{color});
+ }
+ else {
+ my $xe = $stepx ? $x + $stepx / 2 - 1 : $x;
+ $xe > $x2 and $xe = $x2;
+ my $ye = $stepy ? $y + $stepy / 2 - 1 : $y;
+ $ye > $y2 and $ye = $y2;
+ $img->line(x1 => $x, y1 => $y, x2 => $xe, y2 => $ye, %opts);
+ }
+ $counter += $step_size;
+ $x += $stepx;
+ $y += $stepy;
+ }
+
+ return 1;
}
else {
- # for older versions of Imager
- my $subset = $img->crop(left=>$left, top=>$top,
- right=>$right, bottom=>$bottom);
- $subset->filter(%$filter);
- $img->paste(left=>$left, top=>$top, img=>$subset);
+ $self->_error("Unknown line style $style");
+ return;
+ }
+}
+
+=item _box(xmin ..., style => $style)
+
+A wrapper for drawing styled box outlines.
+
+=cut
+
+sub _box {
+ my ($self, %opts) = @_;
+
+ my $style = delete $opts{style} || "solid";
+ my $img = delete $opts{img}
+ or die "No img supplied to _box";
+
+ if ($style eq "solid") {
+ return $img->box(%opts);
+ }
+ else {
+ my $box = delete $opts{box};
+ # replicate Imager's defaults
+ my %work_opts = ( xmin => 0, ymin => 0, xmax => $img->getwidth() - 1, ymax => $img->getheight() -1, %opts, style => $style, img => $img );
+ my ($xmin, $ymin, $xmax, $ymax) = delete @work_opts{qw/xmin ymin xmax ymax/};
+ if ($box) {
+ ($xmin, $ymin, $xmax, $ymax) = @$box;
+ }
+ $xmin > $xmax and ($xmin, $xmax) = ($xmax, $xmin);
+ $ymin > $ymax and ($ymin, $ymax) = ($ymax, $ymin);
+
+ if ($xmax - $xmin > 1) {
+ $self->_line(x1 => $xmin+1, y1 => $ymin, x2 => $xmax-1, y2 => $ymin, %work_opts);
+ $self->_line(x1 => $xmin+1, y1 => $ymax, x2 => $xmax-1, y2 => $ymax, %work_opts);
+ }
+ $self->_line(x1 => $xmin, y1 => $ymin, x2 => $xmin, y2 => $ymax, %work_opts);
+ return $self->_line(x1 => $xmax, y1 => $ymin, x2 => $xmax, y2 => $ymax, %work_opts);
+ }
+}
+
+=item _feature_enabled($feature_name)
+
+Check if the given feature is enabled in the work style.
+
+=cut
+
+sub _feature_enabled {
+ my ($self, $name) = @_;
+
+ return $self->{_style}{features}{$name};
+}
+
+sub _line_marker {
+ my ($self, $index) = @_;
+
+ my $markers = $self->{'_style'}{'line_markers'};
+ if (!$markers) {
+ return;
+ }
+ my $marker = $markers->[$index % @$markers];
+
+ return $marker;
+}
+
+sub _draw_line_marker {
+ my $self = shift;
+ my ($x1, $y1, $series_counter) = @_;
+
+ my $img = $self->_get_image();
+
+ my $style = $self->_line_marker($series_counter);
+ return unless $style;
+
+ my $type = $style->{'shape'};
+ my $radius = $style->{'radius'};
+
+ my $line_aa = $self->_get_number("lineaa");
+ my $fill_aa = $self->_get_number("fill.aa");
+
+ if ($type eq 'circle') {
+ my @fill = $self->_data_fill($series_counter, [$x1 - $radius, $y1 - $radius, $x1 + $radius, $y1 + $radius]);
+ $img->circle(x => $x1, y => $y1, r => $radius, aa => $fill_aa, filled => 1, @fill);
+ }
+ elsif ($type eq 'open_circle') {
+ my $color = $self->_data_color($series_counter);
+ $img->circle(x => $x1, y => $y1, r => $radius, aa => $fill_aa, filled => 0, color => $color);
+ }
+ elsif ($type eq 'open_square') {
+ my $color = $self->_data_color($series_counter);
+ $img->box(xmin => $x1 - $radius, ymin => $y1 - $radius, xmax => $x1 + $radius, ymax => $y1 + $radius, filled => 0, color => $color);
+ }
+ elsif ($type eq 'open_triangle') {
+ my $color = $self->_data_color($series_counter);
+ $img->polyline(
+ points => [
+ [$x1 - $radius, $y1 + $radius],
+ [$x1 + $radius, $y1 + $radius],
+ [$x1, $y1 - $radius],
+ [$x1 - $radius, $y1 + $radius],
+ ],
+ color => $color, aa => $line_aa);
+ }
+ elsif ($type eq 'open_diamond') {
+ my $color = $self->_data_color($series_counter);
+ $img->polyline(
+ points => [
+ [$x1 - $radius, $y1],
+ [$x1, $y1 + $radius],
+ [$x1 + $radius, $y1],
+ [$x1, $y1 - $radius],
+ [$x1 - $radius, $y1],
+ ],
+ color => $color, aa => $line_aa);
+ }
+ elsif ($type eq 'square') {
+ my @fill = $self->_data_fill($series_counter, [$x1 - $radius, $y1 - $radius, $x1 + $radius, $y1 + $radius]);
+ $img->box(xmin => $x1 - $radius, ymin => $y1 - $radius, xmax => $x1 + $radius, ymax => $y1 + $radius, @fill);
+ }
+ elsif ($type eq 'diamond') {
+ # The gradient really doesn't work for diamond
+ my $color = $self->_data_color($series_counter);
+ $img->polygon(
+ points => [
+ [$x1 - $radius, $y1],
+ [$x1, $y1 + $radius],
+ [$x1 + $radius, $y1],
+ [$x1, $y1 - $radius],
+ ],
+ filled => 1, color => $color, aa => $fill_aa);
+ }
+ elsif ($type eq 'triangle') {
+ # The gradient really doesn't work for triangle
+ my $color = $self->_data_color($series_counter);
+ $img->polygon(
+ points => [
+ [$x1 - $radius, $y1 + $radius],
+ [$x1 + $radius, $y1 + $radius],
+ [$x1, $y1 - $radius],
+ ],
+ filled => 1, color => $color, aa => $fill_aa);
+
+ }
+ elsif ($type eq 'x') {
+ my $color = $self->_data_color($series_counter);
+ $img->line(x1 => $x1 - $radius, y1 => $y1 -$radius, x2 => $x1 + $radius, y2 => $y1+$radius, aa => $line_aa, color => $color) || die $img->errstr;
+ $img->line(x1 => $x1 + $radius, y1 => $y1 -$radius, x2 => $x1 - $radius, y2 => $y1+$radius, aa => $line_aa, color => $color) || die $img->errstr;
+ }
+ elsif ($type eq 'plus') {
+ my $color = $self->_data_color($series_counter);
+ $img->line(x1 => $x1, y1 => $y1 -$radius, x2 => $x1, y2 => $y1+$radius, aa => $line_aa, color => $color) || die $img->errstr;
+ $img->line(x1 => $x1 + $radius, y1 => $y1, x2 => $x1 - $radius, y2 => $y1, aa => $line_aa, color => $color) || die $img->errstr;
}
}
1;
+
__END__
=back
projects / imager-graph.git / blobdiff