projects / imager.git / blame
| 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 | } |