test coverage and fix pass for compose()
[imager.git] / t / t62compose.t
1 #!perl -w
2 use strict;
3 use Imager qw(:handy);
4 use Test::More tests => 114;
5 use Imager::Test qw(is_image is_imaged);
6
7 -d "testout" or mkdir "testout";
8
9 Imager::init_log("testout/t62compose.log", 1);
10
11 my @files;
12
13 my %types =
14   (
15    double =>
16    {
17     blue => NCF(0, 0, 1),
18     red =>  NCF(1, 0, 0),
19     green2 => NCF(0, 1, 0, 0.5),
20     green2_on_blue => NCF(0, 0.5, 0.5),
21     red3_on_blue => NCF(1/3, 0, 2/3),
22     green6_on_blue => NCF(0, 1/6, 5/6),
23     red2_on_blue => NCF(0.5, 0, 0.5),
24     green4_on_blue => NCF(0, 0.25, 0.75),
25     gray100 => NCF(1.0, 0, 0),
26     gray50 => NCF(0.5, 0, 0),
27     is_image => \&is_imaged,
28    },
29    8 =>
30    {
31     blue => NC(0, 0, 255),
32     red =>  NC(255, 0, 0),
33     green2 => NC(0, 255, 0, 128),
34     green2_on_blue => NC(0, 128, 127),
35     red3_on_blue => NC(85, 0, 170),
36     green6_on_blue => NC(0, 42, 213),
37     red2_on_blue => NC(128, 0, 127),
38     green4_on_blue => NC(0, 64, 191),
39     gray100 => NC(255, 0, 0),
40     gray50 => NC(128, 0, 0),
41     is_image => \&is_image,
42    },
43   );
44
45 for my $type_id (sort keys %types) {
46   my $type = $types{$type_id};
47   my $blue = $type->{blue};
48   my $red = $type->{red};
49   my $green2 = $type->{green2};
50   my $green2_on_blue = $type->{green2_on_blue};
51   my $red3_on_blue = $type->{red3_on_blue};
52   my $green6_on_blue = $type->{green6_on_blue};
53   my $red2_on_blue = $type->{red2_on_blue};
54   my $green4_on_blue = $type->{green4_on_blue};
55   my $gray100 = $type->{gray100};
56   my $gray50 = $type->{gray50};
57   my $is_image = $type->{is_image};
58
59   print "# type $type_id\n";
60   my $targ = Imager->new(xsize => 100, ysize => 100, bits => $type_id);
61   $targ->box(color => $blue, filled => 1);
62   is($targ->type, "direct", "check target image type");
63   is($targ->bits, $type_id, "check target bits");
64
65   my $src = Imager->new(xsize => 40, ysize => 40, channels => 4, bits => $type_id);
66   $src->box(filled => 1, color => $red, xmax => 19, ymax => 19);
67   $src->box(filled => 1, xmin => 20, color => $green2);
68   save_to($src, "${type_id}_src");
69
70   my $mask_ones = Imager->new(channels => 1, xsize => 40, ysize => 40, bits => $type_id);
71   $mask_ones->box(filled => 1, color => NC(255, 255, 255));
72
73
74   # mask or full mask, should be the same
75   for my $mask_info ([ "nomask" ], [ "fullmask", mask => $mask_ones ]) {
76     my ($mask_type, @mask_extras) = @$mask_info;
77     print "# $mask_type\n";
78     {
79       my $cmp = $targ->copy;
80       $cmp->box(filled => 1, color => $red,
81                 xmin=> 5, ymin => 10, xmax => 24, ymax => 29);
82       $cmp->box(filled => 1, color => $green2_on_blue,
83                 xmin => 25, ymin => 10, xmax => 44, ymax => 49);
84       {
85         my $work = $targ->copy;
86         ok($work->compose(src => $src, tx => 5, ty => 10, @mask_extras),
87            "$mask_type - simple compose");
88         $is_image->($work, $cmp, "check match");
89         save_to($work, "${type_id}_${mask_type}_simple");
90       }
91       { # >1 opacity
92         my $work = $targ->copy;
93         ok($work->compose(src => $src, tx => 5, ty => 10, opacity => 2.0, @mask_extras),
94            "$mask_type - compose with opacity > 1.0 acts like opacity=1.0");
95         $is_image->($work, $cmp, "check match");
96       }
97       { # 0 opacity is a failure
98         my $work = $targ->copy;
99         ok(!$work->compose(src => $src, tx => 5, ty => 10, opacity => 0.0, @mask_extras),
100            "$mask_type - compose with opacity = 0 is an error");
101         is($work->errstr, "opacity must be positive", "check message");
102       }
103     }
104     { # compose at 1/3
105       my $work = $targ->copy;
106       ok($work->compose(src => $src, tx => 7, ty => 33, opacity => 1/3, @mask_extras),
107          "$mask_type - simple compose at 1/3");
108       my $cmp = $targ->copy;
109       $cmp->box(filled => 1, color => $red3_on_blue,
110                 xmin => 7, ymin => 33, xmax => 26, ymax => 52);
111       $cmp->box(filled => 1, color => $green6_on_blue,
112                 xmin => 27, ymin => 33, xmax => 46, ymax => 72);
113       $is_image->($work, $cmp, "check match");
114     }
115     { # targ off top left
116       my $work = $targ->copy;
117       ok($work->compose(src => $src, tx => -5, ty => -3, @mask_extras),
118          "$mask_type - compose off top left");
119       my $cmp = $targ->copy;
120       $cmp->box(filled => 1, color => $red,
121                 xmin=> 0, ymin => 0, xmax => 14, ymax => 16);
122       $cmp->box(filled => 1, color => $green2_on_blue,
123                 xmin => 15, ymin => 0, xmax => 34, ymax => 36);
124       $is_image->($work, $cmp, "check match");
125     }
126     { # targ off bottom right
127       my $work = $targ->copy;
128       ok($work->compose(src => $src, tx => 65, ty => 67, @mask_extras),
129          "$mask_type - targ off bottom right");
130       my $cmp = $targ->copy;
131       $cmp->box(filled => 1, color => $red,
132                 xmin=> 65, ymin => 67, xmax => 84, ymax => 86);
133       $cmp->box(filled => 1, color => $green2_on_blue,
134                 xmin => 85, ymin => 67, xmax => 99, ymax => 99);
135       $is_image->($work, $cmp, "check match");
136     }
137     { # src off top left
138       my $work = $targ->copy;
139       my @more_mask_extras;
140       if (@mask_extras) {
141         push @more_mask_extras,
142           (
143            mask_left => -5,
144            mask_top => -15,
145           );
146       }
147       ok($work->compose(src => $src, tx => 10, ty => 20,
148                         src_left => -5, src_top => -15,
149                         @mask_extras, @more_mask_extras),
150          "$mask_type - source off top left");
151       my $cmp = $targ->copy;
152       $cmp->box(filled => 1, color => $red,
153                 xmin=> 15, ymin => 35, xmax => 34, ymax => 54);
154       $cmp->box(filled => 1, color => $green2_on_blue,
155               xmin => 35, ymin => 35, xmax => 54, ymax => 74);
156       $is_image->($work, $cmp, "check match");
157     }
158     {
159       # src off bottom right
160       my $work = $targ->copy;
161       ok($work->compose(src => $src, tx => 10, ty => 20,
162                         src_left => 10, src_top => 15,
163                         width => 40, height => 40, @mask_extras),
164          "$mask_type - source off bottom right");
165       my $cmp = $targ->copy;
166       $cmp->box(filled => 1, color => $red,
167                 xmin=> 10, ymin => 20, xmax => 19, ymax => 24);
168       $cmp->box(filled => 1, color => $green2_on_blue,
169                 xmin => 20, ymin => 20, xmax => 39, ymax => 44);
170       $is_image->($work, $cmp, "check match");
171     }
172     {
173       # simply out of bounds
174       my $work = $targ->copy;
175       ok(!$work->compose(src => $src, tx => 100, @mask_extras),
176          "$mask_type - off the right of the target");
177       $is_image->($work, $targ, "no changes");
178       ok(!$work->compose(src => $src, ty => 100, @mask_extras),
179          "$mask_type - off the bottom of the target");
180       $is_image->($work, $targ, "no changes");
181       ok(!$work->compose(src => $src, tx => -40, @mask_extras),
182          "$mask_type - off the left of the target");
183       $is_image->($work, $targ, "no changes");
184       ok(!$work->compose(src => $src, ty => -40, @mask_extras),
185          "$mask_type - off the top of the target");
186       $is_image->($work, $targ, "no changes");
187     }
188   }
189
190   # masked tests
191   my $mask = Imager->new(xsize => 40, ysize => 40, channels => 1, bits => $type_id);
192   $mask->box(filled => 1, xmax => 19, color => $gray100);
193   $mask->box(filled => 1, xmin => 20, ymax => 14, xmax => 34,
194              color => $gray50);
195   is($mask->bits, $type_id, "check mask bits");
196   {
197     my $work = $targ->copy;
198     ok($work->compose(src => $src, tx => 5, ty => 7,
199                       mask => $mask),
200        "simple draw masked");
201     my $cmp = $targ->copy;
202     $cmp->box(filled => 1, color => $red,
203               xmin => 5, ymin => 7, xmax => 24, ymax => 26);
204     $cmp->box(filled => 1, color => $green4_on_blue,
205               xmin => 25, ymin => 7, xmax => 39, ymax => 21);
206     $is_image->($work, $cmp, "check match");
207     save_to($work, "${type_id}_simp_masked");
208     save_to($work, "${type_id}_simp_masked_cmp");
209   }
210   {
211     my $work = $targ->copy;
212     ok($work->compose(src => $src, tx => 5, ty => 7,
213                       mask_left => 5, mask_top => 2, 
214                       mask => $mask),
215        "draw with mask offset");
216     my $cmp = $targ->copy;
217     $cmp->box(filled => 1, color => $red,
218               xmin => 5, ymin => 7, xmax => 19, ymax => 26);
219     $cmp->box(filled => 1, color => $red2_on_blue,
220               xmin => 20, ymin => 7, xmax => 24, ymax => 19);
221     $cmp->box(filled => 1, color => $green4_on_blue,
222               xmin => 25, ymin => 7, xmax => 34, ymax => 19);
223     $is_image->($work, $cmp, "check match");
224   }
225   {
226     my $work = $targ->copy;
227     ok($work->compose(src => $src, tx => 5, ty => 7,
228                       mask_left => -3, mask_top => -2, 
229                       mask => $mask),
230        "draw with negative mask offsets");
231     my $cmp = $targ->copy;
232     $cmp->box(filled => 1, color => $red,
233               xmin => 8, ymin => 9, xmax => 24, ymax => 26);
234     $cmp->box(filled => 1, color => $green2_on_blue,
235               xmin => 25, ymin => 9, xmax => 27, ymax => 46);
236     $cmp->box(filled => 1, color => $green4_on_blue,
237               xmin => 28, ymin => 9, xmax => 42, ymax => 23);
238     $is_image->($work, $cmp, "check match");
239   }
240 }
241
242 unless ($ENV{IMAGER_KEEP_FILES}) {
243   unlink @files;
244 }
245
246 sub save_to {
247   my ($im, $name) = @_;
248
249   my $type = $ENV{IMAGER_SAVE_TYPE} || "ppm";
250   $name = "testout/t62_$name.$type";
251   $im->write(file => $name,
252              pnm_write_wide_data => 1);
253   push @files, $name;
254 }