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