ignore more build detritus
[imager-graph.git] / 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_000);
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 }