1use strict;
2use warnings;
3
4use Test::More;
5use Prima::sys::Test;
6
7plan tests => 119;
8
9my $x = Prima::DeviceBitmap-> create( type => dbt::Bitmap, width => 8, height => 8);
10# 1
11ok( $x && $x-> get_paint_state, "create");
12$x-> color( cl::White);
13$x-> bar( 0, 0, 7, 7);
14
15# 2
16my $coordinates = [
17    [ 0, 0, 0xFFFFFF ],
18    [ 0, 2, 0xFFFFFF ],
19    [ 0, 4, 0xFFFFFF ],
20    [ 0, 6, 0xFFFFFF ],
21    [ 1, 0, 0xFFFFFF ],
22    [ 2, 0, 0xFFFFFF ],
23    [ 3, 7, 0xFFFFFF ],
24    [ 4, 0, 0xFFFFFF ],
25    [ 5, 0, 0xFFFFFF ],
26    [ 6, 6, 0xFFFFFF ],
27    [ 7, 5, 0xFFFFFF ],
28    [ 2, 2, 0xFFFFFF ],
29    [ 4, 3, 0xFFFFFF ],
30    [ 5, 6, 0xFFFFFF ],
31    [ 6, 5, 0xFFFFFF ],
32    [ 0, 7, 0xFFFFFF ]
33];
34run_tests( $x, $coordinates, "pixel");
35
36# 3
37$coordinates = [
38    [ 1, 1, 0 ],
39    [ 2, 2, 0 ],
40    [ 6, 6, 0 ],
41    [ 4, 5, 0 ]
42];
43for my $coordinate( @$coordinates ) {
44    my ($xco, $yco) = @$coordinate;
45    $x-> pixel( $xco, $yco, cl::Black);
46}
47run_tests( $x, $coordinates, "line" );
48
49# 4
50$x-> color( cl::White);
51$x-> bar( 0, 0, 7, 7);
52$x-> color( cl::Black);
53$x-> line( 1, 1, 6, 6);
54$coordinates = [
55    [ 1, 1, 0 ],
56    [ 6, 6, 0 ],
57    [ 0, 0, 0xFFFFFF ],
58    [ 7, 7, 0xFFFFFF ]
59    ];
60run_tests( $x, $coordinates, "line" );
61
62# 5
63$x-> color( cl::White);
64$x-> bar( 0, 0, 7, 7);
65$x-> color( cl::Black);
66$x-> lines([2,1,6,1,4,6,3,3]);
67$coordinates = [
68    [ 2, 1, 0 ],
69    [ 6, 1, 0 ],
70    [ 4, 6, 0 ],
71    [ 3, 3, 0 ],
72    [ 1, 1, 0xFFFFFF ],
73    [ 1, 0, 0xFFFFFF ],
74    [ 7, 1, 0xFFFFFF ],
75    [ 4, 7, 0xFFFFFF ],
76    [ 7, 0, 0xFFFFFF ]
77    ];
78run_tests( $x, $coordinates, "lines");
79
80# 6
81$x-> color( cl::White);
82$x-> bar( 0, 0, 7, 7);
83$x-> color( cl::Black);
84$x-> polyline([2,1,6,1,4,6]);
85$coordinates = [
86    [ 2, 1, 0 ],
87    [ 6, 1, 0 ],
88    [ 4, 6, 0 ],
89    [ 1, 1, 0xFFFFFF ],
90    [ 1, 0, 0xFFFFFF ],
91    [ 7, 1, 0xFFFFFF ],
92    [ 4, 7, 0xFFFFFF ],
93    [ 7, 0, 0xFFFFFF ]
94    ];
95run_tests( $x, $coordinates, "polyline");
96
97# 7
98$x-> color( cl::White);
99$x-> bar( 0, 0, 7, 7);
100$x-> color( cl::Black);
101$x-> rectangle( 1, 1, 3, 3);
102$coordinates = [
103    [ 1, 1, 0 ],
104    [ 3, 3, 0 ],
105    [ 2, 2, 0xFFFFFF ],
106    [ 0, 0, 0xFFFFFF ],
107    [ 4, 4, 0xFFFFFF ]
108];
109run_tests( $x, $coordinates, "rectangle");
110
111# 8
112$x-> color( cl::White);
113$x-> bar( 0, 0, 7, 7);
114$x-> color( cl::Black);
115$x-> ellipse( 2, 2, 3, 3);
116$coordinates = [
117    [ 1, 2, 0 ],
118    [ 2, 1, 0 ],
119    [ 2, 3, 0 ],
120    [ 3, 2, 0 ],
121    [ 2, 2, 0xFFFFFF ],
122    [ 1, 0, 0xFFFFFF ],
123    [ 0, 1, 0xFFFFFF ],
124    [ 4, 3, 0xFFFFFF ],
125    [ 3, 4, 0xFFFFFF ]
126    ];
127run_tests( $x, $coordinates, "ellipse");
128
129# 9
130$x-> color( cl::White);
131$x-> bar( 0, 0, 7, 7);
132$x-> color( cl::Black);
133$x-> arc( 4, 4, 7, 7, 30, 210);
134$coordinates = [
135    [ 1, 4, 0 ],
136    [ 4, 7, 0 ],
137    [ 7, 4, 0xFFFFFF ],
138    [ 4, 1, 0xFFFFFF ]
139];
140run_tests( $x, $coordinates, "arc");
141
142
143# 10
144$x-> color( cl::White);
145$x-> bar( 0, 0, 7, 7);
146$x-> color( cl::Black);
147$x-> bar( 3, 3, 1, 1);
148$coordinates = [
149    [ 1, 1, 0 ],
150    [ 3, 3, 0 ],
151    [ 2, 2, 0 ],
152    [ 0, 0, 0xFFFFFF ],
153    [ 0, 4, 0xFFFFFF ]
154];
155run_tests( $x, $coordinates, "bar");
156
157# 11
158$x-> color( cl::White);
159$x-> bar( 0, 0, 7, 7);
160$x-> color( cl::Black);
161$x-> fillpoly([2,1,6,1,4,6]);
162$coordinates = [
163    [ 2, 1, 0 ],
164    [ 6, 1, 0 ],
165    [ 4, 6, 0 ],
166    [ 4, 4, 0 ],
167    [ 1, 1, 0xFFFFFF ],
168    [ 1, 0, 0xFFFFFF ],
169    [ 7, 1, 0xFFFFFF ],
170    [ 4, 7, 0xFFFFFF ],
171    [ 7, 0, 0xFFFFFF ]
172    ];
173run_tests( $x, $coordinates, "fillpoly");
174
175
176# 12
177$x-> color( cl::White);
178$x-> bar( 0, 0, 7, 7);
179$x-> color( cl::Black);
180$x-> fill_ellipse( 2, 2, 3, 3);
181$coordinates = [
182    [ 1, 2, 0 ],
183    [ 2, 1, 0 ],
184    [ 2, 3, 0 ],
185    [ 3, 2, 0 ],
186    [ 2, 2, 0 ],
187    [ 1, 0, 0xFFFFFF ],
188    [ 0, 1, 0xFFFFFF ],
189    [ 4, 3, 0xFFFFFF ],
190    [ 3, 4, 0xFFFFFF ],
191    ];
192run_tests( $x, $coordinates, "fill_ellipse");
193
194
195# 13
196$x-> color( cl::White);
197$x-> bar( 0, 0, 7, 7);
198$x-> color( cl::Black);
199$x-> fill_chord( 4, 4, 7, 7, 30, 210);
200$coordinates = [
201    [ 1, 4, 0 ],
202    [ 4, 7, 0 ],
203    [ 4, 4, 0 ],
204    [ 7, 4, 0xFFFFFF ],
205    [ 4, 1, 0xFFFFFF ]
206];
207run_tests( $x, $coordinates, "fill_chord");
208
209# 14
210$x-> color( cl::White);
211$x-> flood_fill( 1, 4, cl::Black);
212$coordinates = [
213    [ 1, 4, 0xFFFFFF ],
214    [ 4, 7, 0xFFFFFF ],
215    [ 4, 4, 0xFFFFFF ]
216    ];
217run_tests( $x, $coordinates, "flood_fill");
218
219# 15
220$x-> color( cl::White);
221$x-> bar( 0, 0, 7, 7);
222$x-> color( cl::Black);
223$x-> clipRect( 2, 2, 3, 3);
224$x-> bar( 1, 1, 2, 2);
225$x-> clipRect( 0, 0, $x-> size);
226$coordinates = [
227    [ 2, 2, 0 ],
228    [ 1, 1, 0xFFFFFF ]
229    ];
230run_tests( $x, $coordinates, "clipRect");
231
232# 16
233$x-> color( cl::White);
234$x-> bar( 0, 0, 7, 7);
235$x-> color( cl::Black);
236$x-> translate( -1, 1);
237$x-> bar( 2, 2, 3, 3);
238$x-> translate( 0, 0);
239$coordinates = [
240    [ 1, 4, 0 ],
241    [ 3, 2, 0xFFFFFF ],
242    ];
243run_tests( $x, $coordinates, "translate" );
244
245# 17
246$x-> color( cl::White);
247$x-> bar( 0, 0, 7, 7);
248$x-> pixel( 1,2,cl::Black);
249$x-> pixel( 2,1,cl::Black);
250$x-> pixel( 2,3,cl::Black);
251$x-> pixel( 3,2,cl::Black);
252$x-> pixel( 2,2,cl::Black);
253my $image = $x-> image;
254$x-> color( cl::White);
255$x-> bar( 0, 0, 7, 7);
256$x-> put_image( 0, 0, $image);
257$coordinates = [
258    [ 1, 2, 0 ],
259    [ 2, 1, 0 ],
260    [ 2, 3, 0 ],
261    [ 3, 2, 0 ],
262    [ 2, 2, 0 ],
263    [ 1, 1, 0xFFFFFF ],
264    [ 3, 3, 0xFFFFFF ]
265];
266run_tests( $x, $coordinates, "put_image");
267
268# 18
269$x-> color( cl::White);
270$x-> bar( 0, 0, 7, 7);
271$x-> stretch_image( 0, 0, 16, 16, $image);
272$coordinates = [
273    [ 2, 4, 0 ],
274    [ 4, 2, 0 ],
275    [ 4, 6, 0 ],
276    [ 6, 4, 0 ],
277    [ 4, 4, 0 ],
278    [ 2, 2, 0xFFFFFF ],
279    [ 6, 6, 0xFFFFFF ],
280    ];
281run_tests( $x, $coordinates, "stretch_image");
282
283# 19
284$x-> put_image_indirect( $image, 0, 0, 0, 0, 16, 16, 8, 8, rop::XorPut);
285$coordinates = [
286    [ 0, 0, 0 ],
287    [ 1, 1, 0 ],
288    [ 2, 2, 0 ],
289    [ 3, 3, 0 ],
290    [ 4, 4, 0 ],
291    [ 5, 5, 0 ],
292    [ 6, 6, 0 ],
293    [ 7, 7, 0 ],
294];
295run_tests( $x, $coordinates, "xor_put");
296$image-> destroy;
297
298# 20
299sub text_out_test
300{
301	my $x = shift;
302	$x-> color( cl::White);
303	$x-> bar( 0, 0, 7, 7);
304	$x-> color( cl::Black);
305	$x-> font-> height( 8);
306	$x-> text_out( "xyz", 0, 0);
307	my $xi = $x-> image;
308	$xi->type(im::BW);
309	my ( $i, $j);
310	my ( $wh, $bl) = ( 0, 0);
311	for ( $i = 0; $i < 8; $i++) {
312		for ( $j = 0; $j < 8; $j++) {
313			$xi-> pixel( $i,$j) == 0 ?
314				$bl++ : $wh++;
315		}
316	}
317	return $bl;
318}
319
320my $bl = text_out_test($x);
321if ( $bl == 0 ) {
322	# did we hit this bug? https://gitlab.freedesktop.org/xorg/xserver/issues/87
323	my $x = Prima::DeviceBitmap-> create( type => dbt::Pixmap, width => 8, height => 8);
324	$bl = text_out_test($x);
325}
326
327
328cmp_ok( $bl, '>', 5, "text_out");
329
330# 21
331my $y = Prima::DeviceBitmap-> create( type => dbt::Bitmap, width => 2, height => 2);
332$y-> clear;
333$y-> pixel( 0, 0, cl::Black);
334$y-> translate( 1, 1);
335$x-> color( cl::White);
336$x-> bar(0,0,8,8);
337$x-> set( color => cl::Black, backColor => cl::White);
338$x-> put_image( 0, 0, $y);
339$y-> destroy;
340is( $x-> pixel( 0, 0), 0, 'dbm(put_image)');
341
342$x-> destroy;
343
344sub run_tests {
345    my ($x, $coordinates, $name) =  @_;
346    for my $coordinate( @$coordinates ) {
347        my ($xco, $yco, $expected) = @$coordinate;
348        is( $x->pixel( $xco, $yco ), $expected, "$name ($xco, $yco)" );
349    }
350}
351