]>
Commit | Line | Data |
---|---|---|
95b9922f TC |
1 | #!perl -w |
2 | use strict; | |
b785ce07 | 3 | use Test::More tests => 177; |
95b9922f TC |
4 | use Imager; |
5 | use 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 | ||
24 | SKIP: | |
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 |
189 | unless ($ENV{IMAGER_KEEP_FILES}) { |
190 | unlink "testout/t22fill1.ppm"; | |
191 | unlink "testout/t22fill2.ppm"; | |
192 | } | |
193 | ||
194 | # make a vertical test image | |
195 | sub 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 | } |