AMAZONS

PROGRAM AMAZONS
INTEGER LEGAL_MOVE, TURN_COUNT, GAME_ENDED, INPUT_CORRECT
CHARACTER(LEN=2) GAME_BOARD(10, 10)
CHARACTER(LEN=6) INPUT
1 FORMAT (A11)
2 FORMAT (A32)
3 FORMAT (A26)
4 FORMAT (A10)
TURN_COUNT = 1
GAME_ENDED = 0
CALL SET_UP_BOARD(GAME_BOARD)
CALL END_GAME(GAME_BOARD, GAME_ENDED)
DO WHILE (GAME_ENDED == 0)
CALL PRINT_BOARD(GAME_BOARD)
INPUT_CORRECT = 0
IF (TURN_COUNT / 2 * 2 == TURN_COUNT) THEN
PRINT 1, 'BLACKS TURN'
ELSE
PRINT 1, 'WHITES TURN'
END IF
DO WHILE (INPUT_CORRECT == 0)
PRINT 2, 'ENTER PIECE AND WHERE TO MOVE IT'
READ '(A)', INPUT
CALL CHECK_INPUT(INPUT, GAME_BOARD, INPUT_CORRECT, TURN_COUNT)
END DO
CALL MAKE_MOVE(INPUT, GAME_BOARD)
CALL PRINT_BOARD(GAME_BOARD)
INPUT_CORRECT = 0
CALL FIND_PLAYER(INPUT(1:2), GAME_BOARD, I_PLAYER, J_PLAYER)
DO WHILE (INPUT_CORRECT == 0)
PRINT 3, 'ENTER PLACE TO SET ON FIRE'
READ '(A)', INPUT
CALL CHECK_FIRE_INPUT(INPUT, INPUT_CORRECT, I_PLAYER, J_PLAYER, GAME_BOARD)
END DO
CALL FIND_TARGET(INPUT(1:2), I_FIRE, J_FIRE)
CALL SET_FIRE(I_PLAYER, J_PLAYER, I_FIRE, J_FIRE, GAME_BOARD, LEGAL_MOVE)
TURN_COUNT = TURN_COUNT + 1
CALL END_GAME(GAME_BOARD, GAME_ENDED)
END DO
CALL PRINT_BOARD(GAME_BOARD)
IF (GAME_ENDED == 1) THEN
PRINT 4, 'WHITE WINS'
ELSE
PRINT 4, 'BLACK WINS'
END IF
END PROGRAM

SUBROUTINE MAKE_MOVE(INPUT, GAME_BOARD)
INTEGER I_PLAYER, J_PLAYER, I_TARGET, J_TARGET
CHARACTER(LEN=2) GAME_BOARD(10, 10)
CHARACTER(LEN=6) INPUT
CALL FIND_PLAYER(INPUT(1:2), GAME_BOARD, I_PLAYER, J_PLAYER)
CALL FIND_TARGET(INPUT(4:6), I_TARGET, J_TARGET)
GAME_BOARD(I_TARGET, J_TARGET) = GAME_BOARD(I_PLAYER, J_PLAYER)
GAME_BOARD(I_PLAYER, J_PLAYER) = '  '
RETURN
END SUBROUTINE

