- skip all tests if we can't load the font
authorTony Cook <tony@develop-help.com>
Tue, 11 Dec 2007 09:36:22 +0000 (09:36 +0000)
committerTony Cook <tony@develop-help.com>
Tue, 11 Dec 2007 09:36:22 +0000 (09:36 +0000)
 - Save test results to ppm, so we can generate images even if we don't
   have PNG support in Imager.

 - instead of the old draw-no-aa-then-blur-the-result hack, we now use
   arc()'s aa option

 - tests now use Test::More

 - remove the old circle fudge hack, since Imager fixed arc fills a
   while ago

 - strictify Makefile.PL, include the LICENSE, use the correct version
   check for including the extra WriteMakefile keys

Changes
Makefile.PL
lib/Imager/Graph/Pie.pm
t/t00load.t
t/t10pie.t
testimg/t10_lin_fount.png
testimg/t10_mono.png
testimg/t10_rad_fount.png

diff --git a/Changes b/Changes
index 48366f0..a259c9b 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,10 +1,33 @@
 Revision history for Perl extension Graph::Imager.
 
-0.02  Sat Oct  6 20:36:31 2001
+Imager-Graph 0.04
+=================
+
+ - skip all tests if we can't load the font
+
+ - Save test results to ppm, so we can generate images even if we don't
+   have PNG support in Imager.
+
+ - instead of the old draw-no-aa-then-blur-the-result hack, we now use
+   arc()'s aa option
+
+ - tests now use Test::More
+
+ - remove the old circle fudge hack, since Imager fixed arc fills a
+   while ago
+
+ - strictify Makefile.PL, include the LICENSE, use the correct version
+   check for including the extra WriteMakefile keys
+
+Imager-Graph 0.02  Sat Oct  6 20:36:31 2001
+=================
+
  - replace ImUgly.ttf with a new version where % renders on my older PC
  - remove some old test code that printed the Imager version
  - moved into local CVS to simplify cross-platform tests
       
-0.01  Tue Sep 12 23:03:25 2001
+Imager-Graph 0.01  Tue Sep 12 23:03:25 2001
+=================
+
  - original version; created by h2xs 1.19
  - can draw some nice pie graphs
index 7dbb1ed..bf86895 100644 (file)
@@ -1,15 +1,26 @@
-# Imager::Graph
+#!perl -w
+use strict;
+require 5.005;
 use ExtUtils::MakeMaker;
 my %opts;
