package Imager::Graph;
+require 5.005;
=head1 NAME
built-in styles and modifications supplied by the user to the draw()
method.
-For best results you need a version of Imager after 0.38. At the time
-of writing this is only available via CVS:
-
- cvs -d :pserver:anoncvs@cvs.imager.perl.org:/u02/cvsroot login
- cvs -d :pserver:anoncvs@cvs.imager.perl.org:/u02/cvsroot co Imager
-
-This provides extra file format support, fountain (gradient), hatch
-and image fills, and masked images.
-
=over
=cut
use strict;
use vars qw($VERSION);
use Imager qw(:handy);
+use Imager::Fountain;
-$VERSION = '0.03';
-
-my $fancy_fills = 0;
-my ($im_version) = ($Imager::VERSION =~ /(\d\.[\d_]+)/);
-if ($im_version > 0.38) {
- ++$fancy_fills;
- require 'Imager/Fountain.pm';
-}
+$VERSION = '0.05';
# the maximum recursion depth in determining a color, fill or number
use constant MAX_DEPTH => 10;
=over
+=item primary
+
+a light grey background with no outlines. Uses primary colors for the
+data fills.
+
+This is the default style.
+
=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
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
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
pconlyformat => sub { sprintf "%.1f%%", $_[0] },
},
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)',
\%style_defs;
}
-my $def_style = 'primary_red';
+my $def_style = 'primary';
my %styles =
(
+ primary =>
+ {
+ fills=>
+ [
+ qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF)
+ ],
+ fg=>'000000',
+ bg=>'E0E0E0',
+ legend=>
+ {
+ #patchborder=>'000000'
+ },
+ },
primary_red =>
{
fills=>
blur=>undef,
},
},
- );
-
-if ($fancy_fills) {
- $styles{fount_lin} =
+ fount_lin =>
{
fills=>
[
{ 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') ]),
},
fg=>'000000',
bg=>'FFFFFF',
features=>{ dropshadow=>1 },
- };
- $styles{fount_rad} =
- {
+ },
+ fount_rad =>
+ {
fills=>
[
{ fountain=>'radial',
colors=>[ NC('6060FF'), NC('60FF60') ]) },
fg=>'000000',
bg=>'FFFFFF',
- };
-}
+ }
+ );
=item $self->_style_setup(\%opts)
=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
=cut
+
sub _get_number {
my ($self, $name, @depth) = @_;
}
}
+=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.
+
+=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.
}
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;
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/) {
return ( fill=>\%work );
}
else {
- return ( fill=> $what );
+ return ( fill=> \%work );
}
}
}
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');
+ 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);
$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;
Tony Cook <tony@develop-help.com>
+=head1 LICENSE
+
+Imager::Graph is licensed under the same terms as perl itself.
+
=head1 BLAME
Addi for producing a cool imaging module. :)
projects / imager-graph.git / blobdiff