]>
Commit | Line | Data |
---|---|---|
267997be | 1 | #!perl -w |
2 | use strict; | |
3 | use Imager::Graph::Bar; | |
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 | ||
86f73dc2 | 16 | plan tests => 7; |
267997be | 17 | |
18 | my @warned; | |
19 | local $SIG{__WARN__} = | |
20 | sub { | |
21 | print STDERR $_[0]; | |
22 | push @warned, $_[0] | |
23 | }; | |
24 | ||
25 | ||
26 | #my $fontfile = 'ImUgly.ttf'; | |
27 | #my $font = Imager::Font->new(file=>$fontfile, type => 'ft2', aa=>1) | |
28 | # or plan skip_all => "Cannot create font object: ",Imager->errstr,"\n"; | |
29 | my $font = Imager::Font::Test->new(); | |
30 | ||
31 | my @data = ( 100, 180, 80, 20, 2, 1, 0.5 ); | |
32 | my @labels = qw(alpha beta gamma delta epsilon phi gi); | |
33 | ||
86f73dc2 TC |
34 | { |
35 | my $bar = Imager::Graph::Bar->new(); | |
36 | $bar->set_font($font); | |
37 | ok($bar, "creating bar chart object"); | |
267997be | 38 | |
86f73dc2 TC |
39 | $bar->add_data_series(\@data); |
40 | $bar->set_labels(\@labels); | |
267997be | 41 | |
86f73dc2 TC |
42 | my $img1 = $bar->draw(); |
43 | ok($img1, "drawing bar chart"); | |
267997be | 44 | |
86f73dc2 TC |
45 | $img1->write(file=>'testout/t14_bar.ppm') or die "Can't save img1: ".$img1->errstr."\n"; |
46 | cmpimg($img1, 'testimg/t14_bar.ppm', 1); | |
47 | } | |
48 | ||
49 | { # alternative interfaces | |
50 | my $bar = Imager::Graph::Horizontal->new(); | |
51 | $bar->set_font($font); | |
52 | ok($bar, "creating bar chart object"); | |
53 | ||
54 | $bar->add_bar_data_series(\@data); | |
55 | $bar->set_labels(\@labels); | |
56 | ||
57 | my $img1 = $bar->draw(); | |
58 | ok($img1, "drawing bar chart"); | |
59 | ||
60 | $img1->write(file=>'testout/t14_bar2.ppm') or die "Can't save img1: ".$img1->errstr."\n"; | |
61 | cmpimg($img1, 'testimg/t14_bar.ppm', 1); | |
62 | } | |
267997be | 63 | |
64 | unless (is(@warned, 0, "should be no warnings")) { | |
65 | diag($_) for @warned; | |
66 | } | |
67 | ||
68 | sub cmpimg { | |
69 | my ($img, $file, $limit) = @_; | |
70 | ||
71 | $limit ||= 10000; | |
72 | ||
73 | my $cmpimg = Imager->new; | |
74 | $cmpimg->read(file=>$file) | |
75 | or return ok(0, "Cannot read $file: ".$cmpimg->errstr); | |
76 | my $diff = Imager::i_img_diff($img->{IMG}, $cmpimg->{IMG}); | |
77 | cmp_ok($diff, '<', $limit, "Comparison to $file ($diff)"); | |
78 | } | |
79 |