X-Git-Url: https://git.sesse.net/?p=remoteglot;a=blobdiff_plain;f=Board.pm;h=3e0fd33a52b4fa72a4264a4eff58962dc93cc197;hp=39c8134096b5897a0e7bd0ff47baad0441fe310f;hb=5a9dbd3f72666ce02396c30d1b74dae3ab32d40b;hpb=559f0db891b73eaf115d57d26e0fe2376a4a5ed2 diff --git a/Board.pm b/Board.pm index 39c8134..3e0fd33 100644 --- a/Board.pm +++ b/Board.pm @@ -148,6 +148,8 @@ sub move_to_uci_notation { return _pos_to_square($from_row, $from_col) . _pos_to_square($to_row, $to_col) . $promo; } +# 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) = @_; @@ -175,31 +177,38 @@ sub parse_pretty_move { } $move =~ /^([KQRBN])?([a-h])?([1-8])?x?([a-h][1-8])$/ or die "Invalid move $move"; - my $piece = $1 // 'P'; + my $piece = $1; my $from_col = defined($2) ? _col_letter_to_num($2) : undef; my $from_row = defined($3) ? _row_letter_to_num($3) : undef; + if (!defined($piece) && (!defined($from_col) || !defined($from_row))) { + $piece = 'P'; + } my ($to_row, $to_col) = _square_to_pos($4); # Find all possible from-squares that could have been meant. my @squares = (); my $side = 'K'; if ($toplay eq 'B') { - $piece = lc($piece); + $piece = lc($piece) if defined($piece); $side = 'k'; } for my $row (0..7) { next if (defined($from_row) && $from_row != $row); for my $col (0..7) { next if (defined($from_col) && $from_col != $col); - next if ($board->[$row][$col] ne $piece); - next if (!$board->can_reach($piece, $row, $col, $to_row, $to_col)); - - # See if doing this move would put us in check - # (yes, there are clients that expect us to do this). - next if ($board->make_move($row, $col, $to_row, $to_col, $promo)->in_check($side)); + next if (defined($piece) && $board->[$row][$col] ne $piece); push @squares, [ $row, $col ]; } } + if (scalar @squares > 1) { + # Filter out pieces which cannot reach this square. + @squares = grep { $board->can_reach($piece, $_->[0], $_->[1], $to_row, $to_col) } @squares; + } + if (scalar @squares > 1) { + # See if doing this move would put us in check + # (yes, there are clients that expect us to do this). + @squares = grep { !$board->make_move($_->[0], $_->[1], $to_row, $to_col, $promo)->in_check($side) } @squares; + } if (scalar @squares == 0) { die "Impossible move $move"; } @@ -221,6 +230,45 @@ sub fen { return join('/', @rows); } +# Returns a compact bit string describing the same data as fen(). +# This is encoded using a Huffman-like encoding, and should be +# typically about 1/3 the number of bytes. +sub bitpacked_fen { + my ($board) = @_; + my $bits = ""; + + for my $row (0..7) { + for my $col (0..7) { + my $piece = $board->[$row][$col]; + if ($piece eq '-') { + $bits .= "0"; + next; + } + + my $color = (lc($piece) eq $piece) ? 0 : 1; + $bits .= "1" . $color; + + if (lc($piece) eq 'p') { + $bits .= "0"; + } elsif (lc($piece) eq 'n') { + $bits .= "100"; + } elsif (lc($piece) eq 'b') { + $bits .= "101"; + } elsif (lc($piece) eq 'r') { + $bits .= "1110"; + } elsif (lc($piece) eq 'q') { + $bits .= "11110"; + } elsif (lc($piece) eq 'k') { + $bits .= "11111"; + } else { + die "Unknown piece $piece"; + } + } + } + + return pack('b*', $bits); +} + sub can_reach { my ($board, $piece, $from_row, $from_col, $to_row, $to_col) = @_; @@ -339,6 +387,20 @@ sub can_reach { return 0; } +# Like can_reach, but also checks the move doesn't put the side in check. +# We use this in prettyprint_move to reduce the disambiguation, because Chess.js +# needs moves to be in minimally disambiguated form. +sub can_legally_reach { + my ($board, $piece, $from_row, $from_col, $to_row, $to_col) = @_; + + return 0 if (!can_reach($board, $piece, $from_row, $from_col, $to_row, $to_col)); + + my $nb = $board->make_move($from_row, $from_col, $to_row, $to_col); + my $side = ($piece eq lc($piece)) ? 'k' : 'K'; + + return !in_check($nb, $side); +} + my %pieces_against_side = ( k => { K => 1, Q => 1, R => 1, N => 1, B => 1, P => 1 }, K => { k => 1, q => 1, r => 1, n => 1, b => 1, p => 1 }, @@ -452,22 +514,22 @@ sub _prettyprint_move_no_check_or_mate { # white short castling if ($move eq 'e1g1' && $piece eq 'K') { - return '0-0'; + return 'O-O'; } # white long castling if ($move eq 'e1c1' && $piece eq 'K') { - return '0-0-0'; + return 'O-O-O'; } # black short castling if ($move eq 'e8g8' && $piece eq 'k') { - return '0-0'; + return 'O-O'; } # black long castling if ($move eq 'e8c8' && $piece eq 'k') { - return '0-0-0'; + return 'O-O-O'; } my $pretty; @@ -479,12 +541,12 @@ sub _prettyprint_move_no_check_or_mate { $pretty = substr($move, 0, 1) . 'x' . _pos_to_square($to_row, $to_col); } else { $pretty = _pos_to_square($to_row, $to_col); + } - if (defined($promo) && $promo ne '') { - # promotion - $pretty .= "="; - $pretty .= uc($promo); - } + if (defined($promo) && $promo ne '') { + # promotion + $pretty .= "="; + $pretty .= uc($promo); } return $pretty; } @@ -496,7 +558,7 @@ sub _prettyprint_move_no_check_or_mate { for my $col (0..7) { for my $row (0..7) { next unless ($board->[$row][$col] eq $piece); - ++$num_total if ($board->can_reach($piece, $row, $col, $to_row, $to_col)); + ++$num_total if ($board->can_legally_reach($piece, $row, $col, $to_row, $to_col)); } } @@ -504,14 +566,14 @@ sub _prettyprint_move_no_check_or_mate { my $num_row = 0; for my $col (0..7) { next unless ($board->[$from_row][$col] eq $piece); - ++$num_row if ($board->can_reach($piece, $from_row, $col, $to_row, $to_col)); + ++$num_row if ($board->can_legally_reach($piece, $from_row, $col, $to_row, $to_col)); } # and same for columns my $num_col = 0; for my $row (0..7) { next unless ($board->[$row][$from_col] eq $piece); - ++$num_col if ($board->can_reach($piece, $row, $from_col, $to_row, $to_col)); + ++$num_col if ($board->can_legally_reach($piece, $row, $from_col, $to_row, $to_col)); } # see if we need to disambiguate