=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
+
+sub error {
+ $_[0]->{_errstr};
+}
+
+=item draw
+
+Creates a new image, draws the chart onto that image and returns it.
+
+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
+
+You can also supply many different parameters which control the way
+the graph looks. These are supplied as keyword, value pairs, where
+the value can be a hashref containing sub values.
+
+The C<style> parameter will selects a basic color set, and possibly
+sets other related parameters. See L</"STYLES">.
+
+ 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'.
+
+Returns the graph image on success, or false on failure.
+
+=back
+
+=head1 STYLES
+
+The currently defined styles are:
+
+=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.
+
+Graphs drawn using this style should save well as a gif, even though
+some graphs may perform a slight blur.
+
+This was the default style, but the red was too loud.
+
+=item mono
+
+designed for monochrome output, such as most laser printers, this uses
+hatched fills for the data, and no colors. The returned image is a
+one channel image (which can be overridden with the C<channels>
+parameter.)
+
+You can also override the colors used by all components for background
+or drawing by supplying C<fg> and/or C<bg> parameters. ie. if you
+supply C<<fg=>'FF0000', channels=>3>> then the hash fills and anything
+else will be drawn in red. Another use might be to set a transparent
+background, by supplying C<<bg=>'00000000', channels=>4>>.
+
+This style outlines the legend if present and outlines the hashed fills.
+
+=item fount_lin
+
+designed as a "pretty" style this uses linear fountain fills for the
+background and data fills, and adds a drop shadow.
+
+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
+the data and a linear blue to green fill for the background.
+
+=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 error {
- $_[0]->{_errstr};
+sub set_data_area_fills {
+ $_[0]->{'custom_style'}->{'fills'} = $_[1];
}
-=item draw
-
-Creates a new image, draws the chart onto that image and returns it.
+=item set_data_line_colors
-Typically you will need to 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
+=cut
-You can also supply many different parameters which control the way
-the graph looks. These are supplied as keyword, value pairs, where
-the value can be a hashref containing sub values.
+sub set_data_line_colors {
+ $_[0]->{'custom_style'}->{'colors'} = $_[1];
+}
-The C<style> parameter will selects a basic color set, and possibly
-sets other related parameters. See L</"STYLES">.
+=back
- my $img = $graph->draw(data=>\@data,
- title=>{ text=>"Hello, World!",
- size=>36,
- color=>'FF0000' });
+=head1 FEATURES
-When referring to a single sub-value this documentation will refer to
-'title.color' rather than 'the color element of title'.
+Each graph type has a number of features. These are used to add
+various items that are displayed in the graph area. Some common
+methods are:
-Returns the graph image on success, or false on failure.
+=over
-=back
+=item show_legend()
-=head1 STYLES
+adds a box containing boxes filled with the data filess, 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.
-The currently defined styles are:
+=cut
-=over
+sub show_legend {
+ $_[0]->{'custom_style'}->{'features'}->{'legend'} = 1;
+}
-=item primary
+=item show_outline()
-a light grey background with no outlines. Uses primary colors for the
-data fills.
+draws a border around the data areas.
-This is the default style.
+=cut
-=item primary_red
+sub show_outline {
+ $_[0]->{'custom_style'}->{'features'}->{'outline'} = 1;
+}
-a light red background with no outlines. Uses primary colors for the
-data fills.
+=item show_labels()
-Graphs drawn using this style should save well as a gif, even though
-some graphs may perform a slight blur.
+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.
-This was the default style, but the red was too loud.
+=cut
-=item mono
+sub show_labels {
+ $_[0]->{'custom_style'}->{'features'}->{'labels'} = 1;
+}
-designed for monochrome output, such as most laser printers, this uses
-hatched fills for the data, and no colors. The returned image is a
-one channel image (which can be overridden with the C<channels>
-parameter.)
+=item show_drop_shadow()
-You can also override the colors used by all components for background
-or drawing by supplying C<fg> and/or C<bg> parameters. ie. if you
-supply C<<fg=>'FF0000', channels=>3>> then the hash fills and anything
-else will be drawn in red. Another use might be to set a transparent
-background, by supplying C<<bg=>'00000000', channels=>4>>.
+a simple drop shadow is shown behind some of the graph elements.
-This style outlines the legend if present and outlines the hashed fills.
+=cut
-=item fount_lin
+sub show_drop_shadow {
+ $_[0]->{'custom_style'}->{'features'}->{'dropshadow'} = 1;
+}
-designed as a "pretty" style this uses linear fountain fills for the
-background and data fills, and adds a drop shadow.
+=item reset_features()
-You can override the value used for text and outlines by setting the
-C<fg> parameter.
+Unsets all of the features
-=item fount_rad
+=cut
-also designed as a "pretty" style this uses radial fountain fills for
-the data and a linear blue to green fill for the background.
+sub reset_features {
+ $_[0]->{'custom_style'}->{'features'} = {};
+ $_[0]->{'custom_style'}->{'features'}->{'reset'} = 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:
+Additionally, features can be set by passing them into the draw() method:
=over
default style information contains:
text=>{
- color=>'lookup(fg)',
+ color=>'lookup(fg)',
...
},
legend =>{
- color=>'lookup(text.color)',
+ color=>'lookup(text.color)',
...
},
(
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';
+# 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 =
(
qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF)
],
fg=>'000000',
+ negative_bg=>'EEEEEE',
bg=>'E0E0E0',
legend=>
{
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,
},
fount_lin =>
{
{ fountain=>'linear',
xa_ratio=>0.13, ya_ratio=>0.13, xb_ratio=>0.87, yb_ratio=>0.87,
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
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 {
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;
}
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 {
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 {
# default to normal combine mode
my %work = ( combine => 'normal', %$what );
if ($what->{hatch}) {
- 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}) {
- 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=> \%work );
+ 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 {
my @sizes;
my @offsets;
for my $label (@$labels) {
- my @text_box = $self->_text_bbox($label, 'legend');
+ 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) {
}
else {
if ($pos + $gap + $entry_width > $chart_box->[2]) {
- $pos = 0;
- $height += $row_height;
+ $pos = 0;
+ $height += $row_height;
}
push @offsets, [ $pos, $height ];
}
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;
my @fill = $self->_data_fill($dataindex, \@patchbox)
or return;
$img->box(xmin=>$left, ymin=>$top, xmax=>$left + $patchsize,
- ymax=>$top + $patchsize, @fill);
+ ymax=>$top + $patchsize, @fill);
if ($self->{_style}{legend}{patchborder}) {
$img->box(xmin=>$left, ymin=>$top, xmax=>$left + $patchsize,
- ymax=>$top + $patchsize,
- color=>$patchborder);
+ ymax=>$top + $patchsize,
+ color=>$patchborder);
}
$img->string(%text_info, x=>$textpos, 'y'=>$top + $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 ($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_integer('legend.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 {
+ $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 {
- # 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);
+ 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 => $xmin, y1 => $ymin, x2 => $xmin, y2 => $ymax, %work_opts);
}
}
projects / imager-graph.git / blobdiff