use Imager::Graph::SubClass;
my $chart = Imager::Graph::SubClass->new;
- my $img = $chart->draw(data=>..., ...)
+ my $img = $chart->draw(data=> \@data, ...)
or die $chart->error;
=head1 DESCRIPTION
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 Imager qw(:handy);
use Imager::Fountain;
-$VERSION = '0.05';
+$VERSION = '0.06';
# the maximum recursion depth in determining a color, fill or number
use constant MAX_DEPTH => 10;
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
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)',
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',
+ bg=>'E0E0E0',
+ legend=>
+ {
+ #patchborder=>'000000'
+ },
+ },
primary_red =>
{
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') ]),
},
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
}
}
+=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 {
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;
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 _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;
$img;
}
+=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.
+
+=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;
}
+=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);
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]) {
$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;
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;
projects / imager-graph.git / blobdiff