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