t/t10pie.t

   1 #!perl -w
   2 use strict;
   3 use Imager::Graph::Pie;
   4
   5 -d 'testout'
   6   or mkdir "testout", 0700
   7   or die "Could not create output directory: $!";
   8
   9 ++$|;
  10 print "1..11\n";
  11
  12 my $testnum = 1;
  13
  14 use Imager qw(:handy);
  15
  16 # setting this to another font file will cause failed tests
  17 # but may produce nicer text
  18 my $fontfile; # = '/mnt/c/windows/fonts/arial.ttf';
  19
  20 my @data = ( 100, 180, 80, 20, 2, 1, 0.5 );
  21 my @labels = qw(alpha beta gamma delta epsilon phi gi);
  22
  23 my $pie = Imager::Graph::Pie->new;
  24 ok($pie, "creating pie chart object");
  25
  26 # this may change output quality too
  27 #Imager::Font->priorities('ft2');
  28 $fontfile = 'ImUgly.ttf' unless $fontfile and -e $fontfile;
  29 my $font = Imager::Font->new(file=>$fontfile, aa=>1)
  30   or die "Cannot create font object: ",Imager->errstr,"\n";
  31
  32 print "# Imager version: $Imager::VERSION\n";
  33 print "# Font type: ",ref $font,"\n";
  34
  35 my $img1 = $pie->draw(data=>\@data, labels=>\@labels, font=>$font,
  36                       title=>{ text=>'Imager::Graph::Pie', size=>32 },
  37                       features=>{ outline=>1, labels=>1, pieblur=>0, },
  38                       outline=>{ line => '404040' },
  39                      )
  40   or print "# ",$pie->error,"\n";
  41
  42 ok($img1, "drawing first pie chart");
  43 cmpimg($img1, "testimg/t10_pie1.png", 196880977);
  44 unlink('testout/t10_pie1.png');
  45 $img1->write(file=>'testout/t10_pie1.png')
  46   or die "Cannot save pie1: ",$img1->errstr,"\n";
  47
  48 my $img2 = $pie->draw(data=>\@data,
  49                       labels=>\@labels,
  50                       font=>$font,
  51                       title=>{ text=>'Imager::Graph::Pie', size=>36 },
  52                       features=>{ labelspconly=>1, _debugblur=>1,
  53                                   legend=>1 },
  54                       legend=>{ border=>'000000', fill=>'FF8080', },
  55                       fills=>[ qw(404040 606060 808080 A0A0A0 C0C0C0 E0E0E0) ],
  56                      )
  57   or print "# ",$pie->error,"\n";
  58
  59 ok($img2, "drawing second pie chart");
  60 cmpimg($img2, "testimg/t10_pie2.png", 255956289);
  61 unlink('testout/t10_pie2.png');
  62 $img2->write(file=>'testout/t10_pie2.png')
  63   or die "Cannot save pie2: ",$img2->errstr,"\n";
  64
  65 my ($im_version) = $Imager::VERSION =~ /(\d\.[\d_]+)/;
  66 if ($im_version > 0.38) {
  67   my $img3 = $pie->draw(data=>\@data, labels=>\@labels,
  68                         font=>$font, style=>'fount_lin',
  69                         features=>[ 'legend', 'labelspconly', ],
  70                         legend=>{ valign=>'center' });
  71   ok($img3, "third chart");
  72   $img3->write(file=>'testout/t10_lin_fount.png')
  73     or die "Cannot save pie3: ",$img3->errstr,"\n";
  74   cmpimg($img3, "testimg/t10_lin_fount.png", 180_000);
  75
  76   my $img4 = $pie->draw(data=>\@data, labels=>\@labels,
  77                         font=>$font, style=>'fount_rad',
  78                         features=>[ 'legend', 'labelspc', ],
  79                         legend=>{ valign=>'bottom',
  80                                   halign=>'left',
  81                                   border=>'000080' });
  82   ok($img4, "fourth chart");
  83   $img4->write(file=>'testout/t10_rad_fount.png')
  84     or die "Cannot save pie3: ",$img4->errstr,"\n";
  85   cmpimg($img4, "testimg/t10_rad_fount.png", 120_000);
  86
  87   my $img5 = $pie->draw(data=>\@data, labels=>\@labels,
  88                         font=>$font, style=>'mono',
  89                         features=>[ 'allcallouts', 'labelspc' ],
  90                         legend=>{ valign=>'bottom',
  91                                   halign=>'right' });
  92   ok($img5, "fifth chart");
  93   $img5->write(file=>'testout/t10_mono.png')
  94     or die "Cannot save pie3: ",$img5->errstr,"\n";
  95   cmpimg($img5, "testimg/t10_mono.png", 550_000);
  96 }
  97 else {
  98   skip("Imager not new enough", 6);
  99 }
 100
 101 sub ok {
 102   my ($test, $comment) = @_;
 103
 104   if ($test) {
 105     print "ok ",$testnum++," # $comment\n";
 106   }
 107   else {
 108     print "not ok ",$testnum++," # $comment\n";
 109   }
 110 }
 111
 112 sub skip {
 113   my ($comment, $count) = @_;
 114
 115   $count ||= 1;
 116   for (1..$count) {
 117     print "ok ",$testnum++," # skipped $comment\n";
 118   }
 119 }
 120
 121 sub cmpimg {
 122   my ($img, $file, $limit) = @_;
 123
 124   $limit ||= 10000;
 125
 126   if ($Imager::formats{png}) {
 127     my $cmpimg = Imager->new;
 128     $cmpimg->read(file=>$file)
 129       or return ok(0, "Cannot read $file: ".$cmpimg->errstr);
 130     my $diff = Imager::i_img_diff($img->{IMG}, $cmpimg->{IMG});
 131     ok($diff < $limit, "Comparison to $file ($diff)");
 132   }
 133   else {
 134     skip("no png support");
 135   }
 136 }