3 package Games
::Go
::Image2SGF
;
10 Games::Go::Image2SGF -- interpret photographs of go positions.
14 my $board = Games::Go::Image2SGF->new(
19 image => 'go_photograph.jpg'
27 B<Games::Go::Image2SGF> is a I<perl5> module to create a computer-readable
28 I<SGF> format description of the position on a Go board, given a photograph
33 Options are passed to B<Games::Go::ImageSGF> via its constructor. It will
34 attempt to use sane defaults for options you don't supply; arguments must
35 be supplied for the required options.
41 Required. The coordinates of the four corners of the go board's grid. You
42 can obtain these by loading your photograph in an image editor that displays
43 image coordinates and hovering the cursor over each of the grid corners.
47 Required. The filename of the image to interpret. This can be in any format
48 supported by I<Imager>.
50 =item white, black, board
52 Optional. A fairly-representative colour for the white stones, black stones,
53 and go board itself, presented in decimal RGB triplets -- eg. C<[255,255,255]>
54 for white. You should only set these if the generated SGF is incorrect.
55 Default: Black is C<[0,0,0]>, white is C<[255,255,255]>, board colour is
60 Optional. After inferring the grid from the corner points you give, the
61 module will search in a radius of C<sample_radius> pixels to look for stones
62 of a particular colour. As with the C<white, black, board> options: the
63 default is likely to do the right thing, and you should only increase or
64 decrease it if your image is very large or very small. Default: 10 pixels.
70 You may want to use the methods defined in the module in another order, or
71 in conjunction with other methods of your own -- for example, to track
72 video of a live game instead of still images. Note that methods with a
73 leading C<_> are considered internal, and their semantics may change.
81 Further examples at L<http://www.inference.phy.cam.ac.uk/cjb/image2sgf.html>,
82 the L<http://www.red-bean.com/sgf/> SGF standard, and the collaborative guide
83 to Go at L<http://senseis.xmp.net/>.
87 Chris Ball E<lt>chris@cpan.orgE<gt>
91 use constant BOARDSIZE
=> 19;
92 use constant BOARD
=> 0;
93 use constant WHITE
=> 1;
94 use constant BLACK
=> 2;
97 use constant EPSILON
=> 0.0001;
104 # Set up some initial defaults. These are overridden by the user
105 # in their constructor. White/black/board/sample_radius are optional.
107 white
=> [255,255,255],
109 board
=> [100,100,100],
115 while (my($key, $val) = each %options) {
116 $self->{$key} = $val;
119 # Some of our arguments are required, and we should have them at this point.
120 foreach (qw
/tl tr bl br image/) {
121 unless (defined ($self->{$_})) {
122 die "$_ is a required option; see the POD documentation.\n";
126 # The mycolors array will be used by Imager to perform the quantization.
127 $self->{mycolors
} = [ Imager
::Color
->new(@
{ $self->{white
} }),
128 Imager
::Color
->new(@
{ $self->{board
} }),
129 Imager
::Color
->new(@
{ $self->{black
} }) ];
137 my $img = Imager
->new();
138 $img->open(file
=> $self->{image
}) or die $img->errstr();
145 # Quantize the image. We tell Imager to choose the colour in mycolors
146 # that each pixel in the image is nearest to, and set the pixel in the
147 # created image to that colour.
148 $self->{img
} = $self->{img
}->to_paletted(
149 make_colors
=> "none",
150 colors
=> $self->{mycolors
},
152 ) or die $self->{img
}->errstr();
155 sub find_intersections
{
158 $self->invert_coords;
160 # Find the equations for the lines connecting the four sides.
161 # Lines are defined by their slope (m) and yintercept (b) with
162 # the line equation: y = mx + b.
163 my $m_left = ($self->{tl
}[Y
] - $self->{bl
}[Y
]) /
164 ($self->{tl
}[X
] - $self->{bl
}[X
]);
165 my $b_left = $self->{bl
}[Y
] - ($m_left * $self->{bl
}[X
]);
167 my $m_right = ($self->{tr
}[Y
] - $self->{br
}[Y
]) /
168 ($self->{tr
}[X
] - $self->{br
}[X
]);
169 my $b_right = $self->{br
}[Y
] - ($m_right * $self->{br
}[X
]);
171 my $m_top = ($self->{tr
}[Y
] - $self->{tl
}[Y
]) /
172 ($self->{tr
}[X
] - $self->{tl
}[X
]);
173 my $b_top = $self->{tl
}[Y
] - ($m_top * $self->{tl
}[X
]);
175 my $m_bottom = ($self->{br
}[Y
] - $self->{bl
}[Y
]) /
176 ($self->{br
}[X
] - $self->{bl
}[X
]);
177 my $b_bottom = $self->{bl
}[Y
] - ($m_bottom * $self->{bl
}[X
]);
179 # Find the "vanishing points" for the grid the board forms. These will be a
180 # "vertical vanishing point" (vvp) for the intersection of left and right
181 # lines, and a "horizontal vanishing point" (hvp) for top and bottom
182 # intersection. There is the possibility that two lines are perfectly
183 # parallel -- we check this first and create a very small difference if
184 # we're going to be generating a SIGFPE.
185 if ($m_top == $m_bottom) {
188 if ($m_left == $m_right) {
192 my $x_vvp = ($b_right - $b_left) / ($m_left - $m_right);
193 my $y_vvp = ($m_left * $x_vvp) + $b_left;
194 my $x_hvp = ($b_top - $b_bottom) / ($m_bottom - $m_top);
195 my $y_hvp = ($m_bottom * $x_hvp) + $b_bottom;
197 # The "horizon" for any two point perspective grid will be the line
198 # connecting these two vanishing points.
199 my $m_horizon = ($y_vvp - $y_hvp) / ($x_vvp - $x_hvp);
200 my $b_horizon = $y_vvp - ($m_horizon * $x_vvp);
202 # Now find the equation of a line parallel to the horizon that goes through
203 # the bottom right point, called "fg" (short for foreground). (It's
204 # arbitrary which point this parallel line goes through, really, as long as
205 # it's different from the horizon line itself.)
206 my $m_fg = $m_horizon;
207 my $b_fg = $self->{br
}[Y
] - ($m_fg * $self->{br
}[X
]);
209 # Find intersections of the left and right lines on this foreground (fg)
210 my $left_fg_x = ($b_left - $b_fg) / ($m_fg - $m_left);
211 my $right_fg_x = ($b_right - $b_fg) / ($m_fg - $m_right);
213 # Find distance between these intersections along the x axis.
214 my $left_right_fg_x_dist = abs($right_fg_x - $left_fg_x);
216 # Divide this distance into BOARDSIZE-1 fragments to find the spacing of
217 # BOARDSIZE points along it.
218 my $fg_lr_spacing = $left_right_fg_x_dist / (BOARDSIZE
- 1);
220 # Find intersections of the top and bottom lines on the foreground
221 my $top_fg_x = ($b_top - $b_fg) / ($m_fg - $m_top);
222 my $bottom_fg_x = ($b_bottom - $b_fg) / ($m_fg - $m_bottom);
224 # Find distance between these intersections along the x axis.
225 my $top_bottom_fg_x_dist = abs($top_fg_x - $bottom_fg_x);
227 # Divide this distance into BOARDSIZE-1 fragments to find spacing.
228 my $fg_tb_spacing = $top_bottom_fg_x_dist / (BOARDSIZE
- 1);
230 # Go through the foreground left-right x points, establish the vertical
231 # lines as detemined by the slope between them and the vvp. Start
232 # with left point and move towards the right.
233 if ($left_fg_x < $right_fg_x) {
234 for my $i (1 .. BOARDSIZE
) {
235 my $x_i = $left_fg_x + ($fg_lr_spacing * ($i - 1));
236 my $y_i = $m_fg * $x_i + $b_fg;
237 $self->{vert_m_hash
}[$i] = ($y_vvp - $y_i) / ($x_vvp - $x_i);
238 $self->{vert_b_hash
}[$i] = $y_i - ($self->{vert_m_hash
}[$i] * $x_i);
241 for my $i (1 .. BOARDSIZE
) {
242 my $x_i = $left_fg_x - ($fg_lr_spacing * ($i - 1));
243 my $y_i = $m_fg * $x_i + $b_fg;
244 $self->{vert_m_hash
}[$i] = ($y_vvp - $y_i) / ($x_vvp - $x_i);
245 $self->{vert_b_hash
}[$i] = $y_i - ($self->{vert_m_hash
}[$i] * $x_i);
249 # Similarly, go through the foreground top-bottom x points, establish the
250 # horizontal lines as determined by the slope between them and the hvp.
251 # Want to number things from top to bottom, so will start things from
252 # top foreground x and move towards bottom.
253 if ($top_fg_x < $bottom_fg_x) {
254 for my $i (1 .. BOARDSIZE
) {
255 my $x_i = $top_fg_x + ($fg_tb_spacing * ($i - 1));
256 my $y_i = $m_fg * $x_i + $b_fg;
257 $self->{horiz_m_hash
}[$i] = ($y_hvp - $y_i) / ($x_hvp - $x_i);
258 $self->{horiz_b_hash
}[$i] = $y_i - ($self->{horiz_m_hash
}[$i] * $x_i);
261 for my $i (1 .. BOARDSIZE
) {
262 my $x_i = $top_fg_x - ($fg_tb_spacing * ($i - 1));
263 my $y_i = $m_fg * $x_i + $b_fg;
264 $self->{horiz_m_hash
}[$i] = ($y_hvp - $y_i) / ($x_hvp - $x_i);
265 $self->{horiz_b_hash
}[$i] = $y_i - ($self->{horiz_m_hash
}[$i] * $x_i);
269 for my $i (1 .. BOARDSIZE
) {
270 for my $j (1 .. BOARDSIZE
) {
271 my $x_vertex = ($self->{horiz_b_hash
}[$i] - $self->{vert_b_hash
}[$j]) / ($self->{vert_m_hash
}[$j] - $self->{horiz_m_hash
}[$i]);
272 my $y_vertex = ($self->{horiz_m_hash
}[$i] * $x_vertex) + $self->{horiz_b_hash
}[$i];
274 # intersection [3,5] is third from top, fifth from left
275 $self->{intersection
}[$i][$j] = [ $x_vertex, -1 * $y_vertex ];
282 my ($self, $i, $j, $radius) = @_;
283 my $stone = "undecided";
287 my $x_vertex = $self->{intersection
}[$i][$j][X
];
288 my $y_vertex = $self->{intersection
}[$i][$j][Y
];
289 my $black = $self->{mycolors
}->[0];
290 my $board = $self->{mycolors
}->[1];
291 my $white = $self->{mycolors
}->[2];
293 for (my $k = ($x_vertex - $radius); $k <= ($x_vertex + $radius); $k++) {
294 for (my $l = ($y_vertex - $radius); $l <= ($y_vertex + $radius); $l++) {
295 if (($x_vertex - $k)**2 + ($y_vertex - $l)**2 <= ($radius**2)) {
296 # If this is true, then the point ($k, $l) is in our circle.
297 # Now we sample at it.
298 my $gp = $self->{img
}->getpixel('x' => $k, 'y' => $l);
299 next if $gp == undef;
300 if (_color_cmp
($gp, $black) == 1) { $blackcount++; }
301 if (_color_cmp
($gp, $board) == 1) { $boardcount++; }
302 if (_color_cmp
($gp, $white) == 1) { $whitecount++; }
307 # Finished sampling. Use a simple majority to work out which colour
308 # wins. TODO -- there are better ways of doing this. For example,
309 # if we determine one stone to be white or black, we could afterwards
310 # set its radius _in our quantized image_ back to the board colour;
311 # this "explaining away" would alleviate cases where the grid is
312 # slightly off and we're catching pixels of an already-recorded
313 # stone on the edges.
314 if (($whitecount > $blackcount) and ($whitecount > $boardcount)) {
316 } elsif ($blackcount > $boardcount) {
322 my @letters = qw
/z a b c d e f g h i j k l m n o p q r s/;
323 if ($stone == WHITE
or $stone == BLACK
) {
324 $self->update_sgf($stone, $letters[$i], $letters[$j], $stone);
333 # Because the origin (0,0) in the inputed coordinates is in the
334 # upper left instead of the intuitive-for-geometry bottom left,
335 # we want to call this the "fourth quadrant". That means all the
336 # y values are treated as negative numbers, so we convert:
337 for (qw(tl tr bl br)) { $self->{$_}[Y
] = -$self->{$_}[Y
]; }
342 my $time = scalar localtime;
343 $self->{sgf
} .= <<ENDSTARTSGF;
345 GN[Image2SGF conversion of $time.]
347 AP[Image2SGF by Chris Ball.]
354 my ($stone, $x, $y) = @_;
355 if ($stone == BLACK
) {
356 push @
{$self->{blackstones
}}, "$y$x";
358 elsif ($stone == WHITE
) {
359 push @
{$self->{whitestones
}}, "$y$x";
366 $self->{sgf
} .= "\nAB";
367 $self->{sgf
} .= "[$_]" foreach (@
{$self->{blackstones
}});
369 $self->{sgf
} .= "\nAW";
370 $self->{sgf
} .= "[$_]" foreach (@
{$self->{whitestones
}});
372 $self->{sgf
} .= ")\n\n";
379 return ($l[0] == $r[0] and $l[1] == $r[1] and $l[2] == $r[2]);
383 # Example: "cd" => "C16".
385 return chr(64 + $y + ($y > 9 && 1)) . (20 - $x);
389 # Example: "C16" => "cd".
392 return ($2, ord($1) - 65);
398 # The only user-visible method right now. Runs the conversion functions.
399 # (Which are separate methods so that we can keep track of a live game
400 # efficiently -- if the camera is stationary above the board, we only
401 # have to find the grid location once, and can just repeatedly call
402 # read_image/quantize/sample, reusing the coordinates.)
403 $self->find_intersections;
408 for my $i (1 .. BOARDSIZE
) {
409 for my $j (1 .. BOARDSIZE
) {
410 my $stone = $self->sample($i, $j, $self->{sample_radius
});