-if ($] ge '5.005') {
+# eval to prevent warnings about versions with _ in them
+my $MM_ver = eval $ExtUtils::MakeMaker::VERSION;
+if ($MM_ver > 6.06) {
   $opts{AUTHOR} = 'Tony Cook <tony@develop-help.com>';
   $opts{ABSTRACT} = 'Draws good looking pie graphs';
 }
+if ($MM_ver >= 6.31) {
+  $opts{LICENSE} = 'perl';
+}
 
 WriteMakefile(
               %opts,
               'NAME'          => 'Imager::Graph',
               'VERSION_FROM'  => 'Graph.pm', # finds $VERSION
-              PREREQ_PM       => { Imager=>'0.38' },
+              PREREQ_PM       => 
+             { 
+              Imager=>'0.61',
+              'Test::More' => 0.47
+             },
               clean => { FILES=>'testout' },
 );
index a151eb3..0cd7783 100644 (file)
@@ -35,14 +35,6 @@ use POSIX qw(floor);
 
 use constant PI => 3.1415926535;
 
-# Imager doesn't have a arc boundary function, and the obvious code
-# either leaves gaps between the circle and the fill, or has some of the
-# fill outside the outline.  These fudge factors produced good results
-# for the test images <sigh>
-use constant CIRCLE_FUDGE_X => 0.4;
-use constant CIRCLE_FUDGE_Y => 0.4;
-use constant CIRCLE_RADIUS_FUDGE => 0.2;
-
 =item $graph->draw(...)
 
 Draws a pie graph onto a new image and returns the image.
@@ -85,10 +77,6 @@ the segments are labels with their percentages only.
 
 all labels are presented as callouts
 
-=item pieblur
-
-the segments are blurred, as a substitute for anti-aliased arcs
-
 =item outline
 
 the pie segments are outlined.
@@ -277,7 +265,7 @@ sub draw {
       or return;
     my $offy = $self->_get_number('dropshadow.offy');
     for my $item (@info) {
-      $img->arc(x=>$cx+$offx, 'y'=>$cy+$offy, r=>$radius+1,
+      $img->arc(x=>$cx+$offx, 'y'=>$cy+$offy, r=>$radius+1, aa => 1,
                 d1=>180/PI * $item->{begin}, d2=>180/PI * $item->{end},
                 @shadow_fill);
     }
@@ -287,32 +275,26 @@ sub draw {
                           'dropshadow.filter')
       if $style->{dropshadow}{filter};
   }
+
   my @fill_box = ( $cx-$radius, $cy-$radius, $cx+$radius, $cy+$radius );
   for my $item (@info) {
     my @fill = $self->_data_fill($item->{index}, \@fill_box)
       or return;
-    $img->arc(x=>$cx, 'y'=>$cy, r=>$radius, 
+    $img->arc(x=>$cx, 'y'=>$cy, r=>$radius, aa => 1,
               d1=>180/PI * $item->{begin}, d2=>180/PI * $item->{end},
               @fill);
   }
-  if ($style->{features}{pieblur}) {
-    $self->_pieblur($img, $cx, $cy, $radius);
-  }
   if ($style->{features}{outline}) {
     my $outcolor = $self->_get_color('outline.line');
     for my $item (@info) {
-      my $px = int($cx + CIRCLE_FUDGE_X + 
-                   ($radius+CIRCLE_RADIUS_FUDGE) * cos($item->{begin}));
-      my $py = int($cy + CIRCLE_FUDGE_Y + 
-                   ($radius+CIRCLE_RADIUS_FUDGE) * sin($item->{begin}));
+      my $px = int($cx + $radius * cos($item->{begin}));
+      my $py = int($cy + $radius * sin($item->{begin}));
       $img->line(x1=>$cx, y1=>$cy, x2=>$px, y2=>$py, color=>$outcolor);
       for (my $i = $item->{begin}; $i < $item->{end}; $i += PI/180) {
        my $stroke_end = $i + PI/180;
        $stroke_end = $item->{end} if $stroke_end > $item->{end};
-       my $nx = int($cx + CIRCLE_FUDGE_X + 
-                     ($radius+CIRCLE_RADIUS_FUDGE) * cos($stroke_end));
-       my $ny = int($cy + CIRCLE_FUDGE_Y + 
-                     ($radius+CIRCLE_RADIUS_FUDGE) * sin($stroke_end));
+       my $nx = int($cx + $radius * cos($stroke_end));
+       my $ny = int($cy + $radius * sin($stroke_end));
        $img->line(x1=>$px, y1=>$py, x2=>$nx, y2=>$ny, color=>$outcolor,
                  antialias=>1);
        ($px, $py) = ($nx, $ny);
@@ -405,45 +387,6 @@ sub _consolidate_segments {
   }
 }
 
-=item _pieblur($img, $cx, $cy, $radius)
-
-Blurs the pie as a substitute for anti-aliased segments.
-
-=cut
-
-sub _pieblur {
-  my ($self, $img, $cx, $cy, $radius) = @_;
-
-  my $left = $cx - $radius - 2;
-  $left > 1 or $left = 2;
-  my $right = $cx + $radius + 2;
-  my $top = $cy - $radius - 2;
-  $top > 1 or $top = 2;
-  my $bottom = $cy + $radius + 2;
-
-  my $filter = $self->_get_thing("pie.blur")
-    or return;
-  
-  # newer versions of Imager let you work on just part of an image
-  if ($img->can('masked') && !$self->{_style}{features}{_debugblur}) {
-    # the mask prevents the blur from leaking over the edges
-    my $mask = Imager->new(xsize=>$right-$left, ysize=>$bottom-$top, 
-                           channels=>1);
-    $mask->arc(x=>$cx-$left, 'y'=>$cy-$top, r=>$radius);
-    my $masked = $img->masked(mask=>$mask,
-                              left=>$left, top=>$top,
-                              right=>$right, bottom=>$bottom);
-    $masked->filter(%{$self->{_style}{pie}{blur}});
-  }
-  else {
-    # for older versions of Imager
-    my $subset = $img->crop(left=>$left, top=>$top,
-                            right=>$right, bottom=>$bottom);
-    $subset->filter(%{$self->{_style}{pie}{blur}});
-    $img->paste(left=>$left, top=>$top, img=>$subset);
-  }
-}
-
 # used for debugging
 sub _test_line {
   my ($x, $y, @l) = @_;
index 9a7e44c..45fc5bd 100644 (file)
@@ -1,10 +1,4 @@
 #!perl -w
 use strict;
-my $loaded;
-BEGIN { print "1..1\n"; };
-
-use Imager::Graph::Pie;
-++$loaded;
-print "ok 1\n";
-
-END { print "not ok 1\n" unless $loaded; }
+use Test::More tests => 1;
+use_ok('Imager::Graph::Pie');
index 938171e..61a4032 100644 (file)
@@ -1,33 +1,31 @@
 #!perl -w
 use strict;
 use Imager::Graph::Pie;
+use Test::More;
 
 -d 'testout' 
   or mkdir "testout", 0700 
   or die "Could not create output directory: $!";
 
 ++$|;
-print "1..11\n";
 
 my $testnum = 1;
 
 use Imager qw(:handy);
 
-# setting this to another font file will cause failed tests
-# but may produce nicer text
-my $fontfile; # = '/mnt/c/windows/fonts/arial.ttf';
+my $fontfile = 'ImUgly.ttf';
+my $font = Imager::Font->new(file=>$fontfile, aa=>1)
+  or plan skip_all => "Cannot create font object: ",Imager->errstr,"\n";
 
 my @data = ( 100, 180, 80, 20, 2, 1, 0.5 );
 my @labels = qw(alpha beta gamma delta epsilon phi gi);
 
+plan tests => 11;
+
 my $pie = Imager::Graph::Pie->new;
 ok($pie, "creating pie chart object");
 
 # this may change output quality too
-#Imager::Font->priorities('ft2');
-$fontfile = 'ImUgly.ttf' unless $fontfile and -e $fontfile;
-my $font = Imager::Font->new(file=>$fontfile, aa=>1)
-  or die "Cannot create font object: ",Imager->errstr,"\n";
 
 print "# Imager version: $Imager::VERSION\n";
 print "# Font type: ",ref $font,"\n";
@@ -36,13 +34,12 @@ my $img1 = $pie->draw(data=>\@data, labels=>\@labels, font=>$font,
                      title=>{ text=>'Imager::Graph::Pie', size=>32 },
                      features=>{ outline=>1, labels=>1, pieblur=>0, },
                       outline=>{ line => '404040' },
-                    )
-  or print "# ",$pie->error,"\n";
+                    );
 
-ok($img1, "drawing first pie chart");
+ok($img1, "drawing first pie chart")
+  or print "# ",$pie->error,"\n";
 cmpimg($img1, "testimg/t10_pie1.png", 196880977);
-unlink('testout/t10_pie1.png');
-$img1->write(file=>'testout/t10_pie1.png')
+$img1->write(file=>'testout/t10_pie1.ppm')
   or die "Cannot save pie1: ",$img1->errstr,"\n";
 
 my $img2 = $pie->draw(data=>\@data,
@@ -53,23 +50,25 @@ my $img2 = $pie->draw(data=>\@data,
                                   legend=>1 },
                       legend=>{ border=>'000000', fill=>'FF8080', },
                       fills=>[ qw(404040 606060 808080 A0A0A0 C0C0C0 E0E0E0) ],
-                    )
-  or print "# ",$pie->error,"\n";
+                    );
 
-ok($img2, "drawing second pie chart");
+ok($img2, "drawing second pie chart")
+  or print "# ",$pie->error,"\n";
 cmpimg($img2, "testimg/t10_pie2.png", 255956289);
-unlink('testout/t10_pie2.png');
-$img2->write(file=>'testout/t10_pie2.png')
+$img2->write(file=>'testout/t10_pie2.ppm')
   or die "Cannot save pie2: ",$img2->errstr,"\n";
 
 my ($im_version) = $Imager::VERSION =~ /(\d\.[\d_]+)/;
-if ($im_version > 0.38) {
+{
+  $im_version > 0.38
+    or skip("very old Imager", 6);
   my $img3 = $pie->draw(data=>\@data, labels=>\@labels,
                         font=>$font, style=>'fount_lin', 
                         features=>[ 'legend', 'labelspconly', ],
                         legend=>{ valign=>'center' });
-  ok($img3, "third chart");
-  $img3->write(file=>'testout/t10_lin_fount.png')
+  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);
 
@@ -79,8 +78,9 @@ if ($im_version > 0.38) {
                         legend=>{ valign=>'bottom', 
                                   halign=>'left',
                                   border=>'000080' });
-  ok($img4, "fourth chart");
-  $img4->write(file=>'testout/t10_rad_fount.png')
+  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);
 
@@ -89,48 +89,27 @@ if ($im_version > 0.38) {
                         features=>[ 'allcallouts', 'labelspc' ],
                         legend=>{ valign=>'bottom', 
                                   halign=>'right' });
-  ok($img5, "fifth chart");
-  $img5->write(file=>'testout/t10_mono.png')
+  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);
 }
-else {
-  skip("Imager not new enough", 6);
-}
-
-sub ok {
-  my ($test, $comment) = @_;
-
-  if ($test) {
-    print "ok ",$testnum++," # $comment\n";
-  }
-  else {
-    print "not ok ",$testnum++," # $comment\n";
-  }
-}
-
-sub skip {
-  my ($comment, $count) = @_;
-
-  $count ||= 1;
-  for (1..$count) {
-    print "ok ",$testnum++," # skipped $comment\n";
-  }
-}
 
 sub cmpimg {
   my ($img, $file, $limit) = @_;
 
   $limit ||= 10000;
 
-  if ($Imager::formats{png}) {
+ 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});
-    ok($diff < $limit, "Comparison to $file ($diff)");
-  }
-  else {
-    skip("no png support");
+    cmp_ok($diff, '<', $limit, "Comparison to $file ($diff)");
   }
 }
index bc264ae..317f51d 100644 (file)
Binary files a/testimg/t10_lin_fount.png and b/testimg/t10_lin_fount.png differ
index 56b2e16..7486ab5 100644 (file)
Binary files a/testimg/t10_mono.png and b/testimg/t10_mono.png differ
index 865d375..37f5bcb 100644 (file)
Binary files a/testimg/t10_rad_fount.png and b/testimg/t10_rad_fount.png differ