From 3ba7d7aa2f94b7be3cc1d4b6b19f11cb390ae77f Mon Sep 17 00:00:00 2001 From: "Steinar H. Gunderson" Date: Sat, 6 Jan 2018 18:31:37 +0100 Subject: [PATCH] Implement Chess960 castling rules on the backend. --- Board.pm | 166 ++++++++++++++++++++++++++++++++-------------------- Position.pm | 137 +++++++++++++++++++++++++++++++++++-------- 2 files changed, 214 insertions(+), 89 deletions(-) diff --git a/Board.pm b/Board.pm index cb2bc71..783aef0 100644 --- a/Board.pm +++ b/Board.pm @@ -42,56 +42,62 @@ sub make_move { die "Invalid move $move"; } - # white short castling - if ($move eq 'e1g1' && $piece eq 'K') { - # king - $nb->[7][4] = '-'; - $nb->[7][6] = $piece; + if ($piece eq 'K') { + my $dst_piece = $board->[$to_row][$to_col]; - # rook - $nb->[7][7] = '-'; - $nb->[7][5] = 'R'; + # White short castling (regular or Chess960 king-takes-rook) + if ($move eq 'e1g1' || $dst_piece eq 'R') { + # king + $nb->[7][$from_col] = '-'; + $nb->[7][6] = $piece; - return $nb; - } + # rook + $nb->[7][$to_col] = '-'; + $nb->[7][5] = 'R'; - # white long castling - if ($move eq 'e1c1' && $piece eq 'K') { - # king - $nb->[7][4] = '-'; - $nb->[7][2] = $piece; + return $nb; + } - # rook - $nb->[7][0] = '-'; - $nb->[7][3] = 'R'; + # White long castling (regular or Chess960 king-takes-rook) + if ($move eq 'e1c1' || $dst_piece eq 'R') { + # king + $nb->[7][$from_col] = '-'; + $nb->[7][2] = $piece; - return $nb; - } + # rook + $nb->[7][$to_col] = '-'; + $nb->[7][3] = 'R'; - # black short castling - if ($move eq 'e8g8' && $piece eq 'k') { - # king - $nb->[0][4] = '-'; - $nb->[0][6] = $piece; + return $nb; + } + } elsif ($piece eq 'k') { + my $dst_piece = $board->[$to_row][$to_col]; - # rook - $nb->[0][7] = '-'; - $nb->[0][5] = 'r'; + # Black short castling (regular or Chess960 king-takes-rook) + if ($move eq 'e8g8' || $dst_piece eq 'r') { + # king + $nb->[0][$from_col] = '-'; + $nb->[0][6] = $piece; - return $nb; - } + # rook + $nb->[0][$from_col] = '-'; + $nb->[0][5] = 'r'; + + return $nb; + } - # black long castling - if ($move eq 'e8c8' && $piece eq 'k') { - # king - $nb->[0][4] = '-'; - $nb->[0][2] = $piece; + # black long castling + if ($move eq 'e8c8' || $dst_piece eq 'r') { + # king + $nb->[0][$from_col] = '-'; + $nb->[0][2] = $piece; - # rook - $nb->[0][0] = '-'; - $nb->[0][3] = 'r'; + # rook + $nb->[0][$to_col] = '-'; + $nb->[0][3] = 'r'; - return $nb; + return $nb; + } } # check if the from-piece is a pawn @@ -136,9 +142,12 @@ sub _row_letter_to_num { return 7 - (ord(shift) - ord('1')); } +use Carp; + sub _square_to_pos { my ($square) = @_; - $square =~ /^([a-h])([1-8])$/ or die "Invalid square $square"; + #$square =~ /^([a-h])([1-8])$/ or die "Invalid square $square"; + $square =~ /^([a-h])([1-8])$/ or Carp::confess("Invalid square $square"); return (_row_letter_to_num($2), _col_letter_to_num($1)); } @@ -148,25 +157,53 @@ sub move_to_uci_notation { return _pos_to_square($from_row, $from_col) . _pos_to_square($to_row, $to_col) . $promo; } +sub _find_piece_col { + my ($row, $piece) = @_; + for my $col (0..7) { + return $col if ($row->[$col] eq $piece); + } + die "Could not find piece $piece"; +} + # Note: This is in general not a validation that the move is actually allowed # (e.g. you can castle even though you're in check). sub parse_pretty_move { - my ($board, $move, $toplay) = @_; + my ($board, $move, $toplay, $chess960, $white_castle_k, $white_castle_q, $black_castle_k, $black_castle_q) = @_; # Strip check or mate $move =~ s/[+#]$//; if ($move eq '0-0' or $move eq 'O-O') { if ($toplay eq 'W') { - return (_square_to_pos('e1'), _square_to_pos('g1')); + if ($chess960) { + # King takes rook. + return (7, _find_piece_col($board->[7], 'K'), _square_to_pos($white_castle_k . '1')); + } else { + return (_square_to_pos('e1'), _square_to_pos('g1')); + } } else { - return (_square_to_pos('e8'), _square_to_pos('g8')); + if ($chess960) { + # King takes rook. + return (0, _find_piece_col($board->[0], 'k'), _square_to_pos($black_castle_k . '8')); + } else { + return (_square_to_pos('e8'), _square_to_pos('g8')); + } } } elsif ($move eq '0-0-0' or $move eq 'O-O-O') { if ($toplay eq 'W') { - return (_square_to_pos('e1'), _square_to_pos('c1')); + if ($chess960) { + # King takes rook. + return (7, _find_piece_col($board->[7], 'K'), _square_to_pos($white_castle_q . '1')); + } else { + return (_square_to_pos('e1'), _square_to_pos('c1')); + } } else { - return (_square_to_pos('e8'), _square_to_pos('c8')); + if ($chess960) { + # King takes rook. + return (0, _find_piece_col($board->[0], 'k'), _square_to_pos($black_castle_q . '8')); + } else { + return (_square_to_pos('e8'), _square_to_pos('c8')); + } } } @@ -233,7 +270,8 @@ sub fen { sub can_reach { my ($board, $piece, $from_row, $from_col, $to_row, $to_col) = @_; - # can't eat your own piece + # Can't eat your own piece (Chess960 uses king-takes-rook for castling, + # but castling is irrelevant for reachability) my $dest_piece = $board->[$to_row][$to_col]; if ($dest_piece ne '-') { return 0 if (($piece eq lc($piece)) == ($dest_piece eq lc($dest_piece))); @@ -473,24 +511,26 @@ sub _prettyprint_move_no_check_or_mate { die "Invalid move $move"; } - # white short castling - if ($move eq 'e1g1' && $piece eq 'K') { - return 'O-O'; - } - - # white long castling - if ($move eq 'e1c1' && $piece eq 'K') { - return 'O-O-O'; - } + if ($piece eq 'K') { + # white short/long castling + return 'O-O' if ($move eq 'e1g1'); + return 'O-O-O' if ($move eq 'e1c1'); - # black short castling - if ($move eq 'e8g8' && $piece eq 'k') { - return 'O-O'; - } - - # black long castling - if ($move eq 'e8c8' && $piece eq 'k') { - return 'O-O-O'; + # white short/long chess960-style castling (king takes own rook) + my $dst_piece = $board->[$to_row][$to_col]; + if ($dst_piece eq 'R') { + return ($to_col > $from_col) ? 'O-O' : 'O-O-O'; + } + } elsif ($piece eq 'k') { + # black short/long castling + return 'O-O' if ($move eq 'e8g8'); + return 'O-O-O' if ($move eq 'e8c8'); + + # black short/long chess960-style castling (king takes own rook) + my $dst_piece = $board->[$to_row][$to_col]; + if ($dst_piece eq 'r') { + return ($to_col > $from_col) ? 'O-O' : 'O-O-O'; + } } my $pretty; diff --git a/Position.pm b/Position.pm index 17c8512..cd0cc97 100644 --- a/Position.pm +++ b/Position.pm @@ -19,10 +19,10 @@ sub new { $pos->{'board'} = Board->new(@x[1..8]); $pos->{'toplay'} = $x[9]; $pos->{'ep_file_num'} = $x[10]; - $pos->{'white_castle_k'} = $x[11]; - $pos->{'white_castle_q'} = $x[12]; - $pos->{'black_castle_k'} = $x[13]; - $pos->{'black_castle_q'} = $x[14]; + $pos->{'white_castle_k'} = $x[11] ? 'h' : undef; + $pos->{'white_castle_q'} = $x[12] ? 'a' : undef; + $pos->{'black_castle_k'} = $x[13] ? 'h' : undef; + $pos->{'black_castle_q'} = $x[14] ? 'a' : undef; $pos->{'time_since_100move_rule_reset'} = $x[15]; $pos->{'player_w'} = $x[17]; $pos->{'player_b'} = $x[18]; @@ -58,6 +58,7 @@ sub from_fen { my $pos = {}; $board =~ s/(\d)/"-"x$1/ge; $pos->{'board'} = Board->new(split /\//, $board); + $board = $pos->{'board'}; $pos->{'toplay'} = uc($toplay); if ($ep_square =~ /^([a-h])/) { @@ -66,10 +67,37 @@ sub from_fen { $pos->{'ep_file_num'} = -1; } - $pos->{'white_castle_k'} = ($castling =~ /K/) ? 1 : 0; - $pos->{'white_castle_q'} = ($castling =~ /Q/) ? 1 : 0; - $pos->{'black_castle_k'} = ($castling =~ /k/) ? 1 : 0; - $pos->{'black_castle_q'} = ($castling =~ /q/) ? 1 : 0; + # X-FEN castling rights parsing. + if ($castling =~ /K/) { + $pos->{'white_castle_k'} = _col_num_to_letter(_find_piece_col_from_right($board->[7], 'R')); + } + if ($castling =~ /Q/) { + $pos->{'white_castle_q'} = _col_num_to_letter(_find_piece_col($board->[7], 'R')); + } + while ($castling =~ s/([A-H])//g) { + my $rook_col = lc($1); + my $king_col = _find_piece_col($board->[7], 'K'); + if ($rook_col < $king_col) { + $pos->{'white_castle_q'} = _col_num_to_letter($rook_col); + } else { + $pos->{'white_castle_k'} = _col_num_to_letter($rook_col); + } + } + if ($castling =~ /k/) { + $pos->{'white_castle_k'} = _col_num_to_letter(_find_piece_col_from_right($board->[0], 'r')); + } + if ($castling =~ /q/) { + $pos->{'black_castle_q'} = _col_num_to_letter(_find_piece_col($board->[0], 'r')); + } + while ($castling =~ s/([a-h])//g) { + my $rook_col = $1; + my $king_col = _find_piece_col($board->[0], 'k'); + if ($rook_col < $king_col) { + $pos->{'black_castle_q'} = _col_num_to_letter($rook_col); + } else { + $pos->{'black_castle_k'} = _col_num_to_letter($rook_col); + } + } $pos->{'time_since_100move_rule_reset'} = $halfmove_clock // 0; $pos->{'player_w'} = 'white'; $pos->{'player_b'} = 'black'; @@ -95,12 +123,40 @@ sub fen { $fen .= " "; $fen .= lc($pos->{'toplay'}); - # castling + # Castling (X-FEN compatible). my $castling = ""; - $castling .= "K" if ($pos->{'white_castle_k'} == 1); - $castling .= "Q" if ($pos->{'white_castle_q'} == 1); - $castling .= "k" if ($pos->{'black_castle_k'} == 1); - $castling .= "q" if ($pos->{'black_castle_q'} == 1); + if (defined($pos->{'white_castle_k'})) { + my $outer_rook_col = _col_num_to_letter(_find_piece_col_from_right($pos->{'board'}[7], 'R')); + if ($outer_rook_col eq $pos->{'white_castle_k'}) { + $castling .= "K"; + } else { + $castling .= uc($pos->{'white_castle_k'}); + } + } + if (defined($pos->{'white_castle_q'})) { + my $outer_rook_col = _col_num_to_letter(_find_piece_col($pos->{'board'}[7], 'R')); + if ($outer_rook_col eq $pos->{'white_castle_q'}) { + $castling .= "Q"; + } else { + $castling .= uc($pos->{'white_castle_q'}); + } + } + if (defined($pos->{'black_castle_k'})) { + my $outer_rook_col = _col_num_to_letter(_find_piece_col_from_right($pos->{'board'}[0], 'r')); + if ($outer_rook_col eq $pos->{'black_castle_k'}) { + $castling .= "k"; + } else { + $castling .= $pos->{'black_castle_k'}; + } + } + if (defined($pos->{'black_castle_q'})) { + my $outer_rook_col = _col_num_to_letter(_find_piece_col($pos->{'board'}[0], 'r')); + if ($outer_rook_col eq $pos->{'black_castle_q'}) { + $castling .= "q"; + } else { + $castling .= $pos->{'black_castle_q'}; + } + } $castling = "-" if ($castling eq ""); # $castling = "-"; # chess960 $fen .= " "; @@ -155,7 +211,7 @@ sub to_json_hash { sub parse_pretty_move { my ($pos, $move) = @_; - return $pos->{'board'}->parse_pretty_move($move, $pos->{'toplay'}); + 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'}); } sub num_pieces { @@ -196,19 +252,27 @@ sub make_move { $np->{'black_castle_k'} = $pos->{'black_castle_k'}; $np->{'black_castle_q'} = $pos->{'black_castle_q'}; if ($piece eq 'K') { - $np->{'white_castle_k'} = 0; - $np->{'white_castle_q'} = 0; + $np->{'white_castle_k'} = undef; + $np->{'white_castle_q'} = undef; } elsif ($piece eq 'k') { - $np->{'black_castle_k'} = 0; - $np->{'black_castle_q'} = 0; - } elsif ($from_square eq 'a1' || $to_square eq 'a1') { - $np->{'white_castle_q'} = 0; - } elsif ($from_square eq 'h1' || $to_square eq 'h1') { - $np->{'white_castle_k'} = 0; - } elsif ($from_square eq 'a8' || $to_square eq 'a8') { - $np->{'black_castle_q'} = 0; - } elsif ($from_square eq 'h8' || $to_square eq 'h8') { - $np->{'black_castle_k'} = 0; + $np->{'black_castle_k'} = undef; + $np->{'black_castle_q'} = undef; + } elsif (defined($np->{'white_castle_q'}) && + ($from_square eq ($np->{'white_castle_q'} . '1') || + $to_square eq ($np->{'white_castle_q'} . '1'))) { + $np->{'white_castle_q'} = undef; + } elsif (defined($np->{'white_castle_k'}) && + ($from_square eq ($np->{'white_castle_k'} . '1') || + $to_square eq ($np->{'white_castle_k'} . '1'))) { + $np->{'white_castle_k'} = undef; + } elsif (defined($np->{'black_castle_q'}) && + ($from_square eq ($np->{'black_castle_q'} . '8') || + $to_square eq ($np->{'black_castle_q'} . '8'))) { + $np->{'black_castle_q'} = undef; + } elsif (defined($np->{'black_castle_k'}) && + ($from_square eq ($np->{'black_castle_k'} . '8') || + $to_square eq ($np->{'black_castle_k'} . '8'))) { + $np->{'black_castle_k'} = undef; } # 50-move rule. @@ -261,6 +325,11 @@ sub apply_uci_pv { return $pvpos; } +sub _col_num_to_letter { + my $col = shift; + return sprintf("%c", ord('a') + $col); +} + sub _col_letter_to_num { return ord(shift) - ord('a'); } @@ -269,6 +338,22 @@ sub _row_letter_to_num { return 7 - (ord(shift) - ord('1')); } +sub _find_piece_col { + my ($row, $piece) = @_; + for my $col (0..7) { + return $col if ($row->[$col] eq $piece); + } + die "Could not find piece $piece"; +} + +sub _find_piece_col_from_right { + my ($row, $piece) = @_; + for my $col (reverse 0..7) { + return $col if ($row->[$col] eq $piece); + } + die "Could not find piece $piece"; +} + sub _parse_uci_move { my $move = shift; my $from_col = _col_letter_to_num(substr($move, 0, 1)); -- 2.39.2