X-Git-Url: https://git.sesse.net/?p=remoteglot;a=blobdiff_plain;f=Board.pm;h=921de3d9c45f715e7084796aeb1a005bc5270093;hp=2edc07de0c61a37b93ebee9e5aadd73fe29985e2;hb=b9fb6e88fc023303181e384719c8e2d3f19133a2;hpb=2e02751eebe4f5ed406e0f61c6f6eadae0193a41 diff --git a/Board.pm b/Board.pm index 2edc07d..921de3d 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) = @_; @@ -192,16 +194,23 @@ sub parse_pretty_move { 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)); 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"; + } if (scalar @squares != 1) { - die "Ambigious or impossible move $move"; + die "Ambigious move $move"; } return (@{$squares[0]}, $to_row, $to_col, $promo); } @@ -218,6 +227,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) = @_;