Imager-Graph
view release on metacpan or search on metacpan
- the mono style now disables anti-aliasing by default
[*] this was the oldest open bug on rt.cpan.org, now #7 is, still an
Imager-Graph issue
Imager-Graph 0.06 - 21 April 2008
=================
- Removed ancient Imager cruft from the documentation
- round the dimensions used within the legend to integers to prevent
later truncation from causing uneven output.
- add horizontal legend boxes
- add a new style "primary" which is primary_red with a light grey
background, and made that the default, so the default graphs aren't
quite so ugly.
- zero-sized segments were drawn as covering the whole pie. Skip
drawing zero sized segments.
https://rt.cpan.org/Ticket/Display.html?id=34813
- round the pie radius down to avoid running over the edge of the
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 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];
}
Each graph type has a number of features. These are used to add
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 show_legend()
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.
=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.
=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.
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
size of the title text. Default: double I<text.size>
=item halign
=item valign
The horizontal and vertical alignment of the title.
=back
=item legend
defines attributes of the graph legend, if present.
=over
=item color
=item font
=item size
text attributes for the labels used in the legend.
=item patchsize
the width and height of the color patch in the legend. Defaults to
90% of the legend text size.
=item patchgap
the minimum gap between patches in pixels. Defaults to 30% of the
patchsize.
=item patchborder
the color of the border drawn around each patch. Inherited from I<line>.
=item halign
=item valign
the horizontal and vertical alignment of the legend within the graph.
Defaults to 'right' and 'top'.
=item padding
the gap between the legend patches and text and the outside of its
box, or to the legend border, if any.
=item outsidepadding
the gap between the border and the outside of the legend's box. This
is only used if the I<legend.border> attribute is defined.
=item fill
the background fill for the legend. Default: none
=item border
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
example if you give a color as "lookup(fg)" then Imager::Graph will
look for the fg element in the current style (or as overridden by
you.) This is used internally by Imager::Graph to set up the
relationships between the colors of various elements, for example the
default style information contains:
text=>{
color=>'lookup(fg)',
...
},
legend =>{
color=>'lookup(text.color)',
...
},
So by setting the I<fg> color, you also set the default text color,
since each text element uses lookup(text.color) as its value.
=head2 Specifying fills
Fills can be used for the graph background color, the background 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.
You don't need (or usually want) to call Imager::Fill::new yourself,
since the various fill functions will call it for you, and
Imager::Graph provides some hooks to make them more useful.
=over
aa => 'lookup(aa)',
},
title=>{
color => 'lookup(text.color)',
font => 'lookup(text.font)',
halign => 'center',
valign => 'top',
size => 'scale(text.size,2.0)',
aa => 'lookup(text.aa)',
},
legend =>{
color => 'lookup(text.color)',
font => 'lookup(text.font)',
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)',
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)',
(
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=>
{
patchborder=>'000000'
},
},
mono =>
{
fills=>
[
{ hatch=>'slash2' },
{ hatch=>'slosh2' },
if ($object_box->[0] - $chart_box->[0]
< $chart_box->[2] - $object_box->[2]) {
$chart_box->[0] = $object_box->[2];
}
else {
$chart_box->[2] = $object_box->[0];
}
}
}
sub _draw_legend {
my ($self, $img, $labels, $chart_box) = @_;
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;
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_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 @sizes;
for my $label (@$labels) {
my @box = $self->_text_bbox($label, 'legend')
or return;
push(@sizes, \@box);
$width = $box[2] if $box[2] > $width;
if ($minrowsize > $box[3]) {
$height += $minrowsize;
}
else {
$height += $box[3];
}
}
my @box = (0, 0,
$width + $patchsize + $padding * 2 + $gap,
$height + $padding * 2 - $gap);
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 $ypos = $box[1] + $padding;
my $patchpos = $box[0]+$padding;
my $textpos = $patchpos + $patchsize + $gap;
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 @patchbox = ( $patchpos - $patchsize/2, $ypos - $patchsize/2,
$patchpos + $patchsize * 3 / 2, $ypos + $patchsize*3/2 );
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);
if ($self->{_style}{legend}{patchborder}) {
$img->box(xmin=>$patchpos, ymin=>$ypos, xmax=>$patchpos + $patchsize,
ymax=>$ypos + $patchsize,
color=>$patchborder);
}
$img->string(%text_info, x=>$textpos, 'y'=>$ypos + $patchsize,
text=>$label);
my $step = $patchsize + $gap;
if ($minrowsize < $sizes[$dataindex][3]) {
$ypos += $sizes[$dataindex][3];
}
else {
$ypos += $minrowsize;
}
++$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_title {
my ($self, $img, $chart_box) = @_;
my ($self, $box) = @_;
if ($box->[2] - $box->[0] > $box->[3] - $box->[1]) {
return $box->[3] - $box->[1];
}
else {
return $box->[2] - $box->[0];
}
}
sub _draw_flat_legend {
return 0;
}
=item _composite()
Returns a list of style fields that are stored as composites, and
should be merged instead of just being replaced.
=cut
sub _composite {
qw(title legend text label dropshadow outline callout graph);
}
sub _filter_region {
my ($self, $img, $left, $top, $right, $bottom, $filter) = @_;
unless (ref $filter) {
my $name = $filter;
$filter = $self->_get_thing($name)
or return;
$filter->{type}
t/t20api.t
t/t21style_api.t
t/t30many_points.t
t/t31tic_color.t
t/t32series_labels.t
t/t33_long_labels.t
t/t34horizontal_many_points.t
t/t40area.t
t/t91pod.t
t/t93podcover.t
testimg/t10_hlegend.png
testimg/t10_lin_fount.png Test output comparison images
testimg/t10_mono.png
testimg/t10_noother.png
testimg/t10_pie1.png
testimg/t10_pie2.png
testimg/t10_rad_fount.png
testimg/t14_bar.png
testimg/t30_points.png
testimg/t31tic_color.png
testimg/t31tic_color_CMA.png
The aim is to make things as simple as possible, if you have some data
you can create a pie chart with:
use Imager::Graph::Pie;
my $font = Imager::Font->new(file=>$fontfile)
or die "Cannot create font: ",Imager->errstr;
my $pie_graph = Imager::Graph::Pie->new();
my $img = $pie_graph->draw(data=>\@data);
If you want to add a legend, you need to provide some descriptive text
as well:
my $img = $pie_graph->draw(data=>\@data, labels=>\@labels, font=>$font,
features=>'legend');
You might want to add a title instead:
my $img = $pie_graph->draw(data=>\@data, font=>$font, title=>'MyGraph');
or instead of a legend, use callouts to annotate each segment:
my $img = $pie_graph->draw(data=>\@data, labels=>\@labels,
features=>'allcallouts', font=>$font);
(The following graphs use features introduce after Imager 0.38.)
If you want draw a monochrome pie graph, using hatched fills, specify
the 'mono' style:
my $img = $pie_graph->draw(data=>\@data, style=>'mono');
lib/Imager/Graph/Area.pm view on Meta::CPAN
use Imager::Graph::Area;
use Imager::Font;
my $font = Imager::Font->new(file => '/path/to/font.ttf') || die "Error: $!";
my $graph = Imager::Graph::Area->new();
$graph->set_image_width(900);
$graph->set_image_height(600);
$graph->set_font($font);
$graph->use_automatic_axis();
$graph->show_legend();
my @data = (1, 2, 3, 5, 7, 11);
my @labels = qw(one two three five seven eleven);
$graph->add_data_series(\@data, 'Primes');
$graph->set_labels(\@labels);
my $img = $graph->draw() || die $graph->error;
$img->write(file => 'area.png');
lib/Imager/Graph/Bar.pm view on Meta::CPAN
use Imager::Graph::Bar;
use Imager::Font;
my $font = Imager::Font->new(file => '/path/to/font.ttf') || die "Error: $!";
my $graph = Imager::Graph::Bar->new();
$graph->set_image_width(900);
$graph->set_image_height(600);
$graph->set_font($font);
$graph->use_automatic_axis();
$graph->show_legend();
my @data = (1, 2, 3, 5, 7, 11);
my @labels = qw(one two three five seven eleven);
$graph->add_data_series(\@data, 'Primes');
$graph->set_labels(\@labels);
my $img = $graph->draw() || die $graph->error;
$img->write(file => 'bars.png');
lib/Imager/Graph/Column.pm view on Meta::CPAN
use Imager::Graph::Column;
use Imager::Font;
my $font = Imager::Font->new(file => '/path/to/font.ttf') || die "Error: $!";
my $graph = Imager::Graph::Column->new();
$graph->set_image_width(900);
$graph->set_image_height(600);
$graph->set_font($font);
$graph->use_automatic_axis();
$graph->show_legend();
my @data = (1, 2, 3, 5, 7, 11);
my @labels = qw(one two three five seven eleven);
$graph->add_data_series(\@data, 'Primes');
$graph->set_labels(\@labels);
my $img = $graph->draw() || die $graph->error;
$img->write(file => 'columns.png');
lib/Imager/Graph/Horizontal.pm view on Meta::CPAN
$self->_make_img
or return;
my $img = $self->_get_image()
or return;
my @image_box = ( 0, 0, $img->getwidth-1, $img->getheight-1 );
$self->_set_image_box(\@image_box);
my @chart_box = ( 0, 0, $img->getwidth-1, $img->getheight-1 );
$self->_draw_legend(\@chart_box);
if ($style->{title}{text}) {
$self->_draw_title($img, \@chart_box)
or return;
}
# Scale the graph box down to the widest graph that can cleanly hold the # of columns.
return unless $self->_get_data_range();
$self->_remove_tics_from_chart_box(\@chart_box, \%opts);
my $column_count = $self->_get_column_count();
lib/Imager/Graph/Horizontal.pm view on Meta::CPAN
$column_count++;
if ($value > $max_value) { $max_value = $value; }
if ($value < $min_value) { $min_value = $value; }
}
}
return ($min_value, $max_value, $column_count);
}
sub _draw_legend {
my $self = shift;
my $chart_box = shift;
my $style = $self->{'_style'};
my @labels;
my $img = $self->_get_image();
if (my $series = $self->_get_data_series()->{'bar'}) {
push @labels, map { $_->{'series_name'} } @$series;
}
if ($style->{features}{legend} && (scalar @labels)) {
$self->SUPER::_draw_legend($self->_get_image(), \@labels, $chart_box)
or return;
}
return;
}
sub _draw_flat_legend {
return 1;
}
sub _draw_lines {
my $self = shift;
my $style = $self->{'_style'};
my $img = $self->_get_image();
my $max_value = $self->_get_max_value();
lib/Imager/Graph/Horizontal.pm view on Meta::CPAN
my $tic_height = $self->_get_x_tic_height() || 10;
my @x_tic_box = ($chart_box->[0], $chart_box->[3] - $tic_height, $chart_box->[2], $chart_box->[3]);
$self->_remove_box($chart_box, \@y_tic_box);
$self->_remove_box($chart_box, \@x_tic_box);
# If there's no title, the y-tics will be part off-screen. Half of the x-tic height should be more than sufficient.
my @y_tic_tops = ($chart_box->[0], $chart_box->[1], $chart_box->[2], $chart_box->[1] + int($tic_height / 2));
$self->_remove_box($chart_box, \@y_tic_tops);
if (my @box = $self->_text_bbox($self->_get_max_value(), 'legend')) {
my @remove_box = ($chart_box->[2] - int($box[2] / 2) - 1,
$chart_box->[1],
$chart_box->[2],
$chart_box->[3]
);
$self->_remove_box($chart_box, \@remove_box);
}
lib/Imager/Graph/Horizontal.pm view on Meta::CPAN
sub _get_y_tic_width {
my ($self, $opts) = @_;
my $labels = $self->_get_labels($opts);
if (!$labels) {
return;
}
my %text_info = $self->_text_style('legend')
or return;
my $max_width = 0;
foreach my $label (@$labels) {
my @box = $self->_text_bbox($label, 'legend');
my $width = $box[2] + 5;
# For the tic itself...
$width += 10;
if ($width > $max_width) {
$max_width = $width;
}
}
return $max_width;
}
sub _get_x_tic_height {
my $self = shift;
my $min = $self->_get_min_value();
my $max = $self->_get_max_value();
my $tic_count = $self->_get_x_tics();
my $interval = ($max - $min) / ($tic_count - 1);
my %text_info = $self->_text_style('legend')
or return;
my $max_height = 0;
for my $count (0 .. $tic_count - 1) {
my $value = sprintf("%.2f", ($count*$interval)+$min);
my @box = $self->_text_bbox($value, 'legend');
my $height = $box[3] - $box[1];
# For the tic width
$height += 10;
if ($height > $max_height) {
$max_height = $height;
}
}
lib/Imager/Graph/Horizontal.pm view on Meta::CPAN
my $tic_count = (scalar @$labels) - 1;
my $has_columns = defined $self->_get_data_series()->{'bar'};
# If we have columns, we want the x-ticks to show up in the middle of the column, not on the left edge
my $denominator = $tic_count;
if ($has_columns) {
$denominator ++;
}
my $tic_distance = ($graph_box->[3] - $graph_box->[1]) / ($denominator);
my %text_info = $self->_text_style('legend')
or return;
for my $count (0 .. $tic_count) {
my $label = $labels->[$count];
my $x1 = $graph_box->[0] - 5;
my $x2 = $graph_box->[0] + 5;
my $y1 = $graph_box->[1] + ($tic_distance * $count);
if ($has_columns) {
$y1 += $tic_distance / 2;
}
$img->line(x1 => $x1, x2 => $x2, y1 => $y1, y2 => $y1, aa => 1, color => '000000');
my @box = $self->_text_bbox($label, 'legend')
or return;
my $width = $box[2];
my $height = $box[3];
$img->string(%text_info,
x => ($x1 - ($width + 5)),
y => ($y1 + ($height / 2)),
text => $label
);
lib/Imager/Graph/Horizontal.pm view on Meta::CPAN
my $image_box = $self->_get_image_box();
my $tic_count = $self->_get_x_tics();
my $min = $self->_get_min_value();
my $max = $self->_get_max_value();
my $interval = ($max - $min) / ($tic_count - 1);
# If we have columns, we want the x-ticks to show up in the middle of the column, not on the left edge
my $tic_distance = ($graph_box->[2] - $graph_box->[0]) / ($tic_count -1);
my %text_info = $self->_text_style('legend')
or return;
my $show_gridlines = $self->{_style}{features}{'vertical_gridlines'};
my @grid_line = $self->_get_line("vgrid");
for my $count (0 .. $tic_count-1) {
my $x1 = $graph_box->[0] + ($tic_distance * $count);
my $y1 = $graph_box->[3] + 5;
my $y2 = $graph_box->[3] - 5;
my $value = ($count*$interval)+$min;
$img->line(x1 => $x1, x2 => $x1, y1 => $y1, y2 => $y2, aa => 1, color => '000000');
my @box = $self->_text_bbox($value, 'legend')
or return;
my $width = $box[2];
my $height = $box[3];
$img->string(%text_info,
x => ($x1 - ($width / 2)),
y => ($y1 + $height + 5),
text => $value
);
lib/Imager/Graph/Line.pm view on Meta::CPAN
use Imager::Graph::Line;
use Imager::Font;
my $font = Imager::Font->new(file => '/path/to/font.ttf') || die "Error: $!";
my $graph = Imager::Graph::Line->new();
$graph->set_image_width(900);
$graph->set_image_height(600);
$graph->set_font($font);
$graph->use_automatic_axis();
$graph->show_legend();
my @data = (1, 2, 3, 5, 7, 11);
my @labels = qw(one two three five seven eleven);
$graph->add_data_series(\@data, 'Primes');
$graph->set_labels(\@labels);
my $img = $graph->draw() || die $graph->error;
$img->write(file => 'lines.png');
lib/Imager/Graph/Pie.pm view on Meta::CPAN
sub show_label_percentages {
$_[0]->{'custom_style'}->{'features'}->{'labelspc'} = 1;
}
=back
Inherited features:
=over
=item legend
adds a legend to your graph. Requires the labels parameter
=item labels
labels each segment of the graph. If the label doesn't fit inside the
segment it is presented as a callout.
=item outline
the pie segments are outlined.
lib/Imager/Graph/Pie.pm view on Meta::CPAN
label the segments:
# error handling omitted for brevity from now on
$img = $pie->draw(data=>\@data, labels=>\@labels, features=>'labels');
just percentages in the segments:
$img = $pie->draw(data=>\@data, features=>'labelspconly');
add a legend as well:
$img = $pie->draw(data=>\@data, labels=>\@labels,
features=>[ 'labelspconly', 'legend' ]);
and a title, but move the legend down, and add a dropshadow:
$img = $pie->draw(data=>\@data, labels=>\@labels,
title=>'Netcraft Web Survey',
legend=>{ valign=>'bottom' },
features=>[ qw/labelspconly legend dropshadow/ ]);
something a bit prettier:
$img = $pie->draw(data=>\@data, labels=>\@labels,
style=>'fount_lin', features=>'legend');
suitable for monochrome output:
$img = $pie->draw(data=>\@data, labels=>\@labels,
style=>'mono', features=>'legend');
=cut
# this function is too long
sub draw {
my ($self, %opts) = @_;
my $data_series = $self->_get_data_series(\%opts);
$self->_valid_input($data_series)
lib/Imager/Graph/Pie.pm view on Meta::CPAN
}
my $total = 0;
for my $item (@data) {
$total += $item;
}
# consolidate any segments that are too small to display
$self->_consolidate_segments(\@data, \@labels, $total);
if ($style->{features}{legend} && (scalar @labels)) {
$self->_draw_legend($img, \@labels, \@chart_box)
or return;
}
# the following code is fairly ugly
# it attempts to work out a good layout for the components of the chart
my @info;
my $index = 0;
my $pos = 0;
my @ebox = (0, 0, 0, 0);
defined(my $callout_outside = $self->_get_number('callout.outside'))
lib/Imager/Graph/StackedColumn.pm view on Meta::CPAN
use Imager::Graph::StackedColumn;
use Imager::Font;
my $font = Imager::Font->new(file => '/path/to/font.ttf') || die "Error: $!";
my $graph = Imager::Graph::StackedColumn->new();
$graph->set_image_width(900);
$graph->set_image_height(600);
$graph->set_font($font);
$graph->use_automatic_axis();
$graph->show_legend();
my @data = (1, 2, 3, 5, 7, 11);
my @data2 = (1, 1, 1, 2, 2, 2);
my @labels = qw(one two three five seven eleven);
$graph->add_data_series(\@data, 'Primes');
$graph->add_data_series(\@data2, 'Numbers');
$graph->set_labels(\@labels);
my $img = $graph->draw() || die $graph->error;
lib/Imager/Graph/Vertical.pm view on Meta::CPAN
$self->_make_img
or return;
my $img = $self->_get_image()
or return;
my @image_box = ( 0, 0, $img->getwidth-1, $img->getheight-1 );
$self->_set_image_box(\@image_box);
my @chart_box = ( 0, 0, $img->getwidth-1, $img->getheight-1 );
$self->_draw_legend(\@chart_box);
if ($style->{title}{text}) {
$self->_draw_title($img, \@chart_box)
or return;
}
# Scale the graph box down to the widest graph that can cleanly hold the # of columns.
return unless $self->_get_data_range();
$self->_remove_tics_from_chart_box(\@chart_box, \%opts);
my $column_count = $self->_get_column_count();
lib/Imager/Graph/Vertical.pm view on Meta::CPAN
if ($value < $min_value) { $min_value = $value; }
}
if (scalar @$data > $column_count) {
$column_count = scalar @$data;
}
}
return ($min_value, $max_value, $column_count);
}
sub _draw_legend {
my $self = shift;
my $chart_box = shift;
my $style = $self->{'_style'};
my @labels;
my $img = $self->_get_image();
if (my $series = $self->_get_data_series()->{'stacked_column'}) {
push @labels, map { $_->{'series_name'} } @$series;
}
if (my $series = $self->_get_data_series()->{'column'}) {
push @labels, map { $_->{'series_name'} } @$series;
}
if (my $series = $self->_get_data_series()->{'line'}) {
push @labels, map { $_->{'series_name'} } @$series;
}
if (my $series = $self->_get_data_series()->{'area'}) {
push @labels, map { $_->{'series_name'} } @$series;
}
if ($style->{features}{legend} && (scalar @labels)) {
$self->SUPER::_draw_legend($self->_get_image(), \@labels, $chart_box)
or return;
}
return;
}
sub _draw_flat_legend {
return 1;
}
sub _draw_lines {
my $self = shift;
my $style = $self->{'_style'};
my $img = $self->_get_image();
my $max_value = $self->_get_max_value();
lib/Imager/Graph/Vertical.pm view on Meta::CPAN
$self->_remove_box($chart_box, \@y_tic_box);
$self->_remove_box($chart_box, \@x_tic_box);
# If there's no title, the y-tics will be part off-screen. Half of the x-tic height should be more than sufficient.
my @y_tic_tops = ($chart_box->[0], $chart_box->[1], $chart_box->[2], $chart_box->[1] + int($tic_height / 2));
$self->_remove_box($chart_box, \@y_tic_tops);
# Make sure that the first and last label fit
if (my $labels = $self->_get_labels($opts)) {
if (my @box = $self->_text_bbox($labels->[0], 'legend')) {
my @remove_box = ($chart_box->[0],
$chart_box->[1],
$chart_box->[0] + int($box[2] / 2) + 1,
$chart_box->[3]
);
$self->_remove_box($chart_box, \@remove_box);
}
if (my @box = $self->_text_bbox($labels->[-1], 'legend')) {
my @remove_box = ($chart_box->[2] - int($box[2] / 2) - 1,
$chart_box->[1],
$chart_box->[2],
$chart_box->[3]
);
$self->_remove_box($chart_box, \@remove_box);
}
}
}
sub _get_y_tic_width {
my $self = shift;
my $min = $self->_get_min_value();
my $max = $self->_get_max_value();
my $tic_count = $self->_get_y_tics();
my $interval = ($max - $min) / ($tic_count - 1);
my %text_info = $self->_text_style('legend')
or return;
my $max_width = 0;
for my $count (0 .. $tic_count - 1) {
my $value = ($count*$interval)+$min;
if ($interval < 1 || ($value != int($value))) {
$value = sprintf("%.2f", $value);
}
my @box = $self->_text_bbox($value, 'legend');
my $width = $box[2] - $box[0];
# For the tic width
$width += 10;
if ($width > $max_width) {
$max_width = $width;
}
}
return $max_width;
lib/Imager/Graph/Vertical.pm view on Meta::CPAN
my ($self, $opts) = @_;
my $labels = $self->_get_labels($opts);
if (!$labels) {
return;
}
my $tic_count = (scalar @$labels) - 1;
my %text_info = $self->_text_style('legend')
or return;
my $max_height = 0;
for my $count (0 .. $tic_count) {
my $label = $labels->[$count];
my @box = $self->_text_bbox($label, 'legend');
my $height = $box[3] - $box[1];
# Padding + the tic
$height += 10;
if ($height > $max_height) {
$max_height = $height;
}
}
lib/Imager/Graph/Vertical.pm view on Meta::CPAN
my $min = $self->_get_min_value();
my $max = $self->_get_max_value();
my $tic_count = $self->_get_y_tics();
my $img = $self->_get_image();
my $graph_box = $self->_get_graph_box();
my $image_box = $self->_get_image_box();
my $interval = ($max - $min) / ($tic_count - 1);
my %text_info = $self->_text_style('legend')
or return;
my $line_style = $self->_get_color('outline.line');
my $show_gridlines = $self->{_style}{features}{'horizontal_gridlines'};
my @grid_line = $self->_get_line("hgrid");
my $tic_distance = ($graph_box->[3] - $graph_box->[1]) / ($tic_count - 1);
for my $count (0 .. $tic_count - 1) {
my $x1 = $graph_box->[0] - 5;
my $x2 = $graph_box->[0] + 5;
my $y1 = int($graph_box->[3] - ($count * $tic_distance));
my $value = ($count*$interval)+$min;
if ($interval < 1 || ($value != int($value))) {
$value = sprintf("%.2f", $value);
}
my @box = $self->_text_bbox($value, 'legend')
or return;
$img->line(x1 => $x1, x2 => $x2, y1 => $y1, y2 => $y1, aa => 1, color => $line_style);
my $width = $box[2];
my $height = $box[3];
$img->string(%text_info,
x => ($x1 - $width - 3),
y => ($y1 + ($height / 2)),
lib/Imager/Graph/Vertical.pm view on Meta::CPAN
my $tic_count = (scalar @$labels) - 1;
my $has_columns = (defined $self->_get_data_series()->{'column'} || defined $self->_get_data_series()->{'stacked_column'});
# If we have columns, we want the x-ticks to show up in the middle of the column, not on the left edge
my $denominator = $tic_count;
if ($has_columns) {
$denominator ++;
}
my $tic_distance = ($graph_box->[2] - $graph_box->[0]) / ($denominator);
my %text_info = $self->_text_style('legend')
or return;
# If automatic axis is turned on, let's be selective about what labels we draw.
my $max_size = 0;
my $tic_skip = 0;
if ($self->_get_number('automatic_axis')) {
foreach my $label (@$labels) {
my @box = $self->_text_bbox($label, 'legend');
if ($box[2] > $max_size) {
$max_size = $box[2];
}
}
# Give the max_size some padding...
$max_size *= 1.2;
$tic_skip = int($max_size / $tic_distance) + 1;
}
lib/Imager/Graph/Vertical.pm view on Meta::CPAN
$x1 += $tic_distance / 2;
}
$x1 = int($x1);
my $y1 = $graph_box->[3] + 5;
my $y2 = $graph_box->[3] - 5;
$img->line(x1 => $x1, x2 => $x1, y1 => $y1, y2 => $y2, aa => 1, color => $line_style);
my @box = $self->_text_bbox($label, 'legend')
or return;
my $width = $box[2];
my $height = $box[3];
$img->string(%text_info,
x => ($x1 - ($width / 2)),
y => ($y1 + ($height + 5)),
text => $label
);
or print "# ",$pie->error,"\n";
cmpimg($img1, "testimg/t10_pie1.png", 196880977);
$img1->write(file=>'testout/t10_pie1.ppm')
or die "Cannot save pie1: ",$img1->errstr,"\n";
my $img2 = $pie->draw(data=>\@data,
labels=>\@labels,
font=>$font,
title=>{ text=>'Imager::Graph::Pie', size=>36 },
features=>{ labelspconly=>1, _debugblur=>1,
legend=>1 },
legend=>{ border=>'000000', fill=>'C0C0C0', },
fills=>[ qw(404040 606060 808080 A0A0A0 C0C0C0 E0E0E0) ],
);
ok($img2, "drawing second pie chart")
or print "# ",$pie->error,"\n";
cmpimg($img2, "testimg/t10_pie2.png", 255956289);
$img2->write(file=>'testout/t10_pie2.ppm')
or die "Cannot save pie2: ",$img2->errstr,"\n";
my $img3 = $pie->draw(data=>\@data, labels=>\@labels,
font=>$font, style=>'fount_lin',
features=>[ 'legend', 'labelspconly', ],
legend=>{ valign=>'center' });
ok($img3, "third chart")
or print "# ",$pie->error,"\n";
$img3->write(file=>'testout/t10_lin_fount.ppm')
or die "Cannot save pie3: ",$img3->errstr,"\n";
cmpimg($img3, "testimg/t10_lin_fount.png", 180_000);
my $img4 = $pie->draw(data=>\@data, labels=>\@labels,
font=>$font, style=>'fount_rad',
features=>[ 'legend', 'labelspc', ],
legend=>{ valign=>'bottom',
halign=>'left',
border=>'000080' });
ok($img4, "fourth chart")
or print "# ",$pie->error,"\n";
$img4->write(file=>'testout/t10_rad_fount.ppm')
or die "Cannot save pie3: ",$img4->errstr,"\n";
cmpimg($img4, "testimg/t10_rad_fount.png", 120_000);
my $img5 = $pie->draw(data=>\@data, labels=>\@labels,
font=>$font, style=>'mono',
features=>[ 'allcallouts', 'labelspc' ],
legend=>{ valign=>'bottom',
halign=>'right' });
ok($img5, "fifth chart")
or print "# ",$pie->error,"\n";
$img5->write(file=>'testout/t10_mono.ppm')
or die "Cannot save pie3: ",$img5->errstr,"\n";
cmpimg($img5, "testimg/t10_mono.png", 550_000);
my $img6 = $pie->draw(data=>\@data, labels=>\@labels,
font=>$font, style=>'fount_lin',
features=>[ 'allcallouts', 'labelspc', 'legend' ],
legend=>
{
valign=>'top',
halign=>'center',
orientation => 'horizontal',
fill => { solid => Imager::Color->new(0, 0, 0, 32) },
patchborder => undef,
#size => 30,
});
ok($img6, "sixth chart")
or print "# ",$pie->error,"\n";
$img6->write(file=>'testout/t10_hlegend.ppm')
or die "Cannot save pie6: ",$img5->errstr,"\n";
cmpimg($img6, "testimg/t10_hlegend.png", 550_000);
{
# RT #34813
# zero sized segments were drawn to cover the whole circle
my @data = ( 10, 8, 5, 0.000 );
my @labels = qw(alpha beta gamma);
my @warned;
local $SIG{__WARN__} =
sub {
print STDERR $_[0];
push @warned, $_[0]
};
my $img = $pie->draw
(
data => \@data,
labels => \@labels,
font => $font,
features => [ 'legend', 'labelspc', 'outline' ],
);
ok($img, "create graph with no 'others'");
ok($img->write(file => 'testout/t10_noother.ppm'),
"save it");
cmpimg($img, 'testimg/t10_noother.png', 500_000);
unless (is(@warned, 0, "should be no warnings")) {
diag($_) for @warned;
}
}
data => \@data,
title => 'test',
);
ok(!$im, "should fail to produce titled graph with no font");
like($pie->error, qr/title\.font/, "message should mention which font");
$im = $pie->draw
(
labels => \@labels,
data => \@data,
features => [ 'legend' ],
);
ok(!$im, "should fail to produce legended graph with no font");
like($pie->error, qr/legend\.font/, "message should mention which font");
$im = $pie->draw
(
data => \@data,
labels => \@labels,
features => [ 'legend' ],
legend => { orientation => "horizontal" },
);
ok(!$im, "should fail to produce horizontal legended graph with no font");
like($pie->error, qr/legend\.font/, "message should mention which font");
$im = $pie->draw
(
data => \@data,
labels => \@labels,
);
ok(!$im, "should fail to produce labelled graph with no font");
like($pie->error, qr/label\.font/, "message should mention which font");
$im = $pie->draw
{
# test methods used to set features
# adds test coverage for otherwise uncovered methods
my $pie = Imager::Graph::Pie->new;
$pie->add_data_series(\@data);
$pie->set_labels(\@labels);
$pie->set_font($font);
$pie->set_style("mono");
$pie->show_callouts_onAll_segments();
$pie->show_label_percentages();
$pie->set_legend_horizontal_align("right");
$pie->set_legend_vertical_align("bottom");
my $im = $pie->draw();
ok($im, "made mono test using methods");
cmpimg($im, "testimg/t10_mono.png", 550_00);
}
{
# more method coverage
my $pie = Imager::Graph::Pie->new;
$pie->add_data_series(\@data);
$pie->set_labels(\@labels);
$pie->set_font($font);
$pie->set_style("fount_lin");
$pie->show_legend();
$pie->show_only_label_percentages();
$pie->set_legend_vertical_align("center");
my $im = $pie->draw();
ok($im, "made lin_found test using methods");
cmpimg($im, "testimg/t10_lin_fount.png", 180_000);
}
{
my $pie = Imager::Graph::Pie->new;
my $im = $pie->draw(width => -1, data => \@data);
ok(!$im, "shouldn't be able to create neg width image");
t/t21style_api.t view on Meta::CPAN
$api_graph->set_line_color('00FF00');
$api_graph->set_title('Tester Title');
$api_graph->set_title_font_size(14);
$api_graph->set_title_font_color('444444');
$api_graph->set_title_horizontal_align('left');
$api_graph->set_title_vertical_align('bottom');
$api_graph->set_text_font_size(18);
$api_graph->set_text_font_color('FFFFFF');
$api_graph->set_graph_background_color('00FF00');
$api_graph->set_graph_foreground_color('FF00FF');
$api_graph->set_legend_font_color('0000FF');
$api_graph->set_legend_font($font);
$api_graph->set_legend_font_size(17);
$api_graph->set_legend_patch_size(30);
$api_graph->set_legend_patch_gap(20);
$api_graph->set_legend_horizontal_align('left');
$api_graph->set_legend_vertical_align('top');
$api_graph->set_legend_padding(5);
$api_graph->set_legend_outside_padding(12);
$api_graph->set_legend_fill('000000');
$api_graph->set_legend_border('222222');
$api_graph->set_legend_orientation('horizontal');
$api_graph->set_callout_font_color('FF0000');
$api_graph->set_callout_font($font);
$api_graph->set_callout_font_size(45);
$api_graph->set_callout_line_color('FF2211');
$api_graph->set_callout_leader_inside_length(10);
$api_graph->set_callout_leader_outside_length(20);
$api_graph->set_callout_leader_length(30);
$api_graph->set_callout_gap(5);
$api_graph->set_label_font_color('55FFFF');
$api_graph->set_label_font($font);
t/t21style_api.t view on Meta::CPAN
$api_graph->set_drop_shadow_fill_color('113333');
$api_graph->set_drop_shadow_offset(25);
$api_graph->set_drop_shadowXOffset(30);
$api_graph->set_drop_shadowYOffset(5);
$api_graph->set_drop_shadow_filter({ type=>'mosaic', size => 20 });
$api_graph->set_outline_color('FF00FF');
$api_graph->set_data_area_fills([qw(FF0000 00FF00 0000FF)]);
$api_graph->set_data_line_colors([qw(FF0000 00FF00 0000FF)]);
my $api_img = $api_graph->draw(
features => [qw(legend outline labels)],
) || die $api_graph->error;
ok($api_img);
my $style_graph = Imager::Graph::Pie->new();
$style_graph->add_data_series(\@data, 'Positive Slope');
$style_graph->set_style('ocean');
$style_graph->set_labels([0 .. 10]);
my $style_img = $style_graph->draw(
features => [qw(legend outline labels)],
font => $font, # base font * set_font()
back => 'FF00FF', # Background color/fill - set_image_background()
size => 500, # Size of the graph * set_size()
width => 800, # width of the image * set_width()
height => 600, # height of the image * set_height()
channels => 3, # # of channels in the image - set_channels()
line => '00FF00', # color of lines - set_line_color()
title => {
text => 'Tester Title', # title for the chart * set_title()
size => '14', # size of the title font - set_title_font_size()
color => '444444', # color of the title - set_title_font_color()
halign => 'left', # horizontal alignment of the title - set_title_horizontal_align()
valign => 'bottom', # vertical alignment of the title - set_title_vertical_align()
},
text => {
color => 'FFFFFF', # default color of text - set_text_font_color()
size => '18', # default size of text - set_text_font_size()
},
bg => '00FF00', # background color of the graph - set_graph_background_color()
fg => 'FF00FF', # foreground color of the graph - set_graph_foreground_color()
legend => {
color => '0000FF', # text color for the legend - set_legend_font_color()
font => $font, # font to be used for the legend - set_legend_font()
size => 17, # font size to be used for labels
# in the legend - set_legend_font_size()
patchsize => 30, # the size in pixels? percent? - set_legend_patch_size()
# of the color patches in
# the legend.
patchgap => 20, # gap between the color patches. - set_legend_patch_gap()
# in pixels? percent?
halign => 'left', # horizontal alignment of the - set_legend_horizontal_align()
# legend within the graph
valign => 'top', # vertical alignment of the - set_legend_vertical_align()
# legend within the graph
padding => '5', # the space between the patches - set_legend_padding()
# of color and the outside of
# the legend box
outsidepadding => '12', # the space between the - set_legend_outside_padding()
# border of the legend,
# and the outside edge of the
# legend
fill => '000000', # A fill for the background - set_legend_fill()
# of the legend.
border => '222222', # The color of the border of - set_legend_border()
# the legend.
orientation => 'horizontal', # the orientation of the - set_legend_orientation()
# legend
},
callout => {
color => 'FF0000', # the color of the callout text - set_callout_font_color()
font => $font, # the font to use for callouts - set_callout_font()
size => 45, # the font size for callout text - set_callout_font_size()
line => 'FF2211', # the color of the line from the - set_callout_line_color()
# callout to the graph
inside => '10', # the length in pixels? of the - set_callout_leader_inside_length()
# leader...
outside => '20', # the other side of the leader? - set_callout_leader_outside_length()
t/t32series_labels.t view on Meta::CPAN
my @data = (1 .. 1000);
my @labels = qw(alpha beta gamma delta epsilon phi gi);
my $line = Imager::Graph::Line->new();
ok($line, "creating line chart object");
$line->set_font($font);
$line->add_data_series(\@data, "Data series 1");
$line->set_labels(\@labels);
$line->show_legend();
my $img1 = $line->draw();
ok($img1, "drawing line chart");
$img1->write(file=>'testout/t32_series.ppm') or die "Can't save img1: ".$img1->errstr."\n";
cmpimg($img1, 'testimg/t32_series.png', 200_000);
unless (is(@warned, 0, "should be no warnings")) {
diag($_) for @warned;
}
t/t40area.t view on Meta::CPAN
$area->add_data_series(\@data1, "Test Area");
$area->add_data_series(\@data2, "Test Area 2");
my $img1 = $area->draw
(
#data => \@data,
labels => \@labels,
font => $font,
title => "Test",
features => { legend => 1 },
legend =>
{
valign => "bottom",
halign => "center",
orientation => "horizontal",
},
area =>
{
opacity => 0.8,
},
#outline => { line => '404040' },
( run in 1.133 second using v1.01-cache-2.11-cpan-49f99fa48dc )