intergrate Patrick's area chart work in progress
authorpmichaud <pmichaud@pobox.com>
Mon, 5 Jul 2010 09:38:34 +0000 (09:38 +0000)
committerTony Cook <tony@develop-help.com>
Mon, 5 Jul 2010 09:38:34 +0000 (09:38 +0000)
Makefile.PL
lib/Imager/Graph/Area.pm [new file with mode: 0644]
lib/Imager/Graph/Vertical.pm
t/t40area.t [new file with mode: 0644]
testimg/t40area1.png [new file with mode: 0644]

index bf86895637192af29cc5a3e3b2b18af17855200d..9625c71d4ca9c5ce69f0be025251176f717b9f94 100644 (file)
@@ -19,7 +19,7 @@ WriteMakefile(
               'VERSION_FROM'  => 'Graph.pm', # finds $VERSION
               PREREQ_PM       => 
              { 
-              Imager=>'0.61',
+              Imager=>'0.75',
               'Test::More' => 0.47
              },
               clean => { FILES=>'testout' },
diff --git a/lib/Imager/Graph/Area.pm b/lib/Imager/Graph/Area.pm
new file mode 100644 (file)
index 0000000..257dd49
--- /dev/null
@@ -0,0 +1,45 @@
+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;
+
index 4ebad656e16a75690ee0919e680d7a1d4d15e159..47038f31e8a20e1a818700d4784dc48ad9d326a7 100644 (file)
@@ -12,6 +12,7 @@ use Imager::Graph;
 @ISA = qw(Imager::Graph);
 
 use constant STARTING_MIN_VALUE => 99999;
+
 =over 4
 
 =item add_data_series(\@data, $series_name)
@@ -513,6 +514,9 @@ sub _draw_legend {
   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)
@@ -602,6 +606,34 @@ sub _draw_lines {
   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'};
@@ -665,7 +697,7 @@ sub _draw_area {
     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];
@@ -1242,4 +1274,16 @@ sub _get_image_box      { return $_[0]->{'image_box'} }
 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;
diff --git a/t/t40area.t b/t/t40area.t
new file mode 100644 (file)
index 0000000..dafef7b
--- /dev/null
@@ -0,0 +1,95 @@
+#!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)");
+  }
+}
diff --git a/testimg/t40area1.png b/testimg/t40area1.png
new file mode 100644 (file)
index 0000000..0d299e4
Binary files /dev/null and b/testimg/t40area1.png differ