1use strict; 2use warnings; 3 4use Test::More; 5use Prima::sys::Test; 6use Prima qw(Application); 7 8plan tests => 1835; 9 10my ($src, $mask, $dst); 11my $can_argb = $::application->get_system_value(sv::LayeredWidgets); 12 13sub test_src 14{ 15 my $descr = shift; 16 $src->pixel(0,0,cl::Black); 17 $src->pixel(1,0,cl::White); 18 my $ok = $dst->put_image(0,0,$src); 19 ok( $ok, "put $descr" ); 20 is( $dst->pixel(0,0), cl::Black, "$descr 0"); 21 is( $dst->pixel(1,0), cl::White, "$descr 1"); 22} 23 24sub bitop 25{ 26 my ( $pix, $descr, $s, $m, $d ) = @_; 27 my $res = ( $d & $m ) ^ $s; 28 my $clr = $res ? cl::White : cl::Black; 29 is($pix, $clr, "$descr ($s & $m ^ $d == $res)"); 30} 31 32sub fill_dst 33{ 34 my $dst = shift; 35 $dst->rop(rop::CopyPut); 36 $dst->pixel(0,0,cl::Black); 37 $dst->pixel(1,0,cl::Black); 38 $dst->pixel(2,0,cl::Black); 39 $dst->pixel(3,0,cl::Black); 40 $dst->pixel(0,1,cl::White); 41 $dst->pixel(1,1,cl::White); 42 $dst->pixel(2,1,cl::White); 43 $dst->pixel(3,1,cl::White); 44} 45 46sub test_mask 47{ 48# .... .*.* ..** ..** 49# **** & .*.* ^ ..** = .**. 50# 51# this doesn't work with RGBA blending because XOR can do inversions, while alpha channel cannot 52# 53 my $descr = shift; 54 55 56 $mask->pixel(0,0,cl::Black); 57 $mask->pixel(1,0,cl::White); 58 $mask->pixel(2,0,cl::Black); 59 $mask->pixel(3,0,cl::White); 60 # convert AND-mask to alpha-channel (only to be converted back, but still..) 61 $mask->put_image( 0, 0, $mask, rop::NotPut) if $mask->type == im::Byte; 62 63 $src->pixel(0,0,cl::Black); 64 $src->pixel(1,0,cl::Black); 65 $src->pixel(2,0,cl::White); 66 $src->pixel(3,0,cl::White); 67 68 fill_dst($dst); 69 70 my $icon = Prima::Icon->new; 71 $icon->combine($src,$mask); 72 73 my $ok = 1; 74 $ok &= $dst->put_image(0,0,$icon); 75 $ok &= $dst->put_image(0,1,$icon); 76 ok( $ok, "put $descr" ); 77 78 bitop( $dst->pixel(0,0), $descr, 0,0,0); 79 bitop( $dst->pixel(1,0), $descr, 0,1,0); 80 bitop( $dst->pixel(2,0), $descr, 1,0,0); 81 bitop( $dst->pixel(3,0), $descr, 1,1,0); 82 83 bitop( $dst->pixel(0,1), $descr, 0,0,1); 84 bitop( $dst->pixel(1,1), $descr, 0,1,1); 85 bitop( $dst->pixel(2,1), $descr, 1,0,1); 86 bitop( $dst->pixel(3,1), $descr, 1,1,1); 87 88 # test 2: test a8 source in paint 89} 90 91sub test_dst 92{ 93 my ($target, %opt) = @_; 94 $src = Prima::DeviceBitmap->create( width => 2, height => 1, type => dbt::Bitmap); 95 $dst->set(color => cl::Black, backColor => cl::White); 96 test_src( "bitmap on $target"); 97 98 $dst->set(color => cl::White, backColor => cl::Black); 99 $dst->clear; 100 $src->pixel(0,0,cl::Black); 101 $dst->put_image(0,0,$src); 102 is( $dst->pixel(0,0), cl::White, "inverse bitmap on $target 0"); 103 $src->pixel(0,0,cl::White); 104 $dst->put_image(0,0,$src); 105 is( $dst->pixel(0,0), cl::Black, "inverse bitmap on $target 1"); 106 107 $dst->set(color => cl::Black, backColor => cl::Black); 108 $src->pixel(0,0,cl::Black); 109 $dst->put_image(0,0,$src); 110 is( $dst->pixel(0,0), cl::Black, "clear bitmap on $target 0"); 111 $src->pixel(0,0,cl::White); 112 $dst->put_image(0,0,$src); 113 is( $dst->pixel(0,0), cl::Black, "clear bitmap on $target 1"); 114 115 $dst->set(color => cl::White, backColor => cl::White); 116 $src->pixel(0,0,cl::Black); 117 $dst->put_image(0,0,$src); 118 is( $dst->pixel(0,0), cl::White, "set bitmap on $target 0"); 119 $src->pixel(0,0,cl::White); 120 $dst->put_image(0,0,$src); 121 is( $dst->pixel(0,0), cl::White, "set bitmap on $target 1"); 122 123 $src = Prima::DeviceBitmap->create( width => 2, height => 1, type => dbt::Pixmap); 124 test_src( "pixmap on $target"); 125 126 $src = Prima::Image->create( width => 2, height => 1, type => im::BW); 127 test_src( "im::BW on $target"); 128 is( unpack('C', $src->data), 0x40, "im::BW pixel(white) = 1"); 129 130 $src->begin_paint; 131 test_src( "im::BW/paint on $target"); 132 133 $dst->set(color => cl::White, backColor => cl::Black); 134 test_src( "inverse im::BW/paint on $target"); 135 $dst->set(color => cl::Black, backColor => cl::Black); 136 test_src( "clear im::BW/paint on $target"); 137 $dst->set(color => cl::White, backColor => cl::White); 138 test_src( "set im::BW/paint on $target"); 139 $src->end_paint; 140 141 $src->type(im::bpp1); 142 $src->colormap(cl::Black, cl::White); 143 test_src( "im::bpp1/BW on $target"); 144 $src->colormap(cl::White, cl::Black); 145 test_src( "im::bpp1/WB on $target"); 146 147 $src->colormap(cl::White, cl::Black); 148 $src->begin_paint; 149 test_src( "im::bpp1/paint on $target"); 150 $src->end_paint; 151 152 $src->type(im::bpp4); 153 test_src( "im::bpp4 on $target"); 154 155 $src->type(im::bpp4); 156 $src->colormap(cl::White, cl::Black); 157 $src->begin_paint; 158 test_src( "im::bpp4/paint on $target"); 159 $src->end_paint; 160 161 $src->type(im::bpp8); 162 test_src( "im::bpp8 on $target"); 163 164 $src->type(im::bpp8); 165 $src->colormap(cl::White, cl::Black); 166 $src->begin_paint; 167 test_src( "im::bpp8/paint on $target"); 168 $src->end_paint; 169 170 $src->set( type => im::RGB); 171 test_src( "im::RGB on $target"); 172 $src->begin_paint; 173 test_src( "im::RGB/paint on $target"); 174 $src->end_paint; 175 176 $mask = Prima::Image->create( width => 4, height => 1, type => im::BW); 177 $src = Prima::Image->create( width => 4, height => 1, type => im::BW); 178 test_mask( "1-bit grayscale xor mask / 1-bit and mask on $target"); 179 for my $bit ( 4, 8, 24) { 180 $src = Prima::Image->create( width => 4, height => 1, type => $bit); 181 test_mask( "$bit-bit xor mask / 1-bit and mask on $target"); 182 } 183 184 $mask = Prima::Image->create( width => 4, height => 1, type => im::Byte); 185 $src = Prima::Image->create( width => 4, height => 1, type => im::BW); 186 test_blend( "1-bit grayscale image / 8-bit alpha on $target"); 187 $src = Prima::Image->create( width => 4, height => 1, type => im::bpp1); 188 test_blend( "1-bit image / 8-bit alpha on $target"); 189 190 for my $bit ( 4, 8, 24) { 191 $src = Prima::Image->create( width => 4, height => 1, type => $bit); 192 test_blend( "$bit-bit image / 8-bit alpha on $target"); 193 } 194} 195 196sub blendop 197{ 198 my ( $pix, $descr, $s, $m, $d ) = @_; 199 if ( $s == 1 && $m == 0 && $d == 0 ) { 200 # this is win32/cygwin specific stuff; not that this behavior is 201 # wrong for practical blending, but still a minor WTF 202 ok( $pix == 0xffffff || $pix == 0, "$descr (($s + a$m) OVER $d ) == either 0 or 1 )"); 203 } else { 204 my $res = $m ? $s : ( $s | $d ); 205 my $clr = $res ? cl::White : cl::Black; 206 is($pix, $clr, "$descr (($s + a$m) OVER $d ) == $res)"); 207 } 208} 209 210sub test_blend_pixels 211{ 212 my ($icon, $descr) = @_; 213 214 my $ok = 1; 215 $ok &= $dst->put_image(0,0,$icon); 216 $ok &= $dst->put_image(0,1,$icon); 217 218 ok( $ok, "put $descr" ); 219 220 blendop( $dst->pixel(0,0), $descr, 0,0,0); 221 blendop( $dst->pixel(1,0), $descr, 0,1,0); 222 blendop( $dst->pixel(2,0), $descr, 1,0,0); 223 blendop( $dst->pixel(3,0), $descr, 1,1,0); 224 225 blendop( $dst->pixel(0,1), $descr, 0,0,1); 226 blendop( $dst->pixel(1,1), $descr, 0,1,1); 227 blendop( $dst->pixel(2,1), $descr, 1,0,1); 228 blendop( $dst->pixel(3,1), $descr, 1,1,1); 229} 230 231sub test_blend 232{ 233SKIP: { 234 skip "no argb capability", 9 * 3 unless $can_argb; 235# 0011 + ALPHA(1010) = 0.1* 236# 237# 0000 0.1* 0011 ( . - fully transparent ) 238# 1111 OVER 0.1* 0111 ( * - transparent white ) 239 240 my $descr = shift; 241 242 243 $mask->pixel(0,0,cl::Black); 244 $mask->pixel(1,0,cl::White); 245 $mask->pixel(2,0,cl::Black); 246 $mask->pixel(3,0,cl::White); 247 248 $src->pixel(0,0,cl::Black); 249 $src->pixel(1,0,cl::Black); 250 $src->pixel(2,0,cl::White); 251 $src->pixel(3,0,cl::White); 252 $src->type(im::RGB); 253 254 my $icon = Prima::Icon->new( autoMasking => am::None ); 255 $icon->combine($src,$mask); 256 257 fill_dst($dst); 258 $dst->rop(rop::SrcOver); 259 test_blend_pixels($icon, $descr); 260 261 fill_dst($dst); 262 $dst->rop(rop::SrcOver); 263 $icon->begin_paint; 264 test_blend_pixels($icon, "$descr (in paint)"); 265 $icon->end_paint; 266 267 fill_dst($dst); 268 $dst->rop(rop::SrcOver); 269 test_blend_pixels($icon->bitmap, "$descr (layered)"); 270}} 271 272sub test_blend_native 273{ 274# 0011 + ALPHA(1010) = 0.1* 275# 276# 0000 0.1* 0011 ( . - fully transparent ) 277# 1111 OVER 0.1* 0111 ( * - transparent white ) 278 279 my $descr = shift; 280 281 282 $mask->pixel(0,0,cl::Black); 283 $mask->pixel(1,0,cl::White); 284 $mask->pixel(2,0,cl::Black); 285 $mask->pixel(3,0,cl::White); 286 287 $src->pixel(0,0,cl::Black); 288 $src->pixel(1,0,cl::Black); 289 $src->pixel(2,0,cl::White); 290 $src->pixel(3,0,cl::White); 291 292 my $icon = Prima::Icon->new( autoMasking => am::None ); 293 $icon->combine($src,$mask); 294 295 fill_dst($dst); 296 $dst->rop(rop::SrcOver); 297 298 my $ok = 1; 299 $ok &= $dst->put_image(0,0,$icon); 300 $ok &= $dst->put_image(0,1,$icon); 301 302 my $save = $dst; 303 304 $dst = $dst->dup; 305 $dst->type(im::RGB); # to convert 0xff into 0xffffff 306 307 ok( $ok, "put $descr" ); 308 309 blendop( $dst->pixel(0,0), $descr, 0,0,0); 310 blendop( $dst->pixel(1,0), $descr, 0,1,0); 311 blendop( $dst->pixel(2,0), $descr, 1,0,0); 312 blendop( $dst->pixel(3,0), $descr, 1,1,0); 313 314 blendop( $dst->pixel(0,1), $descr, 0,0,1); 315 blendop( $dst->pixel(1,1), $descr, 0,1,1); 316 blendop( $dst->pixel(2,1), $descr, 1,0,1); 317 blendop( $dst->pixel(3,1), $descr, 1,1,1); 318 319 $dst = $save; 320} 321 322$dst = Prima::Image->create( width => 4, height => 2, type => im::RGB); 323$src = Prima::Image->create( width => 4, height => 1, type => im::RGB); 324$mask = Prima::Image->create( width => 4, height => 1, type => im::BW); 325test_mask( "reference implementation / 1bit mask"); 326 327$mask = Prima::Image->create( width => 4, height => 1, type => im::Byte); 328my $target = "reference implementation / 8bit mask"; 329$mask = Prima::Image->create( width => 4, height => 1, type => im::Byte); 330$src = Prima::Image->create( width => 4, height => 1, type => im::Byte); 331$dst = Prima::Image->create( width => 4, height => 2, type => im::Byte); 332test_blend_native( "8-bit grayscale image / 8-bit alpha on $target"); 333$dst = Prima::Image->create( width => 4, height => 2, type => im::RGB); 334$src = Prima::Image->create( width => 4, height => 1, type => im::RGB); 335test_blend_native( "24-bit image / 8-bit alpha on $target"); 336 337$dst = Prima::DeviceBitmap->create( width => 4, height => 2, type => dbt::Bitmap); 338test_dst("bitmap"); 339 340$dst = Prima::DeviceBitmap->create( width => 4, height => 2, type => dbt::Pixmap); 341test_dst("pixmap"); 342 343$dst = Prima::Image->create( width => 4, height => 2, type => im::BW); 344$dst->begin_paint; 345test_dst("im::BW"); 346$dst->end_paint; 347 348$dst = Prima::Image->create( width => 4, height => 2, type => im::bpp1); 349$dst->begin_paint; 350test_dst("im::bpp1"); 351$dst->end_paint; 352 353$dst = Prima::Image->create( width => 4, height => 2, type => im::RGB); 354$dst->begin_paint; 355test_dst("im::RGB"); 356$dst->end_paint; 357 358# Because get_pixel from non-buffered guarantees nothing. 359# .buffered is also not guaranteed, but for 8 pixel widget that shouldn't be a problem 360# 361# also, do test inside onPaint to make sure it's on the buffer, not on the screen 362$dst = Prima::Widget->create( width => 4, height => 2, buffered => 1, onPaint => sub { 363 return if get_flag; 364 set_flag; 365 test_dst("widget"); 366}); 367$dst->bring_to_front; 368SKIP: { 369 skip "cannot get widget to paint", 226 unless wait_flag; 370} 371 372SKIP: { 373 skip "no argb capability", 226 unless $can_argb; 374 reset_flag; 375 $dst = Prima::Widget->create( width => 4, height => 2, buffered => 1, layered => 1, onPaint => sub { 376 return if get_flag; 377 set_flag; 378 test_dst("argb widget"); 379 }); 380 381 $dst->bring_to_front; 382 skip "cannot get widget to paint", 226 unless wait_flag; 383} 384 385SKIP: { 386 skip "no argb capability", 226 unless $can_argb; 387 $dst = Prima::DeviceBitmap->create( width => 4, height => 2, type => dbt::Layered); 388 test_dst("layered"); 389} 390