3 # There are too many chess modules on CPAN already, so here's another one...
13 # Takes in a FICS style 12-type position.
15 my ($class, $str) = @_;
17 my (@x) = split / /, $str;
19 $pos->{'board'} = Board->new(@x[1..8]);
20 $pos->{'toplay'} = $x[9];
21 $pos->{'ep_file_num'} = $x[10];
22 $pos->{'white_castle_k'} = $x[11] ? 'h' : undef;
23 $pos->{'white_castle_q'} = $x[12] ? 'a' : undef;
24 $pos->{'black_castle_k'} = $x[13] ? 'h' : undef;
25 $pos->{'black_castle_q'} = $x[14] ? 'a' : undef;
26 $pos->{'time_since_100move_rule_reset'} = $x[15];
27 $pos->{'player_w'} = $x[17];
28 $pos->{'player_b'} = $x[18];
29 $pos->{'player_w'} =~ s/^W?[FCIG]M//;
30 $pos->{'player_b'} =~ s/^W?[FCIG]M//;
31 $pos->{'white_clock'} = $x[24];
32 $pos->{'black_clock'} = $x[25];
33 $pos->{'move_num'} = $x[26];
34 if ($x[27] =~ /([a-h][1-8])-([a-h][1-8])/) {
35 $pos->{'last_move_uci'} = $1 . $2;
37 $pos->{'last_move_uci'} = undef;
39 $pos->{'last_move'} = $x[29];
40 $pos->{'prettyprint_cache'} = {};
41 $pos->{'tbprobe_cache'} = {};
48 my ($class, $white, $black) = @_;
49 $white = "base64:" . MIME::Base64::encode_base64($white);
50 $black = "base64:" . MIME::Base64::encode_base64($black);
51 return $class->new("<12> rnbqkbnr pppppppp -------- -------- -------- -------- PPPPPPPP RNBQKBNR W -1 1 1 1 1 0 dummygamenum $white $black -2 dummytime dummyincrement 39 39 dummytime dummytime 1 none (0:00) none 0 0 0");
55 my ($class, $fen) = @_;
56 my ($board, $toplay, $castling, $ep_square, $halfmove_clock, $fullmove_clock) = split / /, $fen;
59 $board =~ s/(\d)/"-"x$1/ge;
60 $pos->{'board'} = Board->new(split /\//, $board);
61 $board = $pos->{'board'};
62 $pos->{'toplay'} = uc($toplay);
64 if ($ep_square =~ /^([a-h])/) {
65 $pos->{'ep_file_num'} = ord($1) - ord('a');
67 $pos->{'ep_file_num'} = -1;
70 # X-FEN castling rights parsing.
71 if ($castling =~ /K/) {
72 $pos->{'white_castle_k'} = _col_num_to_letter(_find_piece_col_from_right($board->[7], 'R'));
74 if ($castling =~ /Q/) {
75 $pos->{'white_castle_q'} = _col_num_to_letter(_find_piece_col($board->[7], 'R'));
77 while ($castling =~ s/([A-H])//) {
78 my $rook_col = lc($1);
79 my $king_col = _col_num_to_letter(_find_piece_col($board->[7], 'K'));
80 if ($rook_col lt $king_col) {
81 $pos->{'white_castle_q'} = $rook_col;
83 $pos->{'white_castle_k'} = $rook_col;
86 if ($castling =~ /k/) {
87 $pos->{'black_castle_k'} = _col_num_to_letter(_find_piece_col_from_right($board->[0], 'r'));
89 if ($castling =~ /q/) {
90 $pos->{'black_castle_q'} = _col_num_to_letter(_find_piece_col($board->[0], 'r'));
92 while ($castling =~ s/([a-h])//) {
94 my $king_col = _col_num_to_letter(_find_piece_col($board->[0], 'k'));
95 if ($rook_col lt $king_col) {
96 $pos->{'black_castle_q'} = $rook_col;
98 $pos->{'black_castle_k'} = $rook_col;
101 $pos->{'time_since_100move_rule_reset'} = $halfmove_clock // 0;
102 $pos->{'player_w'} = 'white';
103 $pos->{'player_b'} = 'black';
104 $pos->{'white_clock'} = 0;
105 $pos->{'black_clock'} = 0;
106 $pos->{'move_num'} = $fullmove_clock // 0;
107 $pos->{'last_move_uci'} = undef;
108 $pos->{'last_move'} = undef;
109 $pos->{'prettyprint_cache'} = {};
110 $pos->{'tbprobe_cache'} = {};
120 my $fen = $pos->{'board'}->fen();
122 # white/black to move
124 $fen .= lc($pos->{'toplay'});
126 # Castling (X-FEN compatible).
128 if (defined($pos->{'white_castle_k'})) {
129 my $outer_rook_col = _col_num_to_letter(_find_piece_col_from_right($pos->{'board'}[7], 'R'));
130 if ($outer_rook_col eq $pos->{'white_castle_k'}) {
133 $castling .= uc($pos->{'white_castle_k'});
136 if (defined($pos->{'white_castle_q'})) {
137 my $outer_rook_col = _col_num_to_letter(_find_piece_col($pos->{'board'}[7], 'R'));
138 if ($outer_rook_col eq $pos->{'white_castle_q'}) {
141 $castling .= uc($pos->{'white_castle_q'});
144 if (defined($pos->{'black_castle_k'})) {
145 my $outer_rook_col = _col_num_to_letter(_find_piece_col_from_right($pos->{'board'}[0], 'r'));
146 if ($outer_rook_col eq $pos->{'black_castle_k'}) {
149 $castling .= $pos->{'black_castle_k'};
152 if (defined($pos->{'black_castle_q'})) {
153 my $outer_rook_col = _col_num_to_letter(_find_piece_col($pos->{'board'}[0], 'r'));
154 if ($outer_rook_col eq $pos->{'black_castle_q'}) {
157 $castling .= $pos->{'black_castle_q'};
160 $castling = "-" if ($castling eq "");
161 # $castling = "-"; # chess960
167 if ($pos->{'ep_file_num'} != -1) {
168 my $col = $pos->{'ep_file_num'};
169 $ep = (qw(a b c d e f g h))[$col];
171 if ($pos->{'toplay'} eq 'B') {
182 $fen .= $pos->{'time_since_100move_rule_reset'};
186 $fen .= $pos->{'move_num'};
193 my $json = { %$pos, fen => $pos->fen() };
194 delete $json->{'toplay'};
195 delete $json->{'move_num'};
196 delete $json->{'board'};
197 delete $json->{'prettyprint_cache'};
198 delete $json->{'tbprobe_cache'};
199 delete $json->{'black_castle_k'};
200 delete $json->{'black_castle_q'};
201 delete $json->{'white_castle_k'};
202 delete $json->{'white_castle_q'};
203 delete $json->{'time_since_100move_rule_reset'};
204 delete $json->{'chess960'} if (!$json->{'chess960'});
205 if ($json->{'player_w'} =~ /^base64:(.*)$/) {
206 $json->{'player_w'} = MIME::Base64::decode_base64($1);
208 if ($json->{'player_b'} =~ /^base64:(.*)$/) {
209 $json->{'player_b'} = MIME::Base64::decode_base64($1);
214 sub parse_pretty_move {
215 my ($pos, $move) = @_;
216 return $pos->{'board'}->parse_pretty_move($move, $pos->{'toplay'}, $pos->{'chess960'}, $pos->{'white_castle_k'}, $pos->{'white_castle_q'}, $pos->{'black_castle_k'}, $pos->{'black_castle_q'});
221 return $pos->{'board'}->num_pieces();
224 # Returns a new Position object.
226 my ($pos, $from_row, $from_col, $to_row, $to_col, $promo, $pretty_move) = @_;
228 my $from_square = _pos_to_square($from_row, $from_col);
229 my $to_square = _pos_to_square($to_row, $to_col);
232 $np->{'board'} = $pos->{'board'}->make_move($from_row, $from_col, $to_row, $to_col, $promo);
233 if ($pos->{'toplay'} eq 'W') {
234 $np->{'toplay'} = 'B';
235 $np->{'move_num'} = $pos->{'move_num'};
237 $np->{'toplay'} = 'W';
238 $np->{'move_num'} = $pos->{'move_num'} + 1;
241 my $piece = $pos->{'board'}[$from_row][$from_col];
242 my $dest_piece = $pos->{'board'}[$to_row][$to_col];
244 # Find out if this was a two-step pawn move.
245 if (lc($piece) eq 'p' && abs($from_row - $to_row) == 2) {
246 $np->{'ep_file_num'} = $from_col;
248 $np->{'ep_file_num'} = -1;
252 $np->{'white_castle_k'} = $pos->{'white_castle_k'};
253 $np->{'white_castle_q'} = $pos->{'white_castle_q'};
254 $np->{'black_castle_k'} = $pos->{'black_castle_k'};
255 $np->{'black_castle_q'} = $pos->{'black_castle_q'};
257 $np->{'white_castle_k'} = undef;
258 $np->{'white_castle_q'} = undef;
259 } elsif ($piece eq 'k') {
260 $np->{'black_castle_k'} = undef;
261 $np->{'black_castle_q'} = undef;
262 } elsif (defined($np->{'white_castle_q'}) &&
263 ($from_square eq ($np->{'white_castle_q'} . '1') ||
264 $to_square eq ($np->{'white_castle_q'} . '1'))) {
265 $np->{'white_castle_q'} = undef;
266 } elsif (defined($np->{'white_castle_k'}) &&
267 ($from_square eq ($np->{'white_castle_k'} . '1') ||
268 $to_square eq ($np->{'white_castle_k'} . '1'))) {
269 $np->{'white_castle_k'} = undef;
270 } elsif (defined($np->{'black_castle_q'}) &&
271 ($from_square eq ($np->{'black_castle_q'} . '8') ||
272 $to_square eq ($np->{'black_castle_q'} . '8'))) {
273 $np->{'black_castle_q'} = undef;
274 } elsif (defined($np->{'black_castle_k'}) &&
275 ($from_square eq ($np->{'black_castle_k'} . '8') ||
276 $to_square eq ($np->{'black_castle_k'} . '8'))) {
277 $np->{'black_castle_k'} = undef;
280 # 50-move rule. Note that castle does not reset the counter, per FIDE rules.
281 my $castling = (lc($piece) eq 'k' && abs($from_col - $to_col) > 1) || # King moves two squares.
282 ($piece eq 'K' && $dest_piece eq 'R') || # Chess960-style king-takes-rook.
283 ($piece eq 'k' && $dest_piece eq 'r');
284 if (!$castling && (lc($piece) eq 'p' || $dest_piece ne '-')) {
285 $np->{'time_since_100move_rule_reset'} = 0;
287 $np->{'time_since_100move_rule_reset'} = $pos->{'time_since_100move_rule_reset'} + 1;
289 $np->{'player_w'} = $pos->{'player_w'};
290 $np->{'player_b'} = $pos->{'player_b'};
291 $np->{'chess960'} = $pos->{'chess960'};
292 if (exists($pos->{'start_fen'})) {
293 $np->{'start_fen'} = $pos->{'start_fen'};
295 if (defined($pretty_move)) {
296 $np->{'last_move'} = $pretty_move;
298 my ($move, $nb) = $pos->{'board'}->prettyprint_move($from_row, $from_col, $to_row, $to_col, $promo);
299 $np->{'last_move'} = $move;
301 $np->{'last_move_uci'} = Board::move_to_uci_notation($from_row, $from_col, $to_row, $to_col, $promo);
306 # Returns a new Position object, and the parsed UCI move.
307 sub make_pretty_move {
308 my ($pos, $move) = @_;
310 my ($from_row, $from_col, $to_row, $to_col, $promo) = $pos->parse_pretty_move($move);
311 my $uci_move = Board::move_to_uci_notation($from_row, $from_col, $to_row, $to_col, $promo);
312 $pos = $pos->make_move($from_row, $from_col, $to_row, $to_col, $promo);
313 return ($pos, $uci_move);
317 my ($row, $col) = @_;
318 return sprintf("%c%d", ord('a') + $col, 8 - $row);
325 for my $pv_move (@pv) {
326 my ($from_row, $from_col, $to_row, $to_col, $promo) = _parse_uci_move($pv_move);
327 $pvpos = $pvpos->make_move($from_row, $from_col, $to_row, $to_col, $promo);
333 sub _col_num_to_letter {
335 return sprintf("%c", ord('a') + $col);
338 sub _col_letter_to_num {
339 return ord(shift) - ord('a');
342 sub _row_letter_to_num {
343 return 7 - (ord(shift) - ord('1'));
346 sub _find_piece_col {
347 my ($row, $piece) = @_;
349 return $col if ($row->[$col] eq $piece);
351 die "Could not find piece $piece";
354 sub _find_piece_col_from_right {
355 my ($row, $piece) = @_;
356 for my $col (reverse 0..7) {
357 return $col if ($row->[$col] eq $piece);
359 die "Could not find piece $piece";
362 sub _parse_uci_move {
364 my $from_col = _col_letter_to_num(substr($move, 0, 1));
365 my $from_row = _row_letter_to_num(substr($move, 1, 1));
366 my $to_col = _col_letter_to_num(substr($move, 2, 1));
367 my $to_row = _row_letter_to_num(substr($move, 3, 1));
368 my $promo = substr($move, 4, 1);
369 return ($from_row, $from_col, $to_row, $to_col, $promo);