'VERSION_FROM' => 'Graph.pm', # finds $VERSION
PREREQ_PM =>
{
- Imager=>'0.61',
+ Imager=>'0.75',
'Test::More' => 0.47
},
clean => { FILES=>'testout' },
--- /dev/null
+package Imager::Graph::Area;
+
+=head1 NAME
+
+ Imager::Graph::Area - a tool for drawing area charts on Imager images
+
+=head1 SYNOPSIS
+
+ 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');
+
+
+
+=cut
+
+use strict;
+use vars qw(@ISA);
+use Imager::Graph::Vertical;
+@ISA = qw(Imager::Graph::Vertical);
+
+sub _get_default_series_type {
+ return 'area';
+}
+
+1;
+
@ISA = qw(Imager::Graph);
use constant STARTING_MIN_VALUE => 99999;
+
=over 4
=item add_data_series(\@data, $series_name)
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)
return 1;
}
+sub _area_data_fill {
+ my ($self, $index, $box) = @_;
+
+ my %fill = $self->_data_fill($index, $box);
+
+ my $opacity = $self->_get_number("area.opacity");
+ $opacity == 1
+ and return %fill;
+
+ my $orig_fill = $fill{fill};
+ unless ($orig_fill) {
+ $orig_fill = Imager::Fill->new
+ (
+ solid => $fill{color},
+ combine => "normal",
+ );
+ }
+ return
+ (
+ fill => Imager::Fill->new
+ (
+ type => "opacity",
+ other => $orig_fill,
+ opacity => $opacity,
+ ),
+ );
+}
+
sub _draw_area {
my $self = shift;
my $style = $self->{'_style'};
push @polygon_points, [$x2, $top];
push @polygon_points, $polygon_points[0];
- my @fill = $self->_data_fill($series_counter, [$left, $bottom, $right, $top]);
+ my @fill = $self->_area_data_fill($series_counter, [$left, $bottom, $right, $top]);
$img->polygon(points => [@polygon_points], @fill);
push @marker_positions, [$x2, $y2];
sub _get_graph_box { return $_[0]->{'graph_box'} }
sub _get_series_counter { return $_[0]->{'series_counter'} }
+sub _style_defs {
+ my ($self) = @_;
+
+ my %work = %{$self->SUPER::_style_defs()};
+ $work{area} =
+ {
+ opacity => 0.5,
+ };
+
+ return \%work;
+}
+
1;
--- /dev/null
+#!perl -w
+use strict;
+use Imager::Graph::Area;
+use lib 't/lib';
+use Imager::Font::Test;
+use Test::More;
+use Imager::Test qw(is_image_similar);
+
+-d 'testout'
+ or mkdir "testout", 0700
+ or die "Could not create output directory: $!";
+
+++$|;
+
+use Imager qw(:handy);
+
+#my $fontfile = 'ImUgly.ttf';
+#my $font = Imager::Font->new(file=>$fontfile, type => 'ft2', aa=>1)
+# or plan skip_all => "Cannot create font object: ",Imager->errstr,"\n";
+my $font = Imager::Font::Test->new();
+
+my @data1 =
+ (
+ 100, 180, 80, 20, 2, 1, 0.5 ,
+ );
+my @data2 =
+ (
+ 10, 20, 40, 200, 150, 10, 50,
+ );
+my @labels = qw(alpha beta gamma delta epsilon phi gi);
+
+plan tests => 4;
+
+my $area = Imager::Graph::Area->new;
+ok($area, "creating area chart object");
+
+# this may change output quality too
+
+print "# Imager version: $Imager::VERSION\n";
+print "# Font type: ",ref $font,"\n";
+
+$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' },
+ )
+ or print "# ", $area->error, "\n";
+
+ok($img1, "made the image");
+
+ok($img1->write(file => "testout/t40area1.ppm"),
+ "save to testout");
+
+cmpimg($img1, "testimg/t40area1.png");
+
+END {
+ unless ($ENV{IMAGER_GRAPH_KEEP_FILES}) {
+ unlink "testout/t40area1.ppm";
+ }
+}
+
+sub cmpimg {
+ my ($img, $file, $limit) = @_;
+
+ $limit ||= 10000;
+
+ SKIP:
+ {
+ $Imager::formats{png}
+ or skip("No PNG support", 1);
+
+ my $cmpimg = Imager->new;
+ $cmpimg->read(file=>$file)
+ or return ok(0, "Cannot read $file: ".$cmpimg->errstr);
+ my $diff = Imager::i_img_diff($img->{IMG}, $cmpimg->{IMG});
+ is_image_similar($img, $cmpimg, $limit, "Comparison to $file ($diff)");
+ }
+}