|
! ============================================ |
|
! Module: Chess_Types |
|
! Purpose: Define constants and basic types |
|
! ============================================ |
|
MODULE Chess_Types |
|
IMPLICIT NONE |
|
|
|
! --- Constants for Pieces --- |
|
INTEGER, PARAMETER :: NO_PIECE = 0 |
|
INTEGER, PARAMETER :: PAWN = 1 |
|
INTEGER, PARAMETER :: KNIGHT = 2 |
|
INTEGER, PARAMETER :: BISHOP = 3 |
|
INTEGER, PARAMETER :: ROOK = 4 |
|
INTEGER, PARAMETER :: QUEEN = 5 |
|
INTEGER, PARAMETER :: KING = 6 |
|
|
|
! --- Constants for Colors --- |
|
INTEGER, PARAMETER :: NO_COLOR = 0 |
|
INTEGER, PARAMETER :: WHITE = 1 |
|
INTEGER, PARAMETER :: BLACK = 2 |
|
|
|
! --- Board Dimensions --- |
|
INTEGER, PARAMETER :: BOARD_SIZE = 8 |
|
|
|
! --- Maximum number of moves possible in a position --- |
|
INTEGER, PARAMETER :: MAX_MOVES = 256 ! Sufficient for chess |
|
|
|
! --- Derived Type for Square (Using 1-based indexing) --- |
|
TYPE :: Square_Type |
|
INTEGER :: rank = 0 |
|
INTEGER :: file = 0 |
|
END TYPE Square_Type |
|
|
|
! --- Derived Type for Move --- |
|
TYPE :: Move_Type |
|
TYPE(Square_Type) :: from_sq |
|
TYPE(Square_Type) :: to_sq |
|
LOGICAL :: is_castling = .FALSE. |
|
LOGICAL :: is_en_passant = .FALSE. |
|
INTEGER :: promotion_piece = NO_PIECE ! e.g., QUEEN, KNIGHT... |
|
INTEGER :: captured_piece = NO_PIECE ! Type of piece captured |
|
END TYPE Move_Type |
|
|
|
! --- Derived Type for Undoing Moves --- |
|
TYPE :: UnmakeInfo_Type |
|
INTEGER :: captured_piece_type = NO_PIECE |
|
INTEGER :: captured_piece_color = NO_COLOR |
|
TYPE(Square_Type) :: captured_sq ! Needed for EP undo |
|
LOGICAL :: prev_ep_target_present = .FALSE. |
|
TYPE(Square_Type) :: prev_ep_target_sq |
|
LOGICAL :: prev_wc_k = .FALSE. |
|
LOGICAL :: prev_wc_q = .FALSE. |
|
LOGICAL :: prev_bc_k = .FALSE. |
|
LOGICAL :: prev_bc_q = .FALSE. |
|
END TYPE UnmakeInfo_Type |
|
|
|
! --- Derived Type for Board State --- |
|
TYPE :: Board_Type |
|
INTEGER, DIMENSION(BOARD_SIZE, BOARD_SIZE) :: squares_piece = NO_PIECE |
|
INTEGER, DIMENSION(BOARD_SIZE, BOARD_SIZE) :: squares_color = NO_COLOR |
|
INTEGER :: current_player = WHITE |
|
LOGICAL :: ep_target_present = .FALSE. |
|
TYPE(Square_Type) :: ep_target_sq |
|
LOGICAL :: wc_k = .FALSE. ! White Kingside Castle Right |
|
LOGICAL :: wc_q = .FALSE. ! White Queenside Castle Right |
|
LOGICAL :: bc_k = .FALSE. ! Black Kingside Castle Right |
|
LOGICAL :: bc_q = .FALSE. ! Black Queenside Castle Right |
|
END TYPE Board_Type |
|
|
|
END MODULE Chess_Types |
|
|
|
! ============================================ |
|
! Module: Board_Utils |
|
! Purpose: Helper functions for board ops |
|
! ============================================ |
|
MODULE Board_Utils |
|
USE Chess_Types |
|
IMPLICIT NONE |
|
PRIVATE |
|
PUBLIC :: init_board, print_board, get_opponent_color, & |
|
sq_is_valid, char_to_file, char_to_rank, & |
|
file_rank_to_sq, is_square_attacked, & |
|
find_king, is_in_check |
|
|
|
CONTAINS |
|
|
|
! --- Function to convert file char ('a'-'h') to index (1-8) --- |
|
INTEGER FUNCTION char_to_file(file_char) |
|
CHARACTER(LEN=1), INTENT(IN) :: file_char |
|
char_to_file = ICHAR(file_char) - ICHAR('a') + 1 |
|
END FUNCTION char_to_file |
|
|
|
! --- Function to convert rank char ('1'-'8') to index (1-8) --- |
|
INTEGER FUNCTION char_to_rank(rank_char) |
|
CHARACTER(LEN=1), INTENT(IN) :: rank_char |
|
INTEGER :: ierr |
|
READ (rank_char, '(I1)', IOSTAT=ierr) char_to_rank |
|
! Basic error check could be added |
|
END FUNCTION char_to_rank |
|
|
|
! --- Subroutine to create a Square_Type --- |
|
FUNCTION file_rank_to_sq(file, rank) RESULT(sq) |
|
INTEGER, INTENT(IN) :: file, rank |
|
TYPE(Square_Type) :: sq |
|
sq%file = file |
|
sq%rank = rank |
|
END FUNCTION file_rank_to_sq |
|
|
|
! --- Function to check if square indices are valid (1-8) --- |
|
LOGICAL FUNCTION sq_is_valid(rank, file) |
|
INTEGER, INTENT(IN) :: rank, file |
|
sq_is_valid = (rank >= 1 .AND. rank <= BOARD_SIZE .AND. & |
|
file >= 1 .AND. file <= BOARD_SIZE) |
|
END FUNCTION sq_is_valid |
|
|
|
! --- Get opponent color --- |
|
INTEGER FUNCTION get_opponent_color(player_color) |
|
INTEGER, INTENT(IN) :: player_color |
|
IF (player_color == WHITE) THEN |
|
get_opponent_color = BLACK |
|
ELSE IF (player_color == BLACK) THEN |
|
get_opponent_color = WHITE |
|
ELSE |
|
get_opponent_color = NO_COLOR ! Should not happen |
|
END IF |
|
END FUNCTION get_opponent_color |
|
|
|
! --- Initialize Board to Starting Position --- |
|
SUBROUTINE init_board(board) |
|
TYPE(Board_Type), INTENT(OUT) :: board |
|
|
|
INTEGER :: i, f |
|
INTEGER, DIMENSION(BOARD_SIZE) :: back_rank_pieces = & |
|
(/ ROOK, KNIGHT, BISHOP, QUEEN, KING, BISHOP, KNIGHT, ROOK /) |
|
|
|
! Clear board |
|
board%squares_piece = NO_PIECE |
|
board%squares_color = NO_COLOR |
|
|
|
! Place pieces |
|
DO f = 1, BOARD_SIZE |
|
! White pieces |
|
board%squares_piece(1, f) = back_rank_pieces(f) |
|
board%squares_color(1, f) = WHITE |
|
board%squares_piece(2, f) = PAWN |
|
board%squares_color(2, f) = WHITE |
|
! Black pieces |
|
board%squares_piece(8, f) = back_rank_pieces(f) |
|
board%squares_color(8, f) = BLACK |
|
board%squares_piece(7, f) = PAWN |
|
board%squares_color(7, f) = BLACK |
|
END DO |
|
|
|
! Set initial state |
|
board%current_player = WHITE |
|
board%ep_target_present = .FALSE. |
|
board%ep_target_sq%rank = 0 |
|
board%ep_target_sq%file = 0 |
|
board%wc_k = .TRUE. |
|
board%wc_q = .TRUE. |
|
board%bc_k = .TRUE. |
|
board%bc_q = .TRUE. |
|
|
|
END SUBROUTINE init_board |
|
|
|
! --- Print Board to Console --- |
|
SUBROUTINE print_board(board) |
|
TYPE(Board_Type), INTENT(IN) :: board |
|
INTEGER :: r, f |
|
CHARACTER(LEN=1) :: piece_char |
|
|
|
PRINT *, " +---+---+---+---+---+---+---+---+" |
|
DO r = BOARD_SIZE, 1, -1 |
|
WRITE(*, '(I1,A)', ADVANCE='NO') r, " |" |
|
DO f = 1, BOARD_SIZE |
|
SELECT CASE (board%squares_piece(r,f)) |
|
CASE (PAWN) |
|
piece_char = 'P' |
|
CASE (KNIGHT) |
|
piece_char = 'N' |
|
CASE (BISHOP) |
|
piece_char = 'B' |
|
CASE (ROOK) |
|
piece_char = 'R' |
|
CASE (QUEEN) |
|
piece_char = 'Q' |
|
CASE (KING) |
|
piece_char = 'K' |
|
CASE DEFAULT |
|
piece_char = ' ' |
|
END SELECT |
|
|
|
IF (board%squares_color(r,f) == BLACK .AND. piece_char /= '.') THEN |
|
! Crude lowercase for black |
|
piece_char = ACHAR(IACHAR(piece_char) + 32) |
|
END IF |
|
WRITE(*, '(A,A)', ADVANCE='NO') " "//piece_char//" |" |
|
END DO |
|
PRINT * |
|
PRINT *, " +---+---+---+---+---+---+---+---+" |
|
END DO |
|
PRINT *, " a b c d e f g h" |
|
IF (board%current_player == WHITE) THEN |
|
PRINT *, "Turn: White" |
|
ELSE |
|
PRINT *, "Turn: Black" |
|
END IF |
|
! Add EP target, Castling rights printout if desired |
|
END SUBROUTINE print_board |
|
|
|
|
|
! --- Find King of a given color --- |
|
FUNCTION find_king(board, king_color) RESULT(king_sq) |
|
TYPE(Board_Type), INTENT(IN) :: board |
|
INTEGER, INTENT(IN) :: king_color |
|
TYPE(Square_Type) :: king_sq |
|
INTEGER :: r, f |
|
LOGICAL :: found = .FALSE. |
|
|
|
king_sq%rank = 0 ! Indicate not found initially |
|
king_sq%file = 0 |
|
|
|
DO r = 1, BOARD_SIZE |
|
DO f = 1, BOARD_SIZE |
|
IF (board%squares_piece(r, f) == KING .AND. & |
|
board%squares_color(r, f) == king_color) THEN |
|
king_sq%rank = r |
|
king_sq%file = f |
|
found = .TRUE. |
|
EXIT ! Exit inner loop |
|
END IF |
|
END DO |
|
IF (found) EXIT ! Exit outer loop |
|
END DO |
|
|
|
END FUNCTION find_king |
|
|
|
LOGICAL FUNCTION is_square_attacked(board, target_sq, attacker_color) |
|
TYPE(Board_Type), INTENT(IN) :: board |
|
TYPE(Square_Type), INTENT(IN) :: target_sq |
|
INTEGER, INTENT(IN) :: attacker_color |
|
|
|
INTEGER :: i, tr, tf, r, f, piece, color, dir, df, dr |
|
INTEGER, DIMENSION(8,2) :: knight_deltas, king_deltas, sliding_deltas |
|
LOGICAL :: is_diagonal |
|
|
|
is_square_attacked = .FALSE. ! Assume not attacked initially |
|
tr = target_sq%rank |
|
tf = target_sq%file |
|
|
|
! 1. Check Pawn attacks |
|
IF (attacker_color == WHITE) THEN |
|
dir = -1 ! White pawns attack southwards (from rank+1) |
|
ELSE |
|
dir = 1 ! Black pawns attack northwards (from rank-1) |
|
END IF |
|
r = tr + dir |
|
DO df = -1, 1, 2 ! Check files tf-1 and tf+1 |
|
f = tf + df |
|
IF (sq_is_valid(r, f)) THEN |
|
IF (board%squares_piece(r, f) == PAWN .AND. & |
|
board%squares_color(r, f) == attacker_color) THEN |
|
is_square_attacked = .TRUE. |
|
RETURN |
|
END IF |
|
END IF |
|
END DO |
|
|
|
knight_deltas = RESHAPE((/ 2, 1, -1, -2, -2, -1, 1, 2, & |
|
1, 2, 2, 1, -1, -2, -2, -1 /), (/8, 2/)) |
|
|
|
DO i = 1, 8 |
|
dr = knight_deltas(i, 1) |
|
df = knight_deltas(i, 2) |
|
r = tr + dr |
|
f = tf + df |
|
IF (sq_is_valid(r,f)) THEN |
|
IF (board%squares_piece(r,f) == KNIGHT .AND. & |
|
board%squares_color(r,f) == attacker_color) THEN |
|
is_square_attacked = .TRUE. |
|
RETURN |
|
END IF |
|
END IF |
|
END DO |
|
|
|
! 3. Check King attacks |
|
king_deltas = RESHAPE((/ 1, 0, -1, 0, 1, 1, -1, -1, & |
|
0, 1, 0, -1, 1, -1, 1, -1 /), (/8, 2/)) |
|
|
|
DO i = 1, 8 |
|
dr = king_deltas(i, 1) |
|
df = king_deltas(i, 2) |
|
r = tr + dr |
|
f = tf + df |
|
IF (sq_is_valid(r,f)) THEN |
|
IF (board%squares_piece(r,f) == KING .AND. & |
|
board%squares_color(r,f) == attacker_color) THEN |
|
is_square_attacked = .TRUE. |
|
RETURN |
|
END IF |
|
END IF |
|
END DO |
|
|
|
! 4. Check Sliding attacks (Rook, Bishop, Queen) |
|
sliding_deltas = RESHAPE((/ 1, -1, 0, 0, 1, 1, -1, -1, & |
|
0, 0, 1, -1, 1, -1, 1, -1 /), (/8, 2/)) |
|
|
|
DO i = 1, 8 |
|
dr = sliding_deltas(i, 1) |
|
df = sliding_deltas(i, 2) |
|
is_diagonal = (i > 4) |
|
r = tr + dr |
|
f = tf + df |
|
DO WHILE (sq_is_valid(r, f)) |
|
piece = board%squares_piece(r,f) |
|
color = board%squares_color(r,f) |
|
IF (piece /= NO_PIECE) THEN ! Found a piece |
|
IF (color == attacker_color) THEN |
|
SELECT CASE(piece) |
|
CASE(QUEEN) |
|
is_square_attacked = .TRUE.; RETURN |
|
CASE(ROOK) |
|
IF (.NOT. is_diagonal) THEN |
|
is_square_attacked = .TRUE.; RETURN |
|
END IF |
|
CASE(BISHOP) |
|
IF (is_diagonal) THEN |
|
is_square_attacked = .TRUE.; RETURN |
|
END IF |
|
END SELECT |
|
END IF |
|
EXIT ! Path blocked, stop searching this direction |
|
END IF |
|
r = r + dr |
|
f = f + df |
|
END DO |
|
END DO |
|
|
|
END FUNCTION is_square_attacked |
|
|
|
! --- Check if the king of 'player_color' is in check --- |
|
LOGICAL FUNCTION is_in_check(board, player_color) |
|
TYPE(Board_Type), INTENT(IN) :: board |
|
INTEGER, INTENT(IN) :: player_color |
|
TYPE(Square_Type) :: king_sq |
|
INTEGER :: attacker_color |
|
|
|
king_sq = find_king(board, player_color) |
|
IF (king_sq%rank == 0) THEN ! King not found (error state) |
|
is_in_check = .FALSE. ! Or handle error |
|
RETURN |
|
END IF |
|
|
|
attacker_color = get_opponent_color(player_color) |
|
is_in_check = is_square_attacked(board, king_sq, attacker_color) |
|
|
|
END FUNCTION is_in_check |
|
|
|
|
|
END MODULE Board_Utils |
|
|
|
|
|
! ============================================ |
|
! Module: Move_Generation |
|
! Purpose: Generate pseudo-legal and legal moves |
|
! ============================================ |
|
MODULE Move_Generation |
|
USE Chess_Types |
|
USE Board_Utils |
|
IMPLICIT NONE |
|
PRIVATE |
|
PUBLIC :: generate_moves ! Main function exposed |
|
|
|
CONTAINS |
|
|
|
! --- Helper to add a move to the list if array not full --- |
|
SUBROUTINE add_move(move_list, num_moves, new_move) |
|
TYPE(Move_Type), DIMENSION(:), INTENT(INOUT) :: move_list |
|
INTEGER, INTENT(INOUT) :: num_moves |
|
TYPE(Move_Type), INTENT(IN) :: new_move |
|
IF (num_moves < MAX_MOVES) THEN |
|
num_moves = num_moves + 1 |
|
move_list(num_moves) = new_move |
|
ELSE |
|
PRINT *, "Warning: Move list full!" |
|
! Handle error - maybe stop program or ignore move |
|
END IF |
|
END SUBROUTINE add_move |
|
|
|
! --- Generate Pawn Moves --- |
|
SUBROUTINE generate_pawn_moves(board, from_sq, move_list, num_moves) |
|
TYPE(Board_Type), INTENT(IN) :: board |
|
TYPE(Square_Type), INTENT(IN) :: from_sq |
|
TYPE(Move_Type), DIMENSION(:), INTENT(INOUT) :: move_list ! Array to store moves |
|
INTEGER, INTENT(INOUT) :: num_moves ! Current count of moves in list |
|
|
|
INTEGER :: r, f, dir, start_rank, promotion_rank, next_r, dbl_r, target_f |
|
INTEGER :: player_color, opponent_color, target_color, target_piece |
|
TYPE(Square_Type) :: to_sq, ep_sq |
|
TYPE(Move_Type) :: new_move |
|
LOGICAL :: can_promote |
|
INTEGER, DIMENSION(4) :: promotion_options = (/ QUEEN, ROOK, BISHOP, KNIGHT /) |
|
INTEGER :: i |
|
|
|
r = from_sq%rank |
|
f = from_sq%file |
|
player_color = board%current_player |
|
opponent_color = get_opponent_color(player_color) |
|
|
|
IF (player_color == WHITE) THEN |
|
dir = 1 |
|
start_rank = 2 |
|
promotion_rank = 8 |
|
ELSE |
|
dir = -1 |
|
start_rank = 7 |
|
promotion_rank = 1 |
|
END IF |
|
|
|
! 1. Single Push |
|
next_r = r + dir |
|
IF (sq_is_valid(next_r, f)) THEN |
|
IF (board%squares_piece(next_r, f) == NO_PIECE) THEN |
|
can_promote = (next_r == promotion_rank) |
|
to_sq = file_rank_to_sq(f, next_r) |
|
IF (can_promote) THEN |
|
DO i = 1, 4 |
|
new_move%from_sq = from_sq |
|
new_move%to_sq = to_sq |
|
new_move%promotion_piece = promotion_options(i) |
|
new_move%captured_piece = NO_PIECE |
|
new_move%is_castling = .FALSE. |
|
new_move%is_en_passant = .FALSE. |
|
CALL add_move(move_list, num_moves, new_move) |
|
END DO |
|
ELSE |
|
new_move%from_sq = from_sq |
|
new_move%to_sq = to_sq |
|
new_move%promotion_piece = NO_PIECE |
|
new_move%captured_piece = NO_PIECE |
|
new_move%is_castling = .FALSE. |
|
new_move%is_en_passant = .FALSE. |
|
CALL add_move(move_list, num_moves, new_move) |
|
|
|
! 2. Double Push (only if single push was possible) |
|
IF (r == start_rank) THEN |
|
dbl_r = r + 2*dir |
|
IF (sq_is_valid(dbl_r, f)) THEN |
|
IF (board%squares_piece(dbl_r, f) == NO_PIECE) THEN |
|
to_sq = file_rank_to_sq(f, dbl_r) |
|
new_move%from_sq = from_sq |
|
new_move%to_sq = to_sq |
|
new_move%promotion_piece = NO_PIECE |
|
new_move%captured_piece = NO_PIECE |
|
new_move%is_castling = .FALSE. |
|
new_move%is_en_passant = .FALSE. |
|
CALL add_move(move_list, num_moves, new_move) |
|
END IF |
|
END IF |
|
END IF |
|
END IF |
|
END IF |
|
END IF |
|
|
|
! 3. Captures (Diagonal) |
|
IF (sq_is_valid(next_r, 1)) THEN ! Only need to check rank validity once |
|
DO target_f = f-1, f+1, 2 ! Check f-1 and f+1 |
|
IF (sq_is_valid(next_r, target_f)) THEN |
|
target_piece = board%squares_piece(next_r, target_f) |
|
target_color = board%squares_color(next_r, target_f) |
|
to_sq = file_rank_to_sq(target_f, next_r) |
|
|
|
! Regular Capture |
|
IF (target_piece /= NO_PIECE .AND. target_color == opponent_color) THEN |
|
can_promote = (next_r == promotion_rank) |
|
IF (can_promote) THEN |
|
DO i = 1, 4 |
|
new_move%from_sq = from_sq |
|
new_move%to_sq = to_sq |
|
new_move%promotion_piece = promotion_options(i) |
|
new_move%captured_piece = target_piece |
|
new_move%is_castling = .FALSE. |
|
new_move%is_en_passant = .FALSE. |
|
CALL add_move(move_list, num_moves, new_move) |
|
END DO |
|
ELSE |
|
new_move%from_sq = from_sq |
|
new_move%to_sq = to_sq |
|
new_move%promotion_piece = NO_PIECE |
|
new_move%captured_piece = target_piece |
|
new_move%is_castling = .FALSE. |
|
new_move%is_en_passant = .FALSE. |
|
CALL add_move(move_list, num_moves, new_move) |
|
END IF |
|
! En Passant Capture |
|
ELSE IF (board%ep_target_present .AND. & |
|
next_r == board%ep_target_sq%rank .AND. & |
|
target_f == board%ep_target_sq%file) THEN |
|
new_move%from_sq = from_sq |
|
new_move%to_sq = board%ep_target_sq ! Move to EP target square |
|
new_move%promotion_piece = NO_PIECE |
|
new_move%captured_piece = PAWN ! EP always captures a pawn |
|
new_move%is_castling = .FALSE. |
|
new_move%is_en_passant = .TRUE. |
|
CALL add_move(move_list, num_moves, new_move) |
|
END IF |
|
END IF |
|
END DO |
|
END IF |
|
|
|
END SUBROUTINE generate_pawn_moves |
|
|
|
! --- Generate Knight Moves --- |
|
SUBROUTINE generate_knight_moves(board, from_sq, move_list, num_moves) |
|
TYPE(Board_Type), INTENT(IN) :: board |
|
TYPE(Square_Type), INTENT(IN) :: from_sq |
|
TYPE(Move_Type), DIMENSION(:), INTENT(INOUT) :: move_list |
|
INTEGER, INTENT(INOUT) :: num_moves |
|
|
|
INTEGER :: r, f, nr, nf, target_piece, target_color |
|
INTEGER, DIMENSION(8,2) :: deltas |
|
TYPE(Square_Type) :: to_sq |
|
TYPE(Move_Type) :: new_move |
|
INTEGER :: i |
|
|
|
r = from_sq%rank |
|
f = from_sq%file |
|
|
|
deltas = RESHAPE((/ 2, 1, -1, -2, -2, -1, 1, 2, & |
|
1, 2, 2, 1, -1, -2, -2, -1 /), (/8, 2/)) |
|
|
|
|
|
new_move%from_sq = from_sq |
|
new_move%promotion_piece = NO_PIECE |
|
new_move%is_castling = .FALSE. |
|
new_move%is_en_passant = .FALSE. |
|
|
|
DO i = 1, 8 |
|
nr = r + deltas(i, 1) |
|
nf = f + deltas(i, 2) |
|
IF (sq_is_valid(nr, nf)) THEN |
|
target_piece = board%squares_piece(nr, nf) |
|
target_color = board%squares_color(nr, nf) |
|
to_sq = file_rank_to_sq(nf, nr) |
|
new_move%to_sq = to_sq |
|
|
|
IF (target_piece == NO_PIECE) THEN ! Move to empty square |
|
new_move%captured_piece = NO_PIECE |
|
CALL add_move(move_list, num_moves, new_move) |
|
ELSE IF (target_color /= board%current_player) THEN ! Capture |
|
new_move%captured_piece = target_piece |
|
CALL add_move(move_list, num_moves, new_move) |
|
END IF |
|
END IF |
|
END DO |
|
END SUBROUTINE generate_knight_moves |
|
|
|
|
|
! --- Generate Sliding Moves (Rook, Bishop, Queen) --- |
|
SUBROUTINE generate_sliding_moves(board, from_sq, directions, num_dirs, move_list, num_moves) |
|
TYPE(Board_Type), INTENT(IN) :: board |
|
TYPE(Square_Type), INTENT(IN) :: from_sq |
|
INTEGER, DIMENSION(num_dirs, 2), INTENT(IN) :: directions |
|
INTEGER, INTENT(IN) :: num_dirs |
|
TYPE(Move_Type), DIMENSION(:), INTENT(INOUT) :: move_list |
|
INTEGER, INTENT(INOUT) :: num_moves |
|
|
|
INTEGER :: r, f, nr, nf, target_piece, target_color, dr, df |
|
TYPE(Square_Type) :: to_sq |
|
TYPE(Move_Type) :: new_move |
|
INTEGER :: i |
|
|
|
r = from_sq%rank |
|
f = from_sq%file |
|
|
|
new_move%from_sq = from_sq |
|
new_move%promotion_piece = NO_PIECE |
|
new_move%is_castling = .FALSE. |
|
new_move%is_en_passant = .FALSE. |
|
|
|
DO i = 1, num_dirs |
|
dr = directions(i, 1) |
|
df = directions(i, 2) |
|
nr = r + dr |
|
nf = f + df |
|
DO WHILE (sq_is_valid(nr, nf)) |
|
target_piece = board%squares_piece(nr, nf) |
|
target_color = board%squares_color(nr, nf) |
|
to_sq = file_rank_to_sq(nf, nr) |
|
new_move%to_sq = to_sq |
|
|
|
IF (target_piece == NO_PIECE) THEN ! Move to empty square |
|
new_move%captured_piece = NO_PIECE |
|
CALL add_move(move_list, num_moves, new_move) |
|
ELSE ! Hit a piece |
|
IF (target_color /= board%current_player) THEN ! Capture |
|
new_move%captured_piece = target_piece |
|
CALL add_move(move_list, num_moves, new_move) |
|
END IF |
|
EXIT ! Stop searching this direction (path blocked) |
|
END IF |
|
|
|
nr = nr + dr ! Continue sliding |
|
nf = nf + df |
|
END DO |
|
END DO |
|
END SUBROUTINE generate_sliding_moves |
|
|
|
! --- Generate King Moves (Including Castling placeholders) --- |
|
SUBROUTINE generate_king_moves(board, from_sq, move_list, num_moves) |
|
TYPE(Board_Type), INTENT(IN) :: board |
|
TYPE(Square_Type), INTENT(IN) :: from_sq |
|
TYPE(Move_Type), DIMENSION(:), INTENT(INOUT) :: move_list |
|
INTEGER, INTENT(INOUT) :: num_moves |
|
|
|
INTEGER :: r, f, nr, nf, target_piece, target_color, back_rank |
|
INTEGER, DIMENSION(8,2) :: deltas |
|
TYPE(Square_Type) :: to_sq |
|
TYPE(Move_Type) :: new_move |
|
INTEGER :: i |
|
LOGICAL :: can_castle_k, can_castle_q |
|
|
|
r = from_sq%rank |
|
f = from_sq%file |
|
|
|
! 1. Normal Moves |
|
deltas = RESHAPE((/ 1, 0, -1, 0, 1, 1, -1, -1, & |
|
0, 1, 0, -1, 1, -1, 1, -1 /), (/8, 2/)) |
|
|
|
new_move%from_sq = from_sq |
|
new_move%promotion_piece = NO_PIECE |
|
new_move%is_castling = .FALSE. |
|
new_move%is_en_passant = .FALSE. |
|
|
|
DO i = 1, 8 |
|
nr = r + deltas(i, 1) |
|
nf = f + deltas(i, 2) |
|
IF (sq_is_valid(nr, nf)) THEN |
|
target_piece = board%squares_piece(nr, nf) |
|
target_color = board%squares_color(nr, nf) |
|
to_sq = file_rank_to_sq(nf, nr) |
|
new_move%to_sq = to_sq |
|
|
|
IF (target_piece == NO_PIECE) THEN ! Move to empty square |
|
new_move%captured_piece = NO_PIECE |
|
CALL add_move(move_list, num_moves, new_move) |
|
ELSE IF (target_color /= board%current_player) THEN ! Capture |
|
new_move%captured_piece = target_piece |
|
CALL add_move(move_list, num_moves, new_move) |
|
END IF |
|
END IF |
|
END DO |
|
|
|
! 2. Castling (Pseudo-legal check: rights and empty squares) |
|
! Legality check (squares not attacked) happens in generate_moves |
|
IF (board%current_player == WHITE) THEN |
|
back_rank = 1 |
|
can_castle_k = board%wc_k |
|
can_castle_q = board%wc_q |
|
ELSE |
|
back_rank = 8 |
|
can_castle_k = board%bc_k |
|
can_castle_q = board%bc_q |
|
END IF |
|
|
|
IF (r == back_rank .AND. f == 5) THEN ! King on e1/e8 |
|
! Kingside |
|
IF (can_castle_k .AND. & |
|
board%squares_piece(back_rank, 6) == NO_PIECE .AND. & |
|
board%squares_piece(back_rank, 7) == NO_PIECE .AND. & |
|
board%squares_piece(back_rank, 8) == ROOK .AND. & ! Check rook presence |
|
board%squares_color(back_rank, 8) == board%current_player) THEN |
|
|
|
new_move%from_sq = from_sq |
|
new_move%to_sq = file_rank_to_sq(7, back_rank) ! King to g1/g8 |
|
new_move%promotion_piece = NO_PIECE |
|
new_move%captured_piece = NO_PIECE |
|
new_move%is_castling = .TRUE. |
|
new_move%is_en_passant = .FALSE. |
|
CALL add_move(move_list, num_moves, new_move) |
|
END IF |
|
! Queenside |
|
IF (can_castle_q .AND. & |
|
board%squares_piece(back_rank, 4) == NO_PIECE .AND. & |
|
board%squares_piece(back_rank, 3) == NO_PIECE .AND. & |
|
board%squares_piece(back_rank, 2) == NO_PIECE .AND. & |
|
board%squares_piece(back_rank, 1) == ROOK .AND. & ! Check rook presence |
|
board%squares_color(back_rank, 1) == board%current_player) THEN |
|
|
|
new_move%from_sq = from_sq |
|
new_move%to_sq = file_rank_to_sq(3, back_rank) ! King to c1/c8 |
|
new_move%promotion_piece = NO_PIECE |
|
new_move%captured_piece = NO_PIECE |
|
new_move%is_castling = .TRUE. |
|
new_move%is_en_passant = .FALSE. |
|
CALL add_move(move_list, num_moves, new_move) |
|
END IF |
|
END IF |
|
|
|
END SUBROUTINE generate_king_moves |
|
|
|
|
|
! --- Generate All Pseudo-Legal Moves --- |
|
SUBROUTINE generate_pseudo_moves(board, move_list, num_moves) |
|
TYPE(Board_Type), INTENT(IN) :: board |
|
TYPE(Move_Type), DIMENSION(:), INTENT(INOUT) :: move_list ! Array to store moves |
|
INTEGER, INTENT(OUT) :: num_moves ! Count of moves generated |
|
|
|
INTEGER :: r, f, piece, color |
|
TYPE(Square_Type) :: from_sq |
|
! Define directions for sliding pieces here |
|
INTEGER, DIMENSION(4, 2) :: bishop_dirs = RESHAPE((/ 1, 1, -1, -1, -1, 1, -1, 1 /), (/4, 2/)) |
|
INTEGER, DIMENSION(4, 2) :: rook_dirs = RESHAPE((/ 1, 0, -1, 0, 0, 1, 0, -1 /), (/4, 2/)) |
|
INTEGER, DIMENSION(8, 2) :: queen_dirs = RESHAPE([ 1, -1, 0, 0, 1, 1, -1, -1, & |
|
0, 0, 1, -1, 1, -1, 1, -1 ], [8, 2]) |
|
num_moves = 0 ! Reset count |
|
|
|
DO r = 1, BOARD_SIZE |
|
DO f = 1, BOARD_SIZE |
|
piece = board%squares_piece(r, f) |
|
color = board%squares_color(r, f) |
|
|
|
IF (color == board%current_player) THEN |
|
from_sq = file_rank_to_sq(f, r) |
|
SELECT CASE (piece) |
|
CASE (PAWN) |
|
CALL generate_pawn_moves(board, from_sq, move_list, num_moves) |
|
CASE (KNIGHT) |
|
CALL generate_knight_moves(board, from_sq, move_list, num_moves) |
|
CASE (BISHOP) |
|
CALL generate_sliding_moves(board, from_sq, bishop_dirs, 4, move_list, num_moves) |
|
CASE (ROOK) |
|
CALL generate_sliding_moves(board, from_sq, rook_dirs, 4, move_list, num_moves) |
|
CASE (QUEEN) |
|
CALL generate_sliding_moves(board, from_sq, queen_dirs, 8, move_list, num_moves) |
|
CASE (KING) |
|
CALL generate_king_moves(board, from_sq, move_list, num_moves) |
|
END SELECT |
|
END IF |
|
END DO |
|
END DO |
|
END SUBROUTINE generate_pseudo_moves |
|
|
|
|
|
! --- Generate Legal Moves (Filters Pseudo-Legal) --- |
|
SUBROUTINE generate_moves(board, legal_move_list, num_legal_moves) |
|
USE make_unmake |
|
TYPE(Board_Type), INTENT(INOUT) :: board ! Needs INOUT for make/unmake |
|
TYPE(Move_Type), DIMENSION(:), INTENT(OUT) :: legal_move_list |
|
INTEGER, INTENT(OUT) :: num_legal_moves |
|
|
|
TYPE(Move_Type), DIMENSION(MAX_MOVES) :: pseudo_moves |
|
INTEGER :: num_pseudo_moves |
|
INTEGER :: i |
|
TYPE(Move_Type) :: current_move |
|
TYPE(UnmakeInfo_Type) :: unmake_info |
|
LOGICAL :: is_legal |
|
INTEGER :: player_color, opponent_color |
|
TYPE(Square_Type) :: king_sq, mid_sq |
|
|
|
num_legal_moves = 0 |
|
player_color = board%current_player |
|
opponent_color = get_opponent_color(player_color) |
|
|
|
! 1. Generate all pseudo-legal moves |
|
CALL generate_pseudo_moves(board, pseudo_moves, num_pseudo_moves) |
|
|
|
! 2. Filter for legality |
|
DO i = 1, num_pseudo_moves |
|
current_move = pseudo_moves(i) |
|
is_legal = .TRUE. ! Assume legal initially |
|
|
|
! Special check for castling through check |
|
IF (current_move%is_castling) THEN |
|
king_sq = current_move%from_sq |
|
IF (current_move%to_sq%file == 7) THEN ! Kingside |
|
mid_sq = file_rank_to_sq(6, king_sq%rank) |
|
ELSE ! Queenside (to_sq%file == 3) |
|
mid_sq = file_rank_to_sq(4, king_sq%rank) |
|
END IF |
|
IF (is_square_attacked(board, king_sq, opponent_color) .OR. & |
|
is_square_attacked(board, mid_sq, opponent_color) .OR. & |
|
is_square_attacked(board, current_move%to_sq, opponent_color)) THEN |
|
is_legal = .FALSE. |
|
END IF |
|
END IF |
|
|
|
IF (is_legal) THEN |
|
! 3. Make the move, check if king is safe, unmake the move |
|
CALL make_move(board, current_move, unmake_info) |
|
IF (.NOT. is_in_check(board, player_color)) THEN |
|
! Add to legal move list |
|
CALL add_move(legal_move_list, num_legal_moves, current_move) |
|
END IF |
|
CALL unmake_move(board, current_move, unmake_info) |
|
END IF |
|
END DO |
|
|
|
END SUBROUTINE generate_moves |
|
|
|
|
|
END MODULE Move_Generation |
|
|
|
|
|
! ============================================ |
|
! Module: Make_Unmake |
|
! Purpose: Apply and revert moves on the board |
|
! ============================================ |
|
MODULE Make_Unmake |
|
USE Chess_Types |
|
USE Board_Utils |
|
IMPLICIT NONE |
|
PRIVATE |
|
PUBLIC :: make_move, unmake_move |
|
|
|
CONTAINS |
|
|
|
! --- Make Move --- |
|
SUBROUTINE make_move(board, move, unmake_info) |
|
TYPE(Board_Type), INTENT(INOUT) :: board |
|
TYPE(Move_Type), INTENT(IN) :: move |
|
TYPE(UnmakeInfo_Type), INTENT(OUT) :: unmake_info |
|
|
|
INTEGER :: r_from, f_from, r_to, f_to, player_color, opponent_color |
|
INTEGER :: piece_moved, color_moved, r_capture, back_rank |
|
TYPE(Square_Type) :: from_sq, to_sq |
|
|
|
player_color = board%current_player |
|
opponent_color = get_opponent_color(player_color) |
|
from_sq = move%from_sq |
|
to_sq = move%to_sq |
|
r_from = from_sq%rank; f_from = from_sq%file |
|
r_to = to_sq%rank; f_to = to_sq%file |
|
|
|
! 1. Store info for unmake |
|
unmake_info%prev_ep_target_present = board%ep_target_present |
|
unmake_info%prev_ep_target_sq = board%ep_target_sq |
|
unmake_info%prev_wc_k = board%wc_k |
|
unmake_info%prev_wc_q = board%wc_q |
|
unmake_info%prev_bc_k = board%bc_k |
|
unmake_info%prev_bc_q = board%bc_q |
|
|
|
piece_moved = board%squares_piece(r_from, f_from) |
|
color_moved = board%squares_color(r_from, f_from) |
|
|
|
IF (move%is_en_passant) THEN |
|
unmake_info%captured_piece_type = PAWN |
|
unmake_info%captured_piece_color = opponent_color |
|
IF (player_color == WHITE) THEN |
|
r_capture = r_to - 1 |
|
ELSE |
|
r_capture = r_to + 1 |
|
END IF |
|
unmake_info%captured_sq = file_rank_to_sq(f_to, r_capture) |
|
! Remove the captured pawn |
|
board%squares_piece(r_capture, f_to) = NO_PIECE |
|
board%squares_color(r_capture, f_to) = NO_COLOR |
|
ELSE IF (move%is_castling) THEN |
|
unmake_info%captured_piece_type = NO_PIECE |
|
unmake_info%captured_piece_color = NO_COLOR |
|
unmake_info%captured_sq%rank = 0 ! Not used |
|
ELSE |
|
unmake_info%captured_piece_type = board%squares_piece(r_to, f_to) |
|
unmake_info%captured_piece_color = board%squares_color(r_to, f_to) |
|
unmake_info%captured_sq = to_sq ! Capture happens on 'to' square |
|
END IF |
|
|
|
! 2. Update Squares |
|
! Clear 'from' square |
|
board%squares_piece(r_from, f_from) = NO_PIECE |
|
board%squares_color(r_from, f_from) = NO_COLOR |
|
|
|
IF (move%is_castling) THEN |
|
board%squares_piece(r_to, f_to) = KING |
|
board%squares_color(r_to, f_to) = player_color |
|
! Move the rook |
|
IF (f_to == 7) THEN ! Kingside (g file) |
|
board%squares_piece(r_from, 8) = NO_PIECE; board%squares_color(r_from, 8) = NO_COLOR |
|
board%squares_piece(r_from, 6) = ROOK; board%squares_color(r_from, 6) = player_color |
|
ELSE ! Queenside (f_to == 3, c file) |
|
board%squares_piece(r_from, 1) = NO_PIECE; board%squares_color(r_from, 1) = NO_COLOR |
|
board%squares_piece(r_from, 4) = ROOK; board%squares_color(r_from, 4) = player_color |
|
END IF |
|
ELSE |
|
! Place moving piece (handle promotion) |
|
IF (move%promotion_piece /= NO_PIECE) THEN |
|
board%squares_piece(r_to, f_to) = move%promotion_piece |
|
ELSE |
|
board%squares_piece(r_to, f_to) = piece_moved |
|
END IF |
|
board%squares_color(r_to, f_to) = color_moved |
|
END IF |
|
|
|
! 3. Update EP Target |
|
board%ep_target_present = .FALSE. |
|
IF (piece_moved == PAWN .AND. ABS(r_to - r_from) == 2) THEN |
|
board%ep_target_present = .TRUE. |
|
board%ep_target_sq%rank = (r_to + r_from) / 2 |
|
board%ep_target_sq%file = f_from |
|
END IF |
|
|
|
! 4. Update Castling Rights |
|
IF (piece_moved == KING) THEN |
|
IF (player_color == WHITE) THEN |
|
board%wc_k = .FALSE.; board%wc_q = .FALSE. |
|
ELSE |
|
board%bc_k = .FALSE.; board%bc_q = .FALSE. |
|
END IF |
|
END IF |
|
IF (piece_moved == ROOK) THEN |
|
IF (player_color == WHITE) THEN |
|
IF (r_from == 1 .AND. f_from == 1) board%wc_q = .FALSE. |
|
IF (r_from == 1 .AND. f_from == 8) board%wc_k = .FALSE. |
|
ELSE |
|
IF (r_from == 8 .AND. f_from == 1) board%bc_q = .FALSE. |
|
IF (r_from == 8 .AND. f_from == 8) board%bc_k = .FALSE. |
|
END IF |
|
END IF |
|
! Rook captured on home square |
|
IF (unmake_info%captured_piece_type == ROOK) THEN |
|
IF (unmake_info%captured_piece_color == WHITE) THEN |
|
IF (r_to == 1 .AND. f_to == 1) board%wc_q = .FALSE. |
|
IF (r_to == 1 .AND. f_to == 8) board%wc_k = .FALSE. |
|
ELSE ! Black rook captured |
|
IF (r_to == 8 .AND. f_to == 1) board%bc_q = .FALSE. |
|
IF (r_to == 8 .AND. f_to == 8) board%bc_k = .FALSE. |
|
END IF |
|
END IF |
|
|
|
! 5. Switch Player |
|
board%current_player = opponent_color |
|
|
|
END SUBROUTINE make_move |
|
|
|
! --- Unmake Move --- |
|
SUBROUTINE unmake_move(board, move, unmake_info) |
|
TYPE(Board_Type), INTENT(INOUT) :: board |
|
TYPE(Move_Type), INTENT(IN) :: move |
|
TYPE(UnmakeInfo_Type), INTENT(IN) :: unmake_info |
|
|
|
INTEGER :: r_from, f_from, r_to, f_to, player_color, opponent_color |
|
INTEGER :: piece_to_restore, color_to_restore |
|
|
|
! 1. Switch Player Back |
|
board%current_player = get_opponent_color(board%current_player) |
|
player_color = board%current_player ! Color of player who made the move being unmade |
|
|
|
! 2. Restore Board State |
|
board%ep_target_present = unmake_info%prev_ep_target_present |
|
board%ep_target_sq = unmake_info%prev_ep_target_sq |
|
board%wc_k = unmake_info%prev_wc_k |
|
board%wc_q = unmake_info%prev_wc_q |
|
board%bc_k = unmake_info%prev_bc_k |
|
board%bc_q = unmake_info%prev_bc_q |
|
|
|
! 3. Reverse Piece Movements |
|
r_from = move%from_sq%rank; f_from = move%from_sq%file |
|
r_to = move%to_sq%rank; f_to = move%to_sq%file |
|
|
|
! Determine the piece type that moved (was it a pawn before promotion?) |
|
IF (move%promotion_piece /= NO_PIECE) THEN |
|
piece_to_restore = PAWN |
|
ELSE IF (move%is_castling) THEN |
|
piece_to_restore = KING ! King moved during castling |
|
ELSE |
|
! Get the piece from the 'to' square (it must be there after make_move) |
|
piece_to_restore = board%squares_piece(r_to, f_to) |
|
END IF |
|
color_to_restore = player_color |
|
|
|
! Put the piece back on 'from' square |
|
board%squares_piece(r_from, f_from) = piece_to_restore |
|
board%squares_color(r_from, f_from) = color_to_restore |
|
|
|
! Restore 'to' square (and potentially captured piece / EP pawn) |
|
IF (move%is_castling) THEN |
|
board%squares_piece(r_to, f_to) = NO_PIECE ! Clear king's landing sq |
|
board%squares_color(r_to, f_to) = NO_COLOR |
|
! Put rook back |
|
IF (f_to == 7) THEN ! Kingside (g file) |
|
board%squares_piece(r_from, 6) = NO_PIECE; board%squares_color(r_from, 6) = NO_COLOR |
|
board%squares_piece(r_from, 8) = ROOK; board%squares_color(r_from, 8) = player_color |
|
ELSE ! Queenside (f_to == 3, c file) |
|
board%squares_piece(r_from, 4) = NO_PIECE; board%squares_color(r_from, 4) = NO_COLOR |
|
board%squares_piece(r_from, 1) = ROOK; board%squares_color(r_from, 1) = player_color |
|
END IF |
|
ELSE IF (move%is_en_passant) THEN |
|
board%squares_piece(r_to, f_to) = NO_PIECE ! Clear EP landing sq |
|
board%squares_color(r_to, f_to) = NO_COLOR |
|
! Put captured pawn back |
|
board%squares_piece(unmake_info%captured_sq%rank, unmake_info%captured_sq%file) = PAWN |
|
board%squares_color(unmake_info%captured_sq%rank, unmake_info%captured_sq%file) = unmake_info%captured_piece_color |
|
ELSE |
|
! Restore whatever was on the 'to' square (captured piece or nothing) |
|
board%squares_piece(r_to, f_to) = unmake_info%captured_piece_type |
|
board%squares_color(r_to, f_to) = unmake_info%captured_piece_color |
|
END IF |
|
|
|
END SUBROUTINE unmake_move |
|
|
|
END MODULE Make_Unmake |
|
|
|
! ============================================ |
|
! Module: Evaluation |
|
! Purpose: Static board evaluation |
|
! ============================================ |
|
MODULE Evaluation |
|
USE Chess_Types |
|
USE Board_Utils |
|
IMPLICIT NONE |
|
PRIVATE |
|
PUBLIC :: evaluate_board |
|
|
|
|
|
INTEGER, PARAMETER, DIMENSION(8, 8) :: PAWN_PST = RESHAPE( & |
|
[ 0, 50, 10, 5, 0, 5, 5, 0, & ! Column 1 |
|
0, 50, 10, 5, 0, -5, 10, 0, & ! Column 2 |
|
0, 50, 20, 10, 0, -10, 10, 0, & ! Column 3 |
|
0, 50, 30, 25, 20, 0, -20, 0, & ! Column 4 |
|
0, 50, 30, 25, 20, -10, -20, 0, & ! Column 5 |
|
0, 50, 20, 10, 0, -10, 10, 0, & ! Column 6 |
|
0, 50, 10, 5, 0, 5, 10, 0, & ! Column 7 |
|
0, 50, 0, 0, 0, 0, 0, 0 ], & ! Column 8 |
|
SHAPE(PAWN_PST)) |
|
|
|
INTEGER, PARAMETER, DIMENSION(8, 8) :: KNIGHT_PST = RESHAPE( & |
|
[ -50, -40, -30, -30, -30, -30, -40, -50, & ! Column 1 |
|
-40, -20, 0, 0, 0, 0, -20, -40, & ! Column 2 |
|
-30, 0, 10, 15, 15, 10, 0, -30, & ! Column 3 |
|
-30, 5, 15, 20, 20, 15, 5, -30, & ! Column 4 |
|
-30, 0, 15, 20, 20, 15, 0, -30, & ! Column 5 |
|
-30, 5, 10, 15, 15, 10, 5, -30, & ! Column 6 |
|
-40, -20, 0, 5, 5, 0, -20, -40, & ! Column 7 |
|
-50, -40, -30, -30, -30, -30, -40, -50 ], & ! Column 8 |
|
SHAPE(KNIGHT_PST)) |
|
|
|
INTEGER, PARAMETER, DIMENSION(8, 8) :: BISHOP_PST = RESHAPE( & |
|
[ -20, -10, -10, -10, -10, -10, -10, -20, & ! Column 1 |
|
-10, 0, 0, 0, 0, 0, 0, -10, & ! Column 2 |
|
-10, 0, 10, 10, 10, 10, 0, -10, & ! Column 3 |
|
-10, 5, 5, 10, 10, 5, 5, -10, & ! Column 4 |
|
-10, 0, 5, 10, 10, 5, 0, -10, & ! Column 5 |
|
-10, 5, 5, 5, 5, 5, 5, -10, & ! Column 6 |
|
-10, 0, 5, 0, 0, 5, 0, -10, & ! Column 7 |
|
-20, -10, -10, -10, -10, -10, -10, -20 ], & ! Column 8 |
|
SHAPE(BISHOP_PST)) |
|
|
|
INTEGER, PARAMETER, DIMENSION(8, 8) :: ROOK_PST = RESHAPE( & |
|
[ 0, 0, 0, 0, 0, 0, 0, 0, & ! Column 1 |
|
5, 10, 10, 10, 10, 10, 10, 5, & ! Column 2 |
|
-5, 0, 0, 0, 0, 0, 0, -5, & ! Column 3 |
|
-5, 0, 0, 0, 0, 0, 0, -5, & ! Column 4 |
|
-5, 0, 0, 0, 0, 0, 0, -5, & ! Column 5 |
|
-5, 0, 0, 0, 0, 0, 0, -5, & ! Column 6 |
|
-5, 0, 0, 0, 0, 0, 0, -5, & ! Column 7 |
|
0, 0, 0, 5, 5, 0, 0, 0 ], & ! Column 8 |
|
SHAPE(ROOK_PST)) |
|
|
|
INTEGER, PARAMETER, DIMENSION(8, 8) :: QUEEN_PST = RESHAPE( & |
|
[ -20, -10, -10, -5, -5, -10, -10, -20, & ! Column 1 |
|
-10, 0, 0, 0, 0, 0, 0, -10, & ! Column 2 |
|
-10, 0, 5, 5, 5, 5, 0, -10, & ! Column 3 |
|
-5, 0, 5, 5, 5, 5, 0, -5, & ! Column 4 |
|
0, 0, 5, 5, 5, 5, 0, -5, & ! Column 5 |
|
-10, 5, 5, 5, 5, 5, 0, -10, & ! Column 6 |
|
-10, 0, 5, 0, 0, 0, 0, -10, & ! Column 7 |
|
-20, -10, -10, -5, -5, -10, -10, -20 ], & ! Column 8 |
|
SHAPE(QUEEN_PST)) |
|
|
|
INTEGER, PARAMETER, DIMENSION(8, 8) :: KING_PST = RESHAPE( & |
|
[ -30, -40, -40, -50, -50, -40, -40, -30, & ! Column 1 |
|
-30, -40, -40, -50, -50, -40, -40, -30, & ! Column 2 |
|
-30, -40, -40, -50, -50, -40, -40, -30, & ! Column 3 |
|
-30, -40, -40, -50, -50, -40, -40, -30, & ! Column 4 |
|
-20, -30, -30, -40, -40, -30, -30, -20, & ! Column 5 |
|
-10, -20, -20, -20, -20, -20, -20, -10, & ! Column 6 |
|
20, 20, 0, 0, 0, 0, 20, 20, & ! Column 7 |
|
20, 30, 10, 0, 0, 10, 30, 20 ], & ! Column 8 |
|
SHAPE(KING_PST)) |
|
|
|
INTEGER, PARAMETER :: PAWN_VAL = 100, KNIGHT_VAL = 320, BISHOP_VAL = 330, & |
|
ROOK_VAL = 500, QUEEN_VAL = 900 |
|
|
|
CONTAINS |
|
! --- Evaluate Board --- |
|
INTEGER FUNCTION evaluate_board(board) |
|
TYPE(Board_Type), INTENT(IN) :: board |
|
INTEGER :: score, r, f, piece, color, eval_rank, piece_value, pst_value |
|
|
|
score = 0 |
|
DO r = 1, BOARD_SIZE |
|
DO f = 1, BOARD_SIZE |
|
piece = board%squares_piece(r, f) |
|
color = board%squares_color(r, f) |
|
IF (piece /= NO_PIECE) THEN |
|
! Material value |
|
SELECT CASE(piece) |
|
CASE(PAWN) ; piece_value = PAWN_VAL |
|
CASE(KNIGHT) ; piece_value = KNIGHT_VAL |
|
CASE(BISHOP) ; piece_value = BISHOP_VAL |
|
CASE(ROOK) ; piece_value = ROOK_VAL |
|
CASE(QUEEN) ; piece_value = QUEEN_VAL |
|
CASE(KING) ; piece_value = 0 ! King material isn't counted |
|
END SELECT |
|
|
|
! Piece Square Table value (needs full tables defined) |
|
IF (color == WHITE) THEN |
|
eval_rank = r |
|
ELSE |
|
eval_rank = BOARD_SIZE - r + 1 ! Flip rank for black |
|
END IF |
|
|
|
SELECT CASE(piece) |
|
CASE(PAWN) ; pst_value = PAWN_PST(eval_rank, f) |
|
CASE(KNIGHT) ; pst_value = KNIGHT_PST(eval_rank, f) |
|
CASE(BISHOP) ; pst_value = BISHOP_PST(eval_rank, f) |
|
CASE(ROOK) ; pst_value = ROOK_PST(eval_rank, f) |
|
CASE(QUEEN) ; pst_value = QUEEN_PST(eval_rank, f) |
|
CASE(KING) ; pst_value = KING_PST(eval_rank, f) |
|
! Add cases for other pieces using their PSTs |
|
CASE DEFAULT ; pst_value = 0 |
|
END SELECT |
|
|
|
IF (color == WHITE) THEN |
|
score = score + piece_value + pst_value |
|
ELSE |
|
score = score - (piece_value + pst_value) |
|
END IF |
|
END IF |
|
END DO |
|
END DO |
|
|
|
! Return score relative to current player |
|
IF (board%current_player == WHITE) THEN |
|
evaluate_board = score |
|
ELSE |
|
evaluate_board = -score |
|
END IF |
|
|
|
END FUNCTION evaluate_board |
|
|
|
END MODULE Evaluation |
|
|
|
|
|
! ============================================ |
|
! Module: Search |
|
! Purpose: AI search algorithm |
|
! ============================================ |
|
MODULE Search |
|
USE Chess_Types |
|
USE Board_Utils |
|
USE Move_Generation |
|
USE Make_Unmake |
|
USE Evaluation |
|
IMPLICIT NONE |
|
PRIVATE |
|
PUBLIC :: find_best_move |
|
|
|
INTEGER, PARAMETER :: MATE_SCORE = 100000 ! A score indicating checkmate |
|
INTEGER, PARAMETER :: INF = MATE_SCORE + 1000 ! Represents infinity |
|
|
|
CONTAINS |
|
|
|
! --- Negamax Search (Recursive Helper) --- |
|
RECURSIVE INTEGER FUNCTION negamax(board, depth, alpha, beta) RESULT(best_score) |
|
TYPE(Board_Type), INTENT(INOUT) :: board ! Needs INOUT for make/unmake |
|
INTEGER, INTENT(IN) :: depth, alpha, beta |
|
INTEGER :: score, current_alpha |
|
TYPE(Move_Type), DIMENSION(MAX_MOVES) :: moves |
|
INTEGER :: num_moves, i |
|
TYPE(Move_Type) :: current_move |
|
TYPE(UnmakeInfo_Type) :: unmake_info |
|
LOGICAL :: in_check |
|
|
|
current_alpha = alpha ! Local copy to modify |
|
|
|
! 1. Depth check |
|
IF (depth <= 0) THEN |
|
best_score = evaluate_board(board) |
|
RETURN |
|
END IF |
|
|
|
! 2. Generate moves |
|
CALL generate_moves(board, moves, num_moves) |
|
|
|
! 3. Checkmate / Stalemate check |
|
IF (num_moves == 0) THEN |
|
in_check = is_in_check(board, board%current_player) |
|
IF (in_check) THEN |
|
best_score = -MATE_SCORE + (10 - depth) ! Lose faster if deeper mate |
|
ELSE |
|
best_score = 0 ! Stalemate |
|
END IF |
|
RETURN |
|
END IF |
|
|
|
! 4. Iterate through moves |
|
best_score = -INF ! Initialize with worst score |
|
|
|
DO i = 1, num_moves |
|
current_move = moves(i) |
|
CALL make_move(board, current_move, unmake_info) |
|
score = -negamax(board, depth - 1, -beta, -current_alpha) ! Recursive call |
|
CALL unmake_move(board, current_move, unmake_info) |
|
|
|
! Update best score and alpha |
|
IF (score > best_score) THEN |
|
best_score = score |
|
END IF |
|
IF (best_score > current_alpha) THEN |
|
current_alpha = best_score |
|
END IF |
|
|
|
! Beta cutoff |
|
IF (current_alpha >= beta) THEN |
|
EXIT ! Prune remaining moves |
|
END IF |
|
END DO |
|
|
|
END FUNCTION negamax |
|
|
|
|
|
! --- Find Best Move (Top Level Search Call) --- |
|
SUBROUTINE find_best_move(board, depth, best_move_found, best_move) |
|
TYPE(Board_Type), INTENT(INOUT) :: board |
|
INTEGER, INTENT(IN) :: depth |
|
LOGICAL, INTENT(OUT) :: best_move_found |
|
TYPE(Move_Type), INTENT(OUT) :: best_move |
|
|
|
TYPE(Move_Type), DIMENSION(MAX_MOVES) :: moves |
|
INTEGER :: num_moves, i |
|
INTEGER :: score, best_score_so_far, alpha, beta |
|
TYPE(Move_Type) :: current_move |
|
TYPE(UnmakeInfo_Type) :: unmake_info |
|
|
|
best_move_found = .FALSE. |
|
best_score_so_far = -INF |
|
alpha = -INF |
|
beta = INF |
|
|
|
CALL generate_moves(board, moves, num_moves) |
|
|
|
IF (num_moves == 0) THEN |
|
RETURN ! No legal moves |
|
END IF |
|
|
|
best_move = moves(1) ! Default to first move |
|
best_move_found = .TRUE. |
|
|
|
DO i = 1, num_moves |
|
current_move = moves(i) |
|
CALL make_move(board, current_move, unmake_info) |
|
score = -negamax(board, depth - 1, -beta, -alpha) |
|
CALL unmake_move(board, current_move, unmake_info) |
|
|
|
IF (score > best_score_so_far) THEN |
|
best_score_so_far = score |
|
best_move = current_move |
|
END IF |
|
|
|
! Update alpha (for root node, mainly tracking best score) |
|
IF (best_score_so_far > alpha) THEN |
|
alpha = best_score_so_far |
|
END IF |
|
! No beta cutoff at root usually, we want the actual best move |
|
END DO |
|
|
|
END SUBROUTINE find_best_move |
|
|
|
END MODULE Search |
|
|
|
! ============================================ |
|
! Main Program: Human vs Computer |
|
! ============================================ |
|
PROGRAM Fortran_Chess |
|
USE Chess_Types |
|
USE Board_Utils |
|
USE Move_Generation ! Needs Make_Unmake implicitly |
|
USE Make_Unmake |
|
USE Search |
|
IMPLICIT NONE |
|
|
|
TYPE(Board_Type) :: game_board |
|
TYPE(Move_Type) :: chosen_move |
|
TYPE(UnmakeInfo_Type) :: move_info ! Needed for make_move call |
|
LOGICAL :: move_found, is_human_turn, game_over, is_checkmate_flag, is_stalemate_flag |
|
INTEGER :: human_player_color, ai_player_color, winner |
|
INTEGER :: search_depth |
|
CHARACTER(LEN=10) :: user_input |
|
CHARACTER(LEN=1) :: from_f_char, from_r_char, to_f_char, to_r_char, promo_char |
|
TYPE(Square_Type) :: parsed_from_sq, parsed_to_sq |
|
INTEGER :: parsed_promo_piece |
|
TYPE(Move_Type), DIMENSION(MAX_MOVES) :: legal_moves |
|
INTEGER :: num_legal_moves, i |
|
|
|
search_depth = 4 ! AI Difficulty |
|
|
|
! --- Player Color Selection --- |
|
DO |
|
PRINT *, "Choose your color (White/Black): " |
|
READ *, user_input |
|
SELECT CASE (TRIM(ADJUSTL(user_input))) ! Basic input handling |
|
CASE ('White', 'white', 'W', 'w') |
|
human_player_color = WHITE |
|
ai_player_color = BLACK |
|
PRINT *, "You play as White." |
|
EXIT |
|
CASE ('Black', 'black', 'B', 'b') |
|
human_player_color = BLACK |
|
ai_player_color = WHITE |
|
PRINT *, "You play as Black." |
|
EXIT |
|
CASE DEFAULT |
|
PRINT *, "Invalid input. Please enter 'White' or 'Black'." |
|
END SELECT |
|
END DO |
|
|
|
! --- Initialize and Print Board --- |
|
CALL init_board(game_board) |
|
CALL print_board(game_board) |
|
|
|
! --- Game Loop --- |
|
game_over = .FALSE. |
|
DO WHILE (.NOT. game_over) |
|
|
|
! 1. Check Game Over |
|
! Need a way to check checkmate/stalemate without modifying board state here, |
|
! or accept that generate_moves modifies it temporarily. |
|
CALL generate_moves(game_board, legal_moves, num_legal_moves) |
|
IF (num_legal_moves == 0) THEN |
|
IF (is_in_check(game_board, game_board%current_player)) THEN |
|
winner = get_opponent_color(game_board%current_player) |
|
IF (winner == WHITE) THEN |
|
PRINT *, "=== CHECKMATE! White wins! ===" |
|
ELSE |
|
PRINT *, "=== CHECKMATE! Black wins! ===" |
|
END IF |
|
ELSE |
|
PRINT *, "=== STALEMATE! Draw. ===" |
|
END IF |
|
game_over = .TRUE. |
|
EXIT ! Exit game loop |
|
END IF |
|
|
|
! 2. Determine Turn |
|
is_human_turn = (game_board%current_player == human_player_color) |
|
|
|
IF (is_human_turn) THEN |
|
! --- Human's Turn --- |
|
PRINT *, " " ! Newline |
|
PRINT *, "Your turn. Enter move (e.g., e2e4, e7e8q): " |
|
move_found = .FALSE. |
|
DO WHILE (.NOT. move_found) |
|
READ *, user_input |
|
IF (TRIM(ADJUSTL(user_input)) == 'quit' .OR. TRIM(ADJUSTL(user_input)) == 'exit') THEN |
|
PRINT *, "Exiting game." |
|
game_over = .TRUE. |
|
EXIT ! Exit inner loop |
|
END IF |
|
|
|
! Basic Parsing (Needs Error Handling!) |
|
IF (LEN_TRIM(user_input) >= 4) THEN |
|
from_f_char = user_input(1:1); from_r_char = user_input(2:2) |
|
to_f_char = user_input(3:3); to_r_char = user_input(4:4) |
|
parsed_from_sq%file = char_to_file(from_f_char) |
|
parsed_from_sq%rank = char_to_rank(from_r_char) |
|
parsed_to_sq%file = char_to_file(to_f_char) |
|
parsed_to_sq%rank = char_to_rank(to_r_char) |
|
|
|
parsed_promo_piece = NO_PIECE |
|
IF (LEN_TRIM(user_input) == 5) THEN |
|
promo_char = user_input(5:5) |
|
SELECT CASE(promo_char) |
|
CASE('q'); parsed_promo_piece = QUEEN |
|
CASE('r'); parsed_promo_piece = ROOK |
|
CASE('b'); parsed_promo_piece = BISHOP |
|
CASE('n'); parsed_promo_piece = KNIGHT |
|
END SELECT |
|
END IF |
|
|
|
! Find the move in the legal list |
|
DO i = 1, num_legal_moves |
|
IF (legal_moves(i)%from_sq%rank == parsed_from_sq%rank .AND. & |
|
legal_moves(i)%from_sq%file == parsed_from_sq%file .AND. & |
|
legal_moves(i)%to_sq%rank == parsed_to_sq%rank .AND. & |
|
legal_moves(i)%to_sq%file == parsed_to_sq%file .AND. & |
|
legal_moves(i)%promotion_piece == parsed_promo_piece) THEN |
|
chosen_move = legal_moves(i) |
|
move_found = .TRUE. |
|
EXIT ! Exit move finding loop |
|
END IF |
|
END DO |
|
END IF |
|
|
|
IF (.NOT. move_found .AND. .NOT. game_over) THEN |
|
PRINT *, "Invalid or illegal move. Try again:" |
|
END IF |
|
END DO ! End move input loop |
|
|
|
IF (game_over) EXIT ! Exit game loop if user quit |
|
|
|
! Make human move |
|
PRINT *, "You moved." ! Add more detail later |
|
CALL make_move(game_board, chosen_move, move_info) |
|
|
|
ELSE |
|
! --- AI's Turn --- |
|
PRINT *, " " ! Newline |
|
PRINT *, "Computer's turn. Thinking..." |
|
CALL find_best_move(game_board, search_depth, move_found, chosen_move) |
|
IF (move_found) THEN |
|
PRINT *, "Computer moved." ! Add move details later |
|
CALL make_move(game_board, chosen_move, move_info) |
|
ELSE |
|
! Should be caught by game over check, but safety print |
|
PRINT *, "Error: AI found no move but game not over?" |
|
game_over = .TRUE. |
|
END IF |
|
END IF |
|
|
|
! Print board after move (if game not over) |
|
IF (.NOT. game_over) THEN |
|
CALL print_board(game_board) |
|
END IF |
|
|
|
END DO ! End game loop |
|
|
|
PRINT *, "Game finished." |
|
|
|
END PROGRAM Fortran_Chess |