t/t10pie.t

   1 #!perl -w
   2 use strict;
   3 use Imager::Graph::Pie;
   4 use lib 't/lib';
   5 use Imager::Font::Test;
   6 use Test::More;
   7
   8 -d 'testout'
   9   or mkdir "testout", 0700
  10   or die "Could not create output directory: $!";
  11
  12 ++$|;
  13
  14 use Imager qw(:handy);
  15
  16 #my $fontfile = 'ImUgly.ttf';
  17 #my $font = Imager::Font->new(file=>$fontfile, type => 'ft2', aa=>1)
  18 #  or plan skip_all => "Cannot create font object: ",Imager->errstr,"\n";
  19 my $font = Imager::Font::Test->new();
  20
  21 my @data = ( 100, 180, 80, 20, 2, 1, 0.5 );
  22 my @labels = qw(alpha beta gamma delta epsilon phi gi);
  23
  24 plan tests => 41;
  25
  26 my $pie = Imager::Graph::Pie->new;
  27 ok($pie, "creating pie chart object");
  28
  29 # this may change output quality too
  30
  31 print "# Imager version: $Imager::VERSION\n";
  32 print "# Font type: ",ref $font,"\n";
  33
  34 my $img1 = $pie->draw(data=>\@data, labels=>\@labels, font=>$font,
  35                       title=>{ text=>'Imager::Graph::Pie', size=>32 },
  36                       features=>{ outline=>1, labels=>1, pieblur=>0, },
  37                       outline=>{ line => '404040' },
  38                      );
  39
  40 ok($img1, "drawing first pie chart")
  41   or print "# ",$pie->error,"\n";
  42 cmpimg($img1, "testimg/t10_pie1.png", 196880977);
  43 $img1->write(file=>'testout/t10_pie1.ppm')
  44   or die "Cannot save pie1: ",$img1->errstr,"\n";
  45
  46 my $img2 = $pie->draw(data=>\@data,
  47                       labels=>\@labels,
  48                       font=>$font,
  49                       title=>{ text=>'Imager::Graph::Pie', size=>36 },
  50                       features=>{ labelspconly=>1, _debugblur=>1,
  51                                   legend=>1 },
  52                       legend=>{ border=>'000000', fill=>'C0C0C0', },
  53                       fills=>[ qw(404040 606060 808080 A0A0A0 C0C0C0 E0E0E0) ],
  54                      );
  55
  56 ok($img2, "drawing second pie chart")
  57   or print "# ",$pie->error,"\n";
  58 cmpimg($img2, "testimg/t10_pie2.png", 255956289);
  59 $img2->write(file=>'testout/t10_pie2.ppm')
  60   or die "Cannot save pie2: ",$img2->errstr,"\n";
  61
  62 my $img3 = $pie->draw(data=>\@data, labels=>\@labels,
  63                       font=>$font, style=>'fount_lin',
  64                       features=>[ 'legend', 'labelspconly', ],
  65                       legend=>{ valign=>'center' });
  66 ok($img3, "third chart")
  67   or print "# ",$pie->error,"\n";
  68 $img3->write(file=>'testout/t10_lin_fount.ppm')
  69   or die "Cannot save pie3: ",$img3->errstr,"\n";
  70 cmpimg($img3, "testimg/t10_lin_fount.png", 180_000);
  71
  72 my $img4 = $pie->draw(data=>\@data, labels=>\@labels,
  73                       font=>$font, style=>'fount_rad',
  74                       features=>[ 'legend', 'labelspc', ],
  75                       legend=>{ valign=>'bottom',
  76                                 halign=>'left',
  77                                 border=>'000080' });
  78 ok($img4, "fourth chart")
  79   or print "# ",$pie->error,"\n";
  80 $img4->write(file=>'testout/t10_rad_fount.ppm')
  81   or die "Cannot save pie3: ",$img4->errstr,"\n";
  82 cmpimg($img4, "testimg/t10_rad_fount.png", 120_000);
  83
  84 my $img5 = $pie->draw(data=>\@data, labels=>\@labels,
  85                       font=>$font, style=>'mono',
  86                       features=>[ 'allcallouts', 'labelspc' ],
  87                       legend=>{ valign=>'bottom',
  88                                 halign=>'right' });
  89 ok($img5, "fifth chart")
  90   or print "# ",$pie->error,"\n";
  91 $img5->write(file=>'testout/t10_mono.ppm')
  92   or die "Cannot save pie3: ",$img5->errstr,"\n";
  93 cmpimg($img5, "testimg/t10_mono.png", 550_000);
  94
  95 my $img6 = $pie->draw(data=>\@data, labels=>\@labels,
  96                       font=>$font, style=>'fount_lin',
  97                       features=>[ 'allcallouts', 'labelspc', 'legend' ],
  98                       legend=>
  99                       {
 100                        valign=>'top',
 101                        halign=>'center',
 102                        orientation => 'horizontal',
 103                        fill => { solid => Imager::Color->new(0, 0, 0, 32) },
 104                        patchborder => undef,
 105                        #size => 30,
 106                       });
 107 ok($img6, "sixth chart")
 108   or print "# ",$pie->error,"\n";
 109 $img6->write(file=>'testout/t10_hlegend.ppm')
 110   or die "Cannot save pie6: ",$img5->errstr,"\n";
 111 cmpimg($img6, "testimg/t10_hlegend.png", 550_000);
 112
 113 {
 114   # RT #34813
 115   # zero sized segments were drawn to cover the whole circle
 116   my @data = ( 10, 8, 5, 0.000 );
 117   my @labels = qw(alpha beta gamma);
 118   my @warned;
 119   local $SIG{__WARN__} =
 120     sub {
 121       print STDERR $_[0];
 122       push @warned, $_[0]
 123     };
 124
 125   my $img = $pie->draw
 126     (
 127      data => \@data,
 128      labels => \@labels,
 129      font => $font,
 130      features => [ 'legend', 'labelspc', 'outline' ],
 131     );
 132   ok($img, "create graph with no 'others'");
 133   ok($img->write(file => 'testout/t10_noother.ppm'),
 134      "save it");
 135   cmpimg($img, 'testimg/t10_noother.png', 500_000);
 136   unless (is(@warned, 0, "should be no warnings")) {
 137     diag($_) for @warned;
 138   }
 139 }
 140
 141 { # RT #535
 142   # no font parameter would crash
 143   my $im = $pie->draw
 144     (
 145      data => \@data,
 146      title => 'test',
 147     );
 148   ok(!$im, "should fail to produce titled graph with no font");
 149   like($pie->error, qr/title\.font/, "message should mention which font");
 150
 151   $im = $pie->draw
 152     (
 153      labels => \@labels,
 154      data => \@data,
 155      features => [ 'legend' ],
 156     );
 157   ok(!$im, "should fail to produce legended graph with no font");
 158   like($pie->error, qr/legend\.font/, "message should mention which font");
 159
 160   $im = $pie->draw
 161     (
 162      data => \@data,
 163      labels => \@labels,
 164      features => [ 'legend' ],
 165      legend => { orientation => "horizontal" },
 166     );
 167   ok(!$im, "should fail to produce horizontal legended graph with no font");
 168   like($pie->error, qr/legend\.font/, "message should mention which font");
 169
 170   $im = $pie->draw
 171     (
 172      data => \@data,
 173      labels => \@labels,
 174     );
 175   ok(!$im, "should fail to produce labelled graph with no font");
 176   like($pie->error, qr/label\.font/, "message should mention which font");
 177
 178   $im = $pie->draw
 179     (
 180      data => \@data,
 181      labels => \@labels,
 182      features => [ 'allcallouts' ],
 183      label => { font => $font },
 184     );
 185   ok(!$im, "should fail to produce callout labelled graph with no font");
 186   like($pie->error, qr/callout\.font/, "message should mention which font");
 187
 188   # shouldn't need to set label font if doing all callouts
 189   $im = $pie->draw
 190     (
 191      data => \@data,
 192      labels => \@labels,
 193      features => [ 'allcallouts' ],
 194      callout => { font => $font },
 195     );
 196   ok($im, "should produce callout labelled graph with only callout font")
 197     or print "# ", $pie->error, "\n";
 198
 199   # shouldn't need to set callout font if doing all labels
 200   $im = $pie->draw
 201     (
 202      data => [ 1, 1, 1 ],
 203      labels => [ qw/a b c/ ],
 204      label => { font => $font }
 205     );
 206   ok($im, "should produce label only graph with only label font");
 207 }
 208
 209 {
 210   # draw with an empty data array is bad
 211   # problem reported and fixed by Patrick Michaud
 212   my $im = $pie->draw(data => []);
 213   ok(!$im, "fail to draw with empty data");
 214   like($pie->error, qr/No values/, "message appropriate");
 215 }
 216
 217 { # pie charts can't represent negative values
 218   # problem reported and fixed by Patrick Michaud
 219   my $im = $pie->draw(data => [ 10, -1, 10 ]);
 220   ok(!$im, "fail to draw with negative value");
 221   is($pie->error, "Data index 1 is less than zero", "check message");
 222 }
 223
 224 { # pie can't represent all zeros
 225   # problem reported and fixed by Patrick Michaud
 226   my $im = $pie->draw(data => [ 0, 0, 0 ]);
 227   ok(!$im, "fail to draw with all zero values");
 228   is($pie->error, "Sum of all data values is zero", "check message");
 229 }
 230
 231 {
 232   # test methods used to set features
 233   # adds test coverage for otherwise uncovered methods
 234   my $pie = Imager::Graph::Pie->new;
 235   $pie->add_data_series(\@data);
 236   $pie->set_labels(\@labels);
 237   $pie->set_font($font);
 238   $pie->set_style("mono");
 239   $pie->show_callouts_onAll_segments();
 240   $pie->show_label_percentages();
 241   $pie->set_legend_horizontal_align("right");
 242   $pie->set_legend_vertical_align("bottom");
 243   my $im = $pie->draw();
 244
 245   ok($im, "made mono test using methods");
 246   cmpimg($im, "testimg/t10_mono.png", 550_00);
 247 }
 248
 249 {
 250   # more method coverage
 251   my $pie = Imager::Graph::Pie->new;
 252   $pie->add_data_series(\@data);
 253   $pie->set_labels(\@labels);
 254   $pie->set_font($font);
 255   $pie->set_style("fount_lin");
 256   $pie->show_legend();
 257   $pie->show_only_label_percentages();
 258   $pie->set_legend_vertical_align("center");
 259   my $im = $pie->draw();
 260
 261   ok($im, "made lin_found test using methods");
 262   cmpimg($im, "testimg/t10_lin_fount.png", 180_00);
 263 }
 264
 265 {
 266   my $pie = Imager::Graph::Pie->new;
 267   my $im = $pie->draw(width => -1, data => \@data);
 268   ok(!$im, "shouldn't be able to create neg width image");
 269   print "# ", $pie->error, "\n";
 270   cmp_ok($pie->error, '=~', qr/^Error creating image/, "check error message");
 271 }
 272
 273 sub cmpimg {
 274   my ($img, $file, $limit) = @_;
 275
 276   $limit ||= 10000;
 277
 278  SKIP:
 279   {
 280     $Imager::formats{png}
 281       or skip("No PNG support", 1);
 282
 283     my $cmpimg = Imager->new;
 284     $cmpimg->read(file=>$file)
 285       or return ok(0, "Cannot read $file: ".$cmpimg->errstr);
 286     my $diff = Imager::i_img_diff($img->{IMG}, $cmpimg->{IMG});
 287     cmp_ok($diff, '<', $limit, "Comparison to $file ($diff)");
 288   }
 289 }