1
2use strict;
3use warnings;
4
5use Test::More;
6use Prima::sys::Test qw(noX11);
7
8sub is_pict
9{
10	my ( $i, $name, $pict ) = @_;
11	my $ok = 1;
12	ALL: for ( my $y = 0; $y < $i->height; $y++) {
13		for ( my $x = 0; $x < $i->width; $x++) {
14			my $actual   = ( $i->pixel($x,$y) > 0) ? 1 : 0;
15			my $expected = (substr($pict, ($i->height-$y-1) * $i->width + $x, 1) eq ' ') ? 0 : 1;
16			next if $actual == $expected;
17			$ok = 0;
18			last ALL;
19		}
20	}
21	ok( $ok, $name );
22	return 1 if $ok;
23	warn "# Actual vs expected:\n";
24	for ( my $y = 0; $y < $i->height; $y++) {
25		my $actual   = join '', map { ($i->pixel($_,$i->height-$y-1) > 0) ? '*' : ' ' } 0..$i->width-1;
26		my $expected = substr($pict, $y * $i->width, $i->width);
27		warn "$actual  | $expected\n";
28	}
29	return 0;
30}
31
32# check optimizers
33for my $bpp ( 1, 4, 8, 24 ) {
34	my $i = Prima::Image->create(
35		width     => 5,
36		height    => 5,
37		type      => $bpp,
38		color     => cl::White,
39		backColor => cl::Black,
40	);
41
42	$i->clear;
43	$i->line(1,1,3,1);
44	is_pict($i, "$bpp: unclipped hline",
45		"     ".
46		"     ".
47		"     ".
48		" *** ".
49		"     "
50	);
51
52	$i->clear;
53	$i->line(-1,1,3,1);
54	is_pict($i, "$bpp: left clipped hline",
55		"     ".
56		"     ".
57		"     ".
58		"**** ".
59		"     "
60	);
61
62	$i->clear;
63	$i->line(1,1,9,1);
64	is_pict($i, "$bpp: left clipped hline",
65		"     ".
66		"     ".
67		"     ".
68		" ****".
69		"     "
70	);
71
72	$i->clear;
73	$i->line(-1,1,9,1);
74	is_pict($i, "$bpp: clipped hline",
75		"     ".
76		"     ".
77		"     ".
78		"*****".
79		"     "
80	);
81
82	$i->clear;
83	$i->rop(rop::XorPut);
84	$i->rectangle( 1,1,3,3);
85	is_pict($i, "$bpp: rectangle",
86		"     ".
87		" *** ".
88		" * * ".
89		" *** ".
90		"     "
91	);
92}
93
94# those are unoptimized
95my $i = Prima::Image->create(
96	width     => 5,
97	height    => 5,
98	type      => im::bpp1,
99	color     => cl::White,
100	backColor => cl::Black,
101);
102$i->clear;
103$i->line(1,1,3,3);
104is_pict($i, "line",
105	"     ".
106	"   * ".
107	"  *  ".
108	" *   ".
109	"     "
110);
111
112
113$i->clear;
114$i->linePattern(lp::DotDot);
115$i->rop2(rop::NoOper);
116$i->line(1,1,3,3);
117$i->linePattern(lp::Solid);
118is_pict($i, "line dotted transparent",
119	"     ".
120	"   * ".
121	"     ".
122	" *   ".
123	"     "
124);
125
126$i->clear;
127$i->linePattern(lp::DotDot);
128$i->rop2(rop::CopyPut);
129$i->line(1,1,3,3);
130$i->linePattern(lp::Solid);
131is_pict($i, "line dotted opaque white",
132	"     ".
133	"   * ".
134	"     ".
135	" *   ".
136	"     "
137);
138
139$i->clear;
140$i->backColor(cl::White);
141$i->linePattern(lp::DotDot);
142$i->rop2(rop::CopyPut);
143$i->line(1,1,3,3);
144$i->backColor(cl::Black);
145$i->linePattern(lp::Solid);
146is_pict($i, "line dotted opaque black",
147	"     ".
148	"   * ".
149	"  *  ".
150	" *   ".
151	"     "
152);
153
154$i->clear;
155$i->region( Prima::Region->new( box => [2,2,1,1]));
156$i->line(1,1,3,3);
157is_pict($i, "line with simple region",
158	"     ".
159	"     ".
160	"  *  ".
161	"     ".
162	"     "
163);
164$i->region( undef );
165
166$i->clear;
167$i->region( Prima::Region->new( box => [1,1,1,1, 3,3,1,1]));
168$i->line(1,1,3,3);
169is_pict($i, "line with complex region",
170	"     ".
171	"   * ".
172	"     ".
173	" *   ".
174	"     "
175);
176$i->region( undef );
177
178$i->clear;
179$i->region( Prima::Region->new( box => [10,10,10,10]));
180$i->line(1,1,3,3);
181is_pict($i, "line outside region",
182	"     ".
183	"     ".
184	"     ".
185	"     ".
186	"     "
187);
188$i->region( undef );
189
190$i->clear;
191$i->region( Prima::Region->new( box => [1,1,1,1, 3,3,1,1]));
192$i->translate(-1,-1);
193$i->line(1,1,3,3);
194is_pict($i, "line with complex region and transform",
195	"     ".
196	"     ".
197	"     ".
198	" *   ".
199	"     "
200);
201$i->translate(0,0);
202$i->region( undef );
203
204$i->linePattern(lp::Solid);
205$i->clear;
206$i->ellipse(2,2,5,5);
207is_pict($i, "ellipse",
208	"  *  ".
209	" * * ".
210	"*   *".
211	" * * ".
212	"  *  "
213);
214
215$i->clear;
216$i->arc(2,2,5,5,0,90);
217is_pict($i, "arc",
218	"  *  ".
219	"   * ".
220	"    *".
221	"     ".
222	"     "
223);
224
225$i->clear;
226$i->chord(2,2,5,5,180,0);
227is_pict($i, "chord",
228	"  *  ".
229	" * * ".
230	"*****".
231	"     ".
232	"     "
233);
234
235$i->clear;
236$i->sector(2,2,5,5,0,270);
237is_pict($i, "sector",
238	"  *  ".
239	" * * ".
240	"* ***".
241	" **  ".
242	"  *  "
243);
244
245$i->clear;
246$i->lines([1,1,3,1, 1,3,3,3, 1,4,4,4]);
247is_pict($i, "lines",
248	" ****".
249	" *** ".
250	"     ".
251	" *** ".
252	"     "
253);
254
255$i->clear;
256$i->polyline([1,1,4,1,1,4,4,4]);
257is_pict($i, "polyline",
258	" ****".
259	"  *  ".
260	"   * ".
261	" ****".
262	"     "
263);
264
265$i->clear;
266$i->fillMode(fm::Overlay|fm::Winding);
267$i->fill_ellipse(2,2,5,5);
268is_pict($i, "fill_ellipse",
269	"  *  ".
270	" *** ".
271	"*****".
272	" *** ".
273	"  *  "
274);
275
276$i->clear;
277$i->fill_sector(2,2,5,5,0,90);
278is_pict($i, "fill_sector",
279	"  *  ".
280	"  ** ".
281	"  ***".
282	"     ".
283	"     "
284);
285
286$i->clear;
287$i->fill_chord(2,2,5,5,0,90);
288is_pict($i, "fill_chord",
289	"  *  ".
290	"   * ".
291	"    *".
292	"     ".
293	"     "
294);
295
296done_testing;
297