- rename("analysis.json.tmp", "analysis.json");
-}
-
-sub find_kings {
- my $board = shift;
- my ($wkr, $wkc, $bkr, $bkc);
-
- for my $row (0..7) {
- for my $col (0..7) {
- my $piece = substr($board->[$row], $col, 1);
- if ($piece eq 'K') {
- ($wkr, $wkc) = ($row, $col);
- } elsif ($piece eq 'k') {
- ($bkr, $bkc) = ($row, $col);
- }
- }
- }
-
- return ($wkr, $wkc, $bkr, $bkc);
-}
-
-sub in_mate {
- my $board = shift;
- my $check = in_check($board);
- return 0 if ($check eq 'none');
-
- # try all possible moves for the side in check
- for my $row (0..7) {
- for my $col (0..7) {
- my $piece = substr($board->[$row], $col, 1);
- next if ($piece eq '-');
-
- if ($check eq 'white') {
- next if ($piece eq lc($piece));
- } else {
- next if ($piece eq uc($piece));
- }
-
- for my $dest_row (0..7) {
- for my $dest_col (0..7) {
- next if ($row == $dest_row && $col == $dest_col);
- next unless (can_reach($board, $piece, $row, $col, $dest_row, $dest_col));
-
- my @nb = @$board;
- substr($nb[$row], $col, 1, '-');
- substr($nb[$dest_row], $dest_col, 1, $piece);
-
- my $new_check = in_check(\@nb);
- return 0 if ($new_check ne $check && $new_check ne 'both');
- }
- }
- }
- }
-
- # nothing to do; mate
- return 1;
-}
-
-sub in_check {
- my $board = shift;
- my ($black_check, $white_check) = (0, 0);
-
- my ($wkr, $wkc, $bkr, $bkc) = find_kings($board);
-
- # check all pieces for the possibility of threatening the two kings
- for my $row (0..7) {
- for my $col (0..7) {
- my $piece = substr($board->[$row], $col, 1);
- next if ($piece eq '-');
-
- if (uc($piece) eq $piece) {
- # white piece
- $black_check = 1 if (can_reach($board, $piece, $row, $col, $bkr, $bkc));
- } else {
- # black piece
- $white_check = 1 if (can_reach($board, $piece, $row, $col, $wkr, $wkc));
- }
- }
- }
-
- if ($black_check && $white_check) {
- return 'both';
- } elsif ($black_check) {
- return 'black';
- } elsif ($white_check) {
- return 'white';
- } else {
- return 'none';
- }
-}
-
-sub can_reach {
- my ($board, $piece, $from_row, $from_col, $to_row, $to_col) = @_;
-
- # can't eat your own piece
- my $dest_piece = substr($board->[$to_row], $to_col, 1);
- if ($dest_piece ne '-') {
- return 0 if (($piece eq lc($piece)) == ($dest_piece eq lc($dest_piece)));
- }
-
- if (lc($piece) eq 'k') {
- return (abs($from_row - $to_row) <= 1 && abs($from_col - $to_col) <= 1);
- }
- if (lc($piece) eq 'r') {
- return 0 unless ($from_row == $to_row || $from_col == $to_col);
-
- # check that there's a clear passage
- if ($from_row == $to_row) {
- if ($from_col > $to_col) {
- ($to_col, $from_col) = ($from_col, $to_col);
- }
-
- for my $c (($from_col+1)..($to_col-1)) {
- my $middle_piece = substr($board->[$to_row], $c, 1);
- return 0 if ($middle_piece ne '-');
- }
-
- return 1;
- } else {
- if ($from_row > $to_row) {
- ($to_row, $from_row) = ($from_row, $to_row);
- }
-
- for my $r (($from_row+1)..($to_row-1)) {
- my $middle_piece = substr($board->[$r], $to_col, 1);
- return 0 if ($middle_piece ne '-');
- }
-
- return 1;
- }
- }
- if (lc($piece) eq 'b') {
- return 0 unless (abs($from_row - $to_row) == abs($from_col - $to_col));
-
- my $dr = ($to_row - $from_row) / abs($to_row - $from_row);
- my $dc = ($to_col - $from_col) / abs($to_col - $from_col);
-
- my $r = $from_row + $dr;
- my $c = $from_col + $dc;
-
- while ($r != $to_row) {
- my $middle_piece = substr($board->[$r], $c, 1);
- return 0 if ($middle_piece ne '-');
-
- $r += $dr;
- $c += $dc;
- }
-
- return 1;
- }
- if (lc($piece) eq 'n') {
- my $diff_r = abs($from_row - $to_row);
- my $diff_c = abs($from_col - $to_col);
- return 1 if ($diff_r == 2 && $diff_c == 1);
- return 1 if ($diff_r == 1 && $diff_c == 2);
- return 0;
- }
- if ($piece eq 'q') {
- return (can_reach($board, 'r', $from_row, $from_col, $to_row, $to_col) ||
- can_reach($board, 'b', $from_row, $from_col, $to_row, $to_col));
- }
- if ($piece eq 'Q') {
- return (can_reach($board, 'R', $from_row, $from_col, $to_row, $to_col) ||
- can_reach($board, 'B', $from_row, $from_col, $to_row, $to_col));
- }
-
- # TODO: en passant
- if ($piece eq 'p') {
- # black pawn
- if ($to_col == $from_col && $to_row == $from_row + 1) {
- return ($dest_piece eq '-');
- }
- if ($to_col == $from_col && $from_row == 1 && $to_row == 3) {
- my $middle_piece = substr($board->[2], $to_col, 1);
- return ($dest_piece eq '-' && $middle_piece eq '-');
- }
- if (abs($to_col - $from_col) == 1 && $to_row == $from_row + 1) {
- return ($dest_piece ne '-');
- }
- return 0;
- }
- if ($piece eq 'P') {
- # white pawn
- if ($to_col == $from_col && $to_row == $from_row - 1) {
- return ($dest_piece eq '-');
- }
- if ($to_col == $from_col && $from_row == 6 && $to_row == 4) {
- my $middle_piece = substr($board->[5], $to_col, 1);
- return ($dest_piece eq '-' && $middle_piece eq '-');
- }
- if (abs($to_col - $from_col) == 1 && $to_row == $from_row - 1) {
- return ($dest_piece ne '-');
- }
- return 0;
- }
-
- # unknown piece
- return 0;