SUBROUTINE IS_MOVE_LEGAL(I_PLAYER, J_PLAYER, I_TARGET, J_TARGET, GAME_BOARD, LEGAL_MOVE)
INTEGER I_PLAYER, J_PLAYER, I_TARGET, J_TARGET, LEGAL_MOVE
CHARACTER(LEN=2) GAME_BOARD(10, 10)
LEGAL_MOVE = 0
IF (I_PLAYER == I_TARGET .AND. J_PLAYER /= J_TARGET) THEN
LEGAL_MOVE = 1
IF (J_PLAYER > J_TARGET) THEN
DO J = J_PLAYER - 1, J_TARGET, - 1
IF (GAME_BOARD(I_TARGET, J) /= '  ') THEN
LEGAL_MOVE = 0
EXIT
END IF
END DO
ELSE
DO J = J_PLAYER + 1, J_TARGET
IF (GAME_BOARD(I_TARGET, J) /= '  ') THEN
LEGAL_MOVE = 0
EXIT
END IF
END DO
END IF
ELSE IF (J_PLAYER == J_TARGET .AND. I_PLAYER /= I_TARGET) THEN
LEGAL_MOVE = 1
IF (I_PLAYER > I_TARGET) THEN
DO I = I_PLAYER - 1, I_TARGET, - 1
IF (GAME_BOARD(I, J_TARGET) /= '  ') THEN
LEGAL_MOVE = 0
EXIT
END IF
END DO
ELSE
DO I = I_PLAYER + 1, I_TARGET
IF (GAME_BOARD(I, J_TARGET) /= '  ') THEN
LEGAL_MOVE = 0
EXIT
END IF
END DO
END IF
ELSE IF (ABS(I_PLAYER - I_TARGET) == ABS(J_PLAYER - J_TARGET) .AND. J_PLAYER /= J_TARGET) THEN
LEGAL_MOVE = 1
IF (I_PLAYER > I_TARGET .AND. J_PLAYER > J_TARGET) THEN
J = J_PLAYER - 1
DO I = I_PLAYER - 1, I_TARGET, -1
IF (GAME_BOARD(I, J) /= '  ') THEN
LEGAL_MOVE = 0
EXIT
END IF
J = J - 1
END DO
ELSE IF (I_PLAYER > I_TARGET .AND. J_PLAYER < J_TARGET) THEN
J = J_PLAYER + 1
DO I = I_PLAYER - 1, I_TARGET, -1
IF (GAME_BOARD(I, J) /= '  ') THEN
LEGAL_MOVE = 0
EXIT
END IF
J = J + 1
END DO
ELSE IF (I_PLAYER < I_TARGET .AND. J_PLAYER < J_TARGET) THEN
J = J_PLAYER + 1
DO I = I_PLAYER + 1, I_TARGET
IF (GAME_BOARD(I, J) /= '  ') THEN
LEGAL_MOVE = 0
EXIT
END IF
J = J + 1
END DO
ELSE IF (I_PLAYER < I_TARGET .AND. J_PLAYER > J_TARGET) THEN
J = J_PLAYER - 1
DO I = I_PLAYER + 1, I_TARGET
IF (GAME_BOARD(I, J) /= '  ') THEN
LEGAL_MOVE = 0
EXIT
END IF
J = J - 1
END DO
END IF
END IF
RETURN
END SUBROUTINE

SUBROUTINE HAS_PLAYER_MOVES(I_PLAYER, J_PLAYER, GAME_BOARD, POSSIBLE_MOVE)
INTEGER I_PLAYER, J_PLAYER, POSSIBLE_MOVE
CHARACTER(LEN=2) GAME_BOARD(10, 10)
POSSIBLE_MOVE = 0
IF (I_PLAYER > 1 .AND. I_PLAYER < 10 .AND. J_PLAYER > 1 .AND. J_PLAYER < 10) THEN
CALL SEARCH_AREA(GAME_BOARD, I_PLAYER - 1, J_PLAYER - 1, I_PLAYER + 1, J_PLAYER + 1, I_PLAYER, J_PLAYER, POSSIBLE_MOVE)
ELSE IF (I_PLAYER == 1 .AND. J_PLAYER == 1) THEN
CALL SEARCH_AREA(GAME_BOARD, I_PLAYER, J_PLAYER, I_PLAYER + 1, J_PLAYER + 1, I_PLAYER, J_PLAYER, POSSIBLE_MOVE)
ELSE IF (I_PLAYER == 10 .AND. J_PLAYER == 10) THEN
CALL SEARCH_AREA(GAME_BOARD, I_PLAYER - 1, J_PLAYER - 1, I_PLAYER, J_PLAYER, I_PLAYER, J_PLAYER, POSSIBLE_MOVE)
ELSE IF (I_PLAYER == 1 .AND. J_PLAYER == 10) THEN
CALL SEARCH_AREA(GAME_BOARD, I_PLAYER, J_PLAYER - 1, I_PLAYER + 1, J_PLAYER, I_PLAYER, J_PLAYER, POSSIBLE_MOVE)
ELSE IF (I_PLAYER == 10 .AND. J_PLAYER == 1) THEN
CALL SEARCH_AREA(GAME_BOARD, I_PLAYER - 1, J_PLAYER, I_PLAYER, J_PLAYER + 1, I_PLAYER, J_PLAYER, POSSIBLE_MOVE)
ELSE IF (I_PLAYER > 1 .AND. I_PLAYER < 10 .AND. J_PLAYER == 1) THEN
CALL SEARCH_AREA(GAME_BOARD, I_PLAYER - 1, J_PLAYER, I_PLAYER + 1, J_PLAYER + 1, I_PLAYER, J_PLAYER, POSSIBLE_MOVE)
ELSE IF (I_PLAYER > 1 .AND. I_PLAYER < 10 .AND. J_PLAYER == 10) THEN
CALL SEARCH_AREA(GAME_BOARD, I_PLAYER - 1, J_PLAYER - 1, I_PLAYER + 1, J_PLAYER, I_PLAYER, J_PLAYER, POSSIBLE_MOVE)
ELSE IF (J_PLAYER > 1 .AND. J_PLAYER < 10 .AND. I_PLAYER == 1) THEN
CALL SEARCH_AREA(GAME_BOARD, I_PLAYER, J_PLAYER - 1, I_PLAYER + 1, J_PLAYER + 1, I_PLAYER, J_PLAYER, POSSIBLE_MOVE)
ELSE IF (J_PLAYER > 1 .AND. J_PLAYER < 10 .AND. I_PLAYER == 10) THEN
CALL SEARCH_AREA(GAME_BOARD, I_PLAYER - 1, J_PLAYER - 1, I_PLAYER, J_PLAYER + 1, I_PLAYER, J_PLAYER, POSSIBLE_MOVE)
END IF
RETURN
END SUBROUTINE

SUBROUTINE FIND_PLAYER(INPUT, GAME_BOARD, I_PLAYER, J_PLAYER)
CHARACTER(LEN=2) GAME_BOARD(10,10), INPUT
INTEGER I_PLAYER, J_PLAYER
DO I = 1, 10
DO J = 1, 10
IF (GAME_BOARD(I, J) == INPUT) THEN
I_PLAYER = I
J_PLAYER = J
EXIT
END IF
END DO
END DO
RETURN
END SUBROUTINE

SUBROUTINE FIND_TARGET(INPUT, I_TARGET, J_TARGET)
CHARACTER(LEN=3) INPUT
CHARACTER(LEN=2) CHECK_NUM(10)
CHARACTER(LEN=1) CHECK(10)
INTEGER I_TARGET, J_TARGET
CHECK(1) = 'A'
CHECK(2) = 'B'
CHECK(3) = 'C'
CHECK(4) = 'D'
CHECK(5) = 'E'
CHECK(6) = 'F'
CHECK(7) = 'G'
CHECK(8) = 'H'
CHECK(9) = 'I'
CHECK(10) = 'J'
CHECK_NUM(1) = '1 '
CHECK_NUM(2) = '2 '
CHECK_NUM(3) = '3 '
CHECK_NUM(4) = '4 '
CHECK_NUM(5) = '5 '
CHECK_NUM(6) = '6 '
CHECK_NUM(7) = '7 '
CHECK_NUM(8) = '8 '
CHECK_NUM(9) = '9 '
CHECK_NUM(10) = '10'
DO I = 1 , 10
IF (INPUT(1:1) == CHECK(I)) J_TARGET = I
IF (INPUT(2:3) == CHECK_NUM(I)) I_TARGET = I
END DO
RETURN
END SUBROUTINE

SUBROUTINE SET_FIRE(I_PLAYER, J_PLAYER, I_FIRE, J_FIRE, GAME_BOARD, LEGAL_MOVE)
CHARACTER(LEN=2) GAME_BOARD(10, 10)
INTEGER I_PLAYER, J_PLAYER, I_FIRE, J_FIRE, LEGAL_MOVE
CALL IS_MOVE_LEGAL(I_PLAYER, J_PLAYER, I_FIRE, J_FIRE, GAME_BOARD, LEGAL_MOVE)
IF (LEGAL_MOVE == 1) GAME_BOARD(I_FIRE, J_FIRE) = '~~'
RETURN
END SUBROUTINE

SUBROUTINE END_GAME(GAME_BOARD, GAME_ENDED)
CHARACTER(LEN=2) GAME_BOARD(10,10)
INTEGER GAME_ENDED, POSSIBLE_MOVE1, POSSIBLE_MOVE2, POSSIBLE_MOVE3, POSSIBLE_MOVE4
INTEGER POSSIBLE_MOVE5, POSSIBLE_MOVE6, POSSIBLE_MOVE7, POSSIBLE_MOVE8
CALL FIND_PLAYER('W1', GAME_BOARD, I_PLAYER, J_PLAYER)
CALL HAS_PLAYER_MOVES(I_PLAYER, J_PLAYER, GAME_BOARD, POSSIBLE_MOVE1)
CALL FIND_PLAYER('W2', GAME_BOARD, I_PLAYER, J_PLAYER)
CALL HAS_PLAYER_MOVES(I_PLAYER, J_PLAYER, GAME_BOARD, POSSIBLE_MOVE2)
CALL FIND_PLAYER('W3', GAME_BOARD, I_PLAYER, J_PLAYER)
CALL HAS_PLAYER_MOVES(I_PLAYER, J_PLAYER, GAME_BOARD, POSSIBLE_MOVE3)
CALL FIND_PLAYER('W4', GAME_BOARD, I_PLAYER, J_PLAYER)
CALL HAS_PLAYER_MOVES(I_PLAYER, J_PLAYER, GAME_BOARD, POSSIBLE_MOVE4)
CALL FIND_PLAYER('B1', GAME_BOARD, I_PLAYER, J_PLAYER)
CALL HAS_PLAYER_MOVES(I_PLAYER, J_PLAYER, GAME_BOARD, POSSIBLE_MOVE5)
CALL FIND_PLAYER('B2', GAME_BOARD, I_PLAYER, J_PLAYER)
CALL HAS_PLAYER_MOVES(I_PLAYER, J_PLAYER, GAME_BOARD, POSSIBLE_MOVE6)
CALL FIND_PLAYER('B3', GAME_BOARD, I_PLAYER, J_PLAYER)
CALL HAS_PLAYER_MOVES(I_PLAYER, J_PLAYER, GAME_BOARD, POSSIBLE_MOVE7)
CALL FIND_PLAYER('B4', GAME_BOARD, I_PLAYER, J_PLAYER)
CALL HAS_PLAYER_MOVES(I_PLAYER, J_PLAYER, GAME_BOARD, POSSIBLE_MOVE8)
IF (POSSIBLE_MOVE1 == 0 .AND. POSSIBLE_MOVE2 == 0 .AND. POSSIBLE_MOVE3 == 0 .AND. POSSIBLE_MOVE4 == 0) THEN
GAME_ENDED = 2
ELSE IF (POSSIBLE_MOVE5 == 0 .AND. POSSIBLE_MOVE6 == 0 .AND. POSSIBLE_MOVE7 == 0 .AND. POSSIBLE_MOVE8 == 0) THEN
GAME_ENDED = 1
END IF
RETURN
END SUBROUTINE

SUBROUTINE PRINT_BOARD(GAME_BOARD)
1 FORMAT (A54)
2 FORMAT (I2, ' | ', 10(A2, ' | '))
CHARACTER(LEN=2) GAME_BOARD(10, 10)
PRINT 1, '   +-------------------------------------------------+'
DO I = 1, 10
IF (I == 10) THEN
PRINT 2, I, (GAME_BOARD(I, J), J = 1, 10)
PRINT 1, '   +-------------------------------------------------+'
ELSE IF (I /= 10) THEN
PRINT 2, I, (GAME_BOARD(I, J), J = 1, 10)
PRINT 1, '   |----+----+----+----+----+----+----+----+----+----|'
END IF
END DO
PRINT 1, '      A    B    C    D    E    F    G    H    I    J  '
RETURN
END SUBROUTINE

SUBROUTINE SET_UP_BOARD(GAME_BOARD)
CHARACTER(LEN=2) GAME_BOARD(10, 10)
GAME_BOARD = '  '
GAME_BOARD(1, 4) = 'W1'
GAME_BOARD(1, 7) = 'W2'
GAME_BOARD(4, 1) = 'W3'
GAME_BOARD(4, 10) = 'W4'
GAME_BOARD(7, 1) = 'B1'
GAME_BOARD(7, 10) = 'B2'
GAME_BOARD(10, 4) = 'B3'
GAME_BOARD(10, 7) = 'B4'
RETURN
END SUBROUTINE

SUBROUTINE CHECK_INPUT(INPUT, GAME_BOARD, INPUT_CORRECT, TURN_COUNT)
INTEGER INPUT_CORRECT, POSSIBLE_FIRE, POSSIBLE_MOVE, TURN_COUNT
CHARACTER(LEN=6) INPUT
CHARACTER(LEN=2) GAME_BOARD(10,10), CHECK_NUM(10)
CHARACTER(LEN=1) CHECK(10)
CHECK(1) = 'A'
CHECK(2) = 'B'
CHECK(3) = 'C'
CHECK(4) = 'D'
CHECK(5) = 'E'
CHECK(6) = 'F'
CHECK(7) = 'G'
CHECK(8) = 'H'
CHECK(9) = 'I'
CHECK(10) = 'J'
CHECK_NUM(1) = '1 '
CHECK_NUM(2) = '2 '
CHECK_NUM(3) = '3 '
CHECK_NUM(4) = '4 '
CHECK_NUM(5) = '5 '
CHECK_NUM(6) = '6 '
CHECK_NUM(7) = '7 '
CHECK_NUM(8) = '8 '
CHECK_NUM(9) = '9 '
CHECK_NUM(10) = '10'
INPUT_CORRECT = 0
IF (INPUT(1:1) == 'W' .AND. TURN_COUNT / 2 * 2 /= TURN_COUNT .OR. INPUT(1:1) == 'B' .AND. TURN_COUNT / 2 * 2 == TURN_COUNT) THEN
IF (INPUT(2:2) == '1' .OR. INPUT(2:2) == '2' .OR. INPUT(2:2) == '3' .OR. INPUT(2:2) == '4') THEN
IF (INPUT(3:3) == ' ') THEN
DO I = 1 , 10
IF (INPUT(4:4) == CHECK(I)) THEN
DO J = 1, 10
IF (INPUT(5:6) == CHECK_NUM(J)) THEN
CALL FIND_PLAYER(INPUT(1:2), GAME_BOARD, I_PLAYER, J_PLAYER)
CALL FIND_TARGET(INPUT(4:6), I_TARGET, J_TARGET)
CALL HAS_PLAYER_MOVES(I_PLAYER, J_PLAYER, GAME_BOARD, POSSIBLE_MOVE)
CALL HAS_PLAYER_MOVES(I_TARGET, J_TARGET, GAME_BOARD, POSSIBLE_FIRE)
CALL IS_MOVE_LEGAL(I_PLAYER, J_PLAYER, I_TARGET, J_TARGET, GAME_BOARD, LEGAL_MOVE)
IF (LEGAL_MOVE == 1 .AND. POSSIBLE_MOVE == 1) THEN
INPUT_CORRECT = 1
END IF
EXIT
END IF
END DO
END IF
END DO
END IF
END IF
END IF
RETURN
END SUBROUTINE

SUBROUTINE CHECK_FIRE_INPUT(INPUT, INPUT_CORRECT, I_PLAYER, J_PLAYER, GAME_BOARD)
INTEGER INPUT_CORRECT, I_PLAYER, J_PLAYER
CHARACTER(LEN=3) INPUT
CHARACTER(LEN=2) GAME_BOARD(10,10),CHECK_NUM(10)
CHARACTER(LEN=1) CHECK(10)
CHECK(1) = 'A'
CHECK(2) = 'B'
CHECK(3) = 'C'
CHECK(4) = 'D'
CHECK(5) = 'E'
CHECK(6) = 'F'
CHECK(7) = 'G'
CHECK(8) = 'H'
CHECK(9) = 'I'
CHECK(10) = 'J'
CHECK_NUM(1) = '1 '
CHECK_NUM(2) = '2 '
CHECK_NUM(3) = '3 '
CHECK_NUM(4) = '4 '
CHECK_NUM(5) = '5 '
CHECK_NUM(6) = '6 '
CHECK_NUM(7) = '7 '
CHECK_NUM(8) = '8 '
CHECK_NUM(9) = '9 '
CHECK_NUM(10) = '10'
INPUT_CORRECT = 0
DO I = 1 , 10
IF (INPUT(1:1) == CHECK(I)) THEN
DO J = 1, 10
IF (INPUT(2:3) == CHECK_NUM(J)) THEN
CALL FIND_TARGET(INPUT, I_TARGET, J_TARGET)
CALL IS_MOVE_LEGAL(I_PLAYER, J_PLAYER, I_TARGET, J_TARGET, GAME_BOARD, INPUT_CORRECT)
EXIT
END IF
END DO
END IF
END DO
RETURN
END SUBROUTINE

SUBROUTINE SEARCH_AREA(GAME_BOARD, I_MIN, J_MIN, I_MAX, J_MAX, I_PLAYER, J_PLAYER, POSSIBLE_MOVE)
CHARACTER(LEN=2) GAME_BOARD(10, 10)
INTEGER I_MIN, J_MIN, I_MAX, J_MAX, I_PLAYER, J_PLAYER, POSSIBLE_MOVE
POSSIBLE_MOVE = 0
DO I = I_MIN, I_MAX
DO J = J_MIN, J_MAX
IF (GAME_BOARD(I, J) == '  ' .AND. I /= I_PLAYER .AND. J /= J_PLAYER) THEN
POSSIBLE_MOVE = 1
EXIT
END IF
END DO
END DO
END SUBROUTINE