]>
Commit | Line | Data |
---|---|---|
618a3282 TC |
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 | } |