]> git.imager.perl.org - imager.git/blame - t/250-draw/020-flood.t
1.012 release
[imager.git] / t / 250-draw / 020-flood.t
CommitLineData
95b9922f
TC
1#!perl -w
2use strict;
b785ce07 3use Test::More tests => 177;
95b9922f
TC
4use Imager;
5use Imager::Test qw(is_image);
6
40e78f96
TC
7-d "testout" or mkdir "testout";
8
95b9922f
TC
9{ # flood_fill wouldn't fill to the right if the area was just a
10 # single scan-line
11 my $im = Imager->new(xsize => 5, ysize => 3);
12 ok($im, "make flood_fill test image");
13 ok($im->line(x1 => 0, y1 => 1, x2 => 4, y2 => 1, color => "white"),
14 "create fill area");
15 ok($im->flood_fill(x => 3, y => 1, color => "blue"),
16 "fill it");
17 my $cmp = Imager->new(xsize => 5, ysize => 3);
18 ok($cmp, "make test image");
19 ok($cmp->line(x1 => 0, y1 => 1, x2 => 4, y2 => 1, color => "blue"),
20 "synthezied filled area");
21 is_image($im, $cmp, "flood_fill filled horizontal line");
22}
23
24SKIP:
25{ # flood_fill won't fill entire line below if line above is shorter
26 my $im = Imager->new(file => "testimg/filltest.ppm");
27 ok($im, "Load test image")
28 or skip("Couldn't load test image: " . Imager->errstr, 3);
29
30 # fill from first bad place
31 my $fill1 = $im->copy;
32 ok($fill1->flood_fill(x => 8, y => 2, color => "#000000"),
33 "fill from a top most spot");
34 my $cmp = Imager->new(xsize => $im->getwidth, ysize => $im->getheight);
35 is_image($fill1, $cmp, "check it filled the lot");
36 ok($fill1->write(file => "testout/t22fill1.ppm"), "save");
37
38 # second bad place
39 my $fill2 = $im->copy;
40 ok($fill2->flood_fill(x => 17, y => 3, color => "#000000"),
41 "fill from not quite top most spot");
42 is_image($fill2, $cmp, "check it filled the lot");
43 ok($fill2->write(file => "testout/t22fill2.ppm"), "save");
44}
45
46{ # verticals
47 my $im = vimage("FFFFFF");
48 my $cmp = vimage("FF0000");
49
50 ok($im->flood_fill(x => 4, y=> 8, color => "FF0000"),
51 "fill at bottom of vertical well");
52 is_image($im, $cmp, "check the result");
53}
54
6ddf3547
TC
55{
56 # 103786 - when filling up would cross a 4-connected border to the left
57 # incorrectly
58 my $im = Imager->new(xsize => 20, ysize => 20);
59 $im->box(filled => 1, box => [ 0, 10, 9, 19 ], color => "FFFFFF");
60 $im->box(filled => 1, box => [ 10, 0, 19, 9 ], color => "FFFFFF");
61 my $cmp = $im->copy;
62 $cmp->box(filled => 1, box => [ 10, 10, 19, 19 ], color => "0000FF");
63 ok($im->flood_fill(x => 19, y => 19, color => "0000FF"),
64 "flood_fill() to big checks");
65 is_image($im, $cmp, "check result correct");
66}
67
87bf0d7d
TC
68{
69 # keys for tests are:
70 # name - base name of the test, the fill position is added
71 # boxes - arrayref of boxes to draw
b785ce07
TC
72 # floods - arrayref of boxes representing the area to be flood filled,
73 # defaults to the whole image
87bf0d7d 74 # fillats - positions to start filling from
b785ce07
TC
75 # Note that floods are drawn before the boxes, so the boxes obscure the
76 # filled area
87bf0d7d
TC
77 my @tests =
78 (
79 {
80 name => "1-pixel border",
81 boxes => [ [ 1, 1, 18, 18 ] ],
82 fillats =>
83 [
84 [ 0, 0 ],
85 [ 19, 0 ],
86 [ 0, 19 ],
87 [ 19, 19 ],
88 [ 10, 0 ],
89 [ 10, 19 ],
90 [ 0, 10 ],
91 [ 19, 10 ],
92 ]
93 },
94 {
95 name => "vertical connect check",
96 boxes =>
97 [
98 [ 0, 0, 8, 11 ],
99 [ 10, 8, 19, 19 ],
100 ],
101 fillats =>
102 [
103 [ 19, 0 ],
104 [ 0, 19 ],
105 ],
106 },
107 {
108 name => "horizontal connect check",
109 boxes =>
110 [
111 [ 0, 0, 11, 8 ],
112 [ 10, 10, 19, 19 ],
113 ],
114 fillats =>
115 [
116 [ 19, 0 ],
117 [ 0, 19 ],
118 ],
119 },
b785ce07
TC
120 {
121 name => "fill from inner line to 1-pixel border",
122 boxes =>
123 [
124 [ 1, 1, 18, 9 ],
125 [ 1, 10, 9, 10 ],
126 [ 1, 11, 18, 19 ],
127 ],
128 fillats => [ [ 10, 10 ], [ 0, 0 ] ],
129 },
130
131 {
132 name => "4-connected",
133 boxes =>
134 [
135 [ 11, 0, 19, 6 ],
136 [ 0, 7, 10, 15 ],
137 [ 11, 16, 19, 19 ],
138 ],
139 floods =>
140 [
141 [ 11, 7, 19, 15 ],
142 ],
143 fillats =>
144 [
145 [ 19, 10 ],
146 [ 19, 7 ],
147 [ 19, 15 ],
148 [ 11, 10 ],
149 [ 11, 7 ],
150 [ 11, 15 ],
151 ]
152 },
87bf0d7d
TC
153 );
154
155 my $box_color = Imager::Color->new("FF0000");
156 my $fill_color = Imager::Color->new("00FF00");
157 for my $test (@tests) {
158 my $base_name = $test->{name};
159 my $boxes = $test->{boxes};
b785ce07 160 my $floods = $test->{floods} || [ [ 0, 0, 19, 19 ] ];
87bf0d7d
TC
161 my $fillats = $test->{fillats};
162 for my $pos (@$fillats) {
163 for my $flip ("none", "h", "v", "vh") {
164 my ($fillx, $filly) = @$pos;
165
166 my $im = Imager->new(xsize => 20, ysize => 20);
167 my $cmp = Imager->new(xsize => 20, ysize => 20);
b785ce07
TC
168 for my $flood (@$floods) {
169 $cmp->box(box => $flood, filled => 1, color => $fill_color);
170 }
87bf0d7d
TC
171 for my $image ($im, $cmp) {
172 for my $box (@$boxes) {
173 $image->box(filled => 1, color => $box_color, box => $box );
174 }
175 }
176 if ($flip ne "none") {
177 $_->flip(dir => $flip) for $im, $cmp;
178 $flip =~ /h/ and $fillx = 19 - $fillx;
179 $flip =~ /v/ and $filly = 19 - $filly;
180 }
181 ok($im->flood_fill(x => $fillx, y => $filly, color => $fill_color),
182 "$base_name - \@($fillx,$filly) - flip $flip - fill");
183 is_image($im, $cmp, "$base_name - \@($fillx,$filly) - flip $flip - compare");
184 }
185 }
186 }
187}
188
95b9922f
TC
189unless ($ENV{IMAGER_KEEP_FILES}) {
190 unlink "testout/t22fill1.ppm";
191 unlink "testout/t22fill2.ppm";
192}
193
194# make a vertical test image
195sub vimage {
196 my $c = shift;
197
198 my $im = Imager->new(xsize => 10, ysize => 10);
199 $im->line(x1 => 1, y1 => 1, x2 => 8, y2 => 1, color => $c);
200 $im->line(x1 => 4, y1 => 2, x2 => 4, y2 => 8, color => $c);
201
202 return $im;
203}