Fortran 90 Chess
dean.m...@gmail.com
this form: E2-E4 (start square, hyphen, end square).
MODULE GLOBALS
INTEGER CFLAG, LEVEL, MAXLEVEL, SCORE, BOARD(0:7, 0:7), BESTA(0:7)
INTEGER BESTB(0:7), BESTX(0:7), BESTY(0:7)
END MODULE GLOBALS
PROGRAM CHESS
USE GLOBALS
IMPLICIT INTEGER (A-Z)
BOARD= RESHAPE( (/ -500, -100, 0, 0, 0, 0, 100, 500, &
-270, -100, 0, 0, 0, 0, 100, 270, &
-300, -100, 0, 0, 0, 0, 100, 300, &
-900, -100, 0, 0, 0, 0, 100, 900, &
-7500, -100, 0, 0, 0, 0, 100, 5000, &
-300, -100, 0, 0, 0, 0, 100, 300, &
-270, -100, 0, 0, 0, 0, 100, 270, &
-500, -100, 0, 0, 0, 0, 100, 500 /), SHAPE(BOARD))
LEVEL=0; MAXLEVEL=6; A=-1; RES=0; CFLAG=0
DO
SCORE=0
CALL IO(A, B, X, Y, RES)
RES=EVALUATE(-1, 10000)
A=BESTA(1); B=BESTB(1); X=BESTX(1); Y=BESTY(1)
END DO
END PROGRAM
RECURSIVE FUNCTION EVALUATE (ID, PRUNE) RESULT (RES)
USE GLOBALS
IMPLICIT INTEGER(A-Z)
DIMENSION XX(0:26), YY(0:26)
LEVEL=LEVEL+1
BESTSCORE=10000*ID
DO B=7,0, -1
DO A=7,0, -1
IF (SGN(BOARD(B,A))/=ID) CYCLE
CALL MOVELIST (A, B, XX, YY, NDX)
DO I=0,NDX,1
X=XX(I); Y=YY(I)
OLDSCORE=SCORE; MOVER=BOARD(B,A); TARG=BOARD(Y,X)
CALL MAKEMOVE (A, B, X, Y)
IF (LEVEL<MAXLEVEL) SCORE=SCORE+EVALUATE(-ID, BESTSCORE-TARG+ID*(8-
ABS(4-X)-ABS(4-Y)))
SCORE=SCORE+TARG-ID*(8-ABS(4-X)-ABS(4-Y))
IF ((ID<0 .AND. SCORE>BESTSCORE) .OR. (ID>0 .AND. SCORE<BESTSCORE))
THEN
BESTA(LEVEL)=A; BESTB(LEVEL)=B
BESTX(LEVEL)=X; BESTY(LEVEL)=Y
BESTSCORE=SCORE
IF ((ID<0 .AND. BESTSCORE>=PRUNE) .OR. (ID>0 .AND. BESTSCORE<=PRUNE))
THEN
BOARD(B,A)=MOVER; BOARD(Y,X)=TARG; SCORE=OLDSCORE
LEVEL=LEVEL-1
RES = BESTSCORE
RETURN
END IF
END IF
BOARD(B,A)=MOVER; BOARD(Y,X)=TARG; SCORE=OLDSCORE
END DO
END DO
END DO
LEVEL=LEVEL-1
RES=BESTSCORE
RETURN
END FUNCTION
SUBROUTINE MAKEMOVE (A, B, X, Y)
USE GLOBALS
IMPLICIT INTEGER (A-Z)
BOARD(Y, X)=BOARD(B, A); BOARD(B, A)=0
IF (Y == 0 .AND. BOARD(Y, X) == 100) BOARD(Y, X)= 900
IF (Y == 0 .AND. BOARD(Y, X) == -100) BOARD(Y, X)= -900
RETURN
END SUBROUTINE
SUBROUTINE MOVELIST (A, B, XX, YY, NDX)
USE GLOBALS
IMPLICIT INTEGER (A-Z)
DIMENSION XX(0:26), YY(0:26)
PIECE=ABS(BOARD(B, A)); NDX=-1
SELECT CASE (PIECE)
CASE (100)
CALL PAWN(A, B, XX, YY, NDX)
CASE (270)
CALL KNIGHT(A, B, XX, YY, NDX)
CASE (300)
CALL BISHOP(A, B, XX, YY, NDX)
CASE (500)
CALL ROOK(A, B, XX, YY, NDX)
CASE (900)
CALL QUEEN(A, B, XX, YY, NDX)
CASE DEFAULT
CALL KING(A, B, XX, YY, NDX)
END SELECT
RETURN
END SUBROUTINE
SUBROUTINE QUEEN (A, B, XX, YY, NDX)
USE GLOBALS
IMPLICIT INTEGER (A-Z)
CALL ROOK(A, B, XX, YY, NDX)
CALL BISHOP(A, B, XX, YY, NDX)
RETURN
END SUBROUTINE
SUBROUTINE KING (A, B, XX, YY, NDX)
USE GLOBALS
IMPLICIT INTEGER (A-Z)
DIMENSION XX(0:26), YY(0:26)
ID=SGN(BOARD(B, A))
DO DY=-1, 1
IF (B+DY<0 .OR. B+DY>7) CYCLE
DO DX=-1, 1
IF (A+DX<0 .OR. A+DX>7) CYCLE
IF (ID/=SGN(BOARD(B+DY,A+DX))) THEN
NDX=NDX+1; XX(NDX)=A+DX; YY(NDX)=B+DY
END IF
END DO
END DO
RETURN
END SUBROUTINE
SUBROUTINE PAWN (A, B, XX, YY, NDX)
USE GLOBALS
IMPLICIT INTEGER (A-Z)
DIMENSION XX(0:26), YY(0:26)
ID = SGN(BOARD(B, A))
IF (((A - 1) >= 0) .AND. ((A - 1) <= 7) .AND. ((B - ID) >= 0) .AND.
((B - ID) <= 7)) THEN
IF (SGN(BOARD((B - ID), (A - 1))) == -ID) THEN
NDX = NDX + 1
XX(NDX) = A - 1
YY(NDX) = B - ID
END IF
END IF
IF (((A + 1) >= 0) .AND. ((A + 1) <= 7) .AND. ((B - ID) >= 0) .AND.
((B - ID) <= 7)) THEN
IF (SGN(BOARD((B - ID), (A + 1))) == -ID) THEN
NDX = NDX + 1
XX(NDX) = A + 1
YY(NDX) = B - ID
END IF
END IF
IF ((A >= 0) .AND. (A <= 7) .AND. ((B - ID) >= 0) .AND. ((B - ID) <=
7)) THEN
IF (BOARD((B - ID), A) == 0) THEN
NDX = NDX + 1
XX(NDX) = A
YY(NDX) = B - ID
IF (((ID < 0) .AND. (B == 1)) .OR. ((ID > 0) .AND. (B == 6))) THEN
IF (BOARD((B - ID - ID), A) == 0) THEN
NDX = NDX + 1
XX(NDX) = A
YY(NDX) = B - ID - ID
END IF
END IF
END IF
END IF
END SUBROUTINE
SUBROUTINE BISHOP (A, B, XX, YY, NDX)
USE GLOBALS
IMPLICIT INTEGER (A-Z)
DIMENSION XX(0:26), YY(0:26)
ID=SGN(BOARD(B, A))
DO DXY=1, 7
X=A-DXY; IF (X<0) EXIT
Y=B+DXY; IF (Y>7) EXIT
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
IF (BOARD(Y, X)/=0) EXIT
END DO
DO DXY=1, 7
X=A+DXY; IF (X>7) EXIT
Y=B+DXY; IF (Y>7) EXIT
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
IF (BOARD(Y, X)/=0) EXIT
END DO
DO DXY=1, 7
X=A-DXY; IF (X<0) EXIT
Y=B-DXY; IF (Y<0) EXIT
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
IF (BOARD(Y, X)/=0) EXIT
END DO
DO DXY=1, 7
X=A+DXY; IF (X>7) EXIT
Y=B-DXY; IF (Y<0) EXIT
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
IF (BOARD(Y, X)/=0) EXIT
END DO
END SUBROUTINE
SUBROUTINE ROOK (A, B, XX, YY, NDX)
USE GLOBALS
IMPLICIT INTEGER (A-Z)
DIMENSION XX(0:26), YY(0:26)
ID=SGN(BOARD(B, A))
DO X = A-1, 0, -1
IF (ID/=SGN(BOARD(B, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=B
END IF
IF (BOARD(B, X)/=0) EXIT
END DO
DO X = A+1, 7, 1
IF (ID/=SGN(BOARD(B, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=B
END IF
IF (BOARD(B, X)/=0) EXIT
END DO
DO Y = B-1, 0, -1
IF (ID/=SGN(BOARD(Y, A))) THEN
NDX=NDX+1; XX(NDX)=A; YY(NDX)=Y
END IF
IF (BOARD(Y, A)/=0) EXIT
END DO
DO Y = B+1, 7, 1
IF (ID/=SGN(BOARD(Y, A))) THEN
NDX=NDX+1; XX(NDX)=A; YY(NDX)=Y
END IF
IF (BOARD(Y, A)/=0) EXIT
END DO
RETURN
END SUBROUTINE
SUBROUTINE KNIGHT (A, B, XX, YY, NDX)
USE GLOBALS
IMPLICIT INTEGER (A-Z)
DIMENSION XX(0:26), YY(0:26)
ID=SGN(BOARD(B, A))
X=A-1; Y=B-2
IF (X>=0 .AND. Y>=0) THEN
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
END IF
X=A-2; Y=B-1
IF (X>=0 .AND. Y>=0) THEN
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
END IF
X=A+1; Y=B-2
IF (X<=7 .AND. Y>=0) THEN
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
END IF
X=A+2; Y=B-1
IF (X<=7 .AND. Y>=0) THEN
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
END IF
X=A-1; Y=B+2
IF (X>=0 .AND. Y<=7) THEN
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
END IF
X=A-1; Y=B+1
IF (X>=0 .AND. Y>=7) THEN
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
END IF
X=A+1; Y=B+2
IF (X<=7 .AND. Y<=7) THEN
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
END IF
X=A+2; Y=B+1
IF (X<=7 .AND. Y<=7) THEN
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
END IF
RETURN
END SUBROUTINE
SUBROUTINE SHOW
USE GLOBALS
IMPLICIT INTEGER (A-Z)
DO B=0, 7
DO A=0, 7
SELECT CASE (BOARD(B, A))
CASE (-7500)
WRITE (*, '(A)', ADVANCE='NO') 'k'
CASE (-900)
WRITE (*, '(A)', ADVANCE='NO') 'q'
CASE (-500)
WRITE (*, '(A)', ADVANCE='NO') 'r'
CASE (-300)
WRITE (*, '(A)', ADVANCE='NO') 'b'
CASE (-270)
WRITE (*, '(A)', ADVANCE='NO') 'n'
CASE (-100)
WRITE (*, '(A)', ADVANCE='NO') 'p'
CASE (-0)
WRITE (*, '(A)', ADVANCE='NO') '.'
CASE (100)
WRITE (*, '(A)', ADVANCE='NO') 'P'
CASE (270)
WRITE (*, '(A)', ADVANCE='NO') 'N'
CASE (300)
WRITE (*, '(A)', ADVANCE='NO') 'B'
CASE (500)
WRITE (*, '(A)', ADVANCE='NO') 'R'
CASE (900)
WRITE (*, '(A)', ADVANCE='NO') 'Q'
CASE (5000)
WRITE (*, '(A)', ADVANCE='NO') 'K'
END SELECT
END DO
WRITE (*, *) ''
END DO
RETURN
END SUBROUTINE
SUBROUTINE IO (A, B, X, Y, RES)
USE GLOBALS
IMPLICIT INTEGER (A-Z)
CHARACTER (LEN=5) INPUT
DIMENSION XX(0:26), YY(0:26)
IF (A>=0) THEN
IF (RES<-2500) THEN
PRINT *, 'I RESIGN'
CALL SHOW
WRITE (*, *)
STOP
END IF
PIECE=BOARD(Y, X)
CALL MAKEMOVE(A, B, X, Y)
WRITE (*, '(A)', ADVANCE='NO') 'MY MOVE: '
WRITE (*, '(A)'), ACHAR(65+A) // ACHAR(56-B) // '-' // ACHAR(65+X) //
ACHAR(56-Y)
SELECT CASE (PIECE)
CASE (100)
PRINT *, 'I TOOK YOUR PAWN'
CASE (270)
PRINT *, 'I TOOK YOUR KNIGHT'
CASE (300)
PRINT *, 'I TOOK YOUR BISHOP'
CASE (500)
PRINT *, 'I TOOK YOUR ROOK'
CASE (900)
PRINT *, 'I TOOK YOUR QUEEN'
CASE (5000)
PRINT *, 'I TOOK YOUR KING'
END SELECT
NULL=INCHECK()
END IF
DO
CALL SHOW
WRITE (*, '(A)', ADVANCE='NO') 'YOUR MOVE: '
READ (*, *) INPUT
CALL UPCASE(INPUT)
IF ((INPUT == 'QUIT') .OR. (INPUT == 'BYE') .OR. (INPUT == 'EXIT'))
THEN
STOP
END IF
IF ((INPUT == 'O-O') .OR. (INPUT == '0-0')) THEN
IF (CFLAG /=0) CYCLE
IF (BOARD(7, 7) /= 500) CYCLE
IF ((BOARD (7,6) /= 0) .OR. (BOARD(7,5) /=0)) CYCLE
BOARD(7, 6) = 5000
BOARD(7, 4) = 0
BOARD(7, 5) = 500
BOARD(7, 7) = 0
CFLAG = 1
RETURN
END IF
IF ((INPUT == 'O-O-O') .OR. (INPUT == '0-0-0')) THEN
IF (CFLAG /= 0) CYCLE
IF (BOARD(7,0) /= 500) CYCLE
IF ((BOARD(7,1) /= 0) .OR. (BOARD(7,2) /= 0) .OR. (BOARD(7,3) /= 0))
CYCLE
BOARD(7, 2) = 5000
BOARD(7, 4) = 0
BOARD(7, 3) = 500
BOARD(7, 0) = 0
CFLAG = 1
RETURN
END IF
B = 8 - (IACHAR(INPUT(2:2)) - 48)
A = IACHAR(INPUT(1:1)) - 65
X = IACHAR(INPUT(4:4)) - 65
Y = 8 - (IACHAR(INPUT(5:5)) - 48)
IF ((B>7) .OR. (B<0) .OR. (A>7) .OR. (A<0) .OR. (X>7) .OR. (X<0) .OR.
(Y>7) .OR. (Y<0)) CYCLE
IF (BOARD(B,A)<=0) CYCLE
CALL MOVELIST(A, B, XX, YY, NDX)
DO K = 0, NDX, 1
IF ((X == XX(K)) .AND. (Y == YY(K))) THEN
MOVER = BOARD(B, A)
TARG = BOARD(Y, X)
CALL MAKEMOVE(A, B, X, Y)
IF (INCHECK() == 0) RETURN
BOARD(B, A) = MOVER
BOARD(Y, X) = TARG
EXIT
END IF
END DO
END DO
END SUBROUTINE
FUNCTION SGN(N)
USE GLOBALS
IMPLICIT INTEGER (A-Z)
IF (N < 0) THEN
SGN = -1
ELSE IF (N == 0) THEN
SGN = 0
ELSE
SGN = 1
END IF
END FUNCTION
SUBROUTINE UPCASE (STRING)
USE GLOBALS
IMPLICIT INTEGER (A-Z)
CHARACTER (LEN = *) STRING
LS = LEN(STRING)
DO LC = 1, LS
IF (LGE(STRING(LC:LC), 'a') .AND. LLE(STRING(LC:LC), 'z')) THEN
STRING(LC:LC) = ACHAR(IACHAR(STRING(LC:LC))-32)
END IF
END DO
RETURN
END SUBROUTINE
FUNCTION INCHECK()
USE GLOBALS
IMPLICIT INTEGER (A-Z)
DIMENSION XX(0:26), YY(0:26)
DO B = 0, 7
DO A = 0, 7
IF (BOARD(B, A)>=0) CYCLE
CALL MOVELIST(A, B, XX, YY, NDX)
DO I = 0, NDX, 1
X = XX(I)
Y = YY(I)
IF (BOARD(Y, X) == 5000) THEN
INCHECK = 1
RETURN
END IF
END DO
END DO
END DO
INCHECK = 0
RETURN
END FUNCTION
e p chandler
> This is a chess program written in Fortran 90. Moves are input in
> this form: E2-E4 (start square, hyphen, end square).
>
> MODULE GLOBALS
> INTEGER CFLAG, LEVEL, MAXLEVEL, SCORE, BOARD(0:7, 0:7), BESTA(0:7)
> INTEGER BESTB(0:7), BESTX(0:7), BESTY(0:7)
> END MODULE GLOBALS
>
> PROGRAM CHESS
> USE GLOBALS
> IMPLICIT INTEGER (A-Z)
> BOARD= RESHAPE( (/ -500, -100, 0, 0, 0, 0, 100, 500, &
> -270, -100, 0, 0, 0, 0, 100, 270, &
> -300, -100, 0, 0, 0, 0, 100, 300, &
> -900, -100, 0, 0, 0, 0, 100, 900, &
> -7500, -100, 0, 0, 0, 0, 100, 5000, &
> -300, -100, 0, 0, 0, 0, 100, 300, &
> -270, -100, 0, 0, 0, 0, 100, 270, &
> -500, -100, 0, 0, 0, 0, 100, 500 /), SHAPE(BOARD))
> LEVEL=0; MAXLEVEL=6; A=-1; RES=0; CFLAG=0
[snip]
After removing a number of line breaks which were introduced by
posting, the program does compile with G95 and it does play chess.
As Fortran, it's OK. Perhaps some of the repeated code was unrolled
for speed?
As a chess program, there are some things missing. It would be nice if
the program announced that my illegal moves were illegal instead of
ignoring them and looping. Likewise calling "Check" and "Checkmate"
would be nice too. I'm really not sure what "I TOOK YOUR KING" means
because that does not happen in chess. The program always plays black.
The program responds the same way every time to the same sequence of
moves, but there really is no opening book. Instead it appears to
evaluate the relative value of pieces on the board and employs some
form of pruning. I'm no chess expert, but IMO the program could do a
better job of developing its pieces.
-- e
Phillip Helbig---remove CLOTHES to reply
<20834783-6160-4c2a...@p25g2000hsf.googlegroups.com>, e p
chandler <ep...@juno.com> writes:
> The program responds the same way every time to the same sequence of
> moves, but there really is no opening book. Instead it appears to
> evaluate the relative value of pieces on the board and employs some
> form of pruning. I'm no chess expert, but IMO the program could do a
> better job of developing its pieces.
It's just a few hundred lines. I'm no expert in computer chess (though
I do have a chess computer from 1981 or so), but surely a "proper"
program is much, much, much more complicated. I'm surprised that one
could make a valid, if limited, chess program in just a few hundred
lines at all.
Beliavsky
> this form: E2-E4 (start square, hyphen, end square).
Thanks for posting this program, which unites two of my loves, chess
and Fortran. As E.P. Chandler said, some line breaks need to be fixed
to make it compile. Do you mind if I post the cleaned up version
somewhere?
The program appears not to recognize the en passant pawn capture. For
example, after
1.e2-e4 g8-f6
2.e4-e5 f6-e4
3.f1-c4 d7-d5
The move e5-d6 is not accepted.
What is a good book to learn the algorithms and data structures
relevant to programming board games? Most of my programming is very
different in nature.
dean.m...@gmail.com
> Thanks for posting this program, which unites two of my loves, chess
> and Fortran. As E.P. Chandler said, some line breaks need to be fixed
> to make it compile. Do you mind if I post the cleaned up version
> somewhere?
I don't mind if you post the cleaned up version somewhere.
> The program appears not to recognize the en passant pawn capture.
It doesn't recognize en passant capture, but I can add it, as well as
adding underpromotion.
For the board, I used a simple array for the board and two arrays for
the moves (x and y coordinates). I represented the pieces using their
relative values. You could use a larger array or bitboards to improve
efficiency.
There's actually a lot of stuff on chess programming online:
http://ai-depot.com/articles/minimax-explained/
http://www.aihorizon.com/essays/chessai/index.htm
http://www.ascotti.org/programming/chess/Shannon%20-%20Programming%20a%20computer%20for%20playing%20chess.pdf
robin
news:68ba36e4-17b6-4acd...@m3g2000hsc.googlegroups.com...
Dean, there are some errors:
> This is a chess program written in Fortran 90. Moves are input in
> this form: E2-E4 (start square, hyphen, end square).
...
> SUBROUTINE IO (A, B, X, Y, RES)
> USE GLOBALS
> IMPLICIT INTEGER (A-Z)
> CHARACTER (LEN=5) INPUT
> DIMENSION XX(0:26), YY(0:26)
> IF (A>=0) THEN
> IF (RES<-2500) THEN
> PRINT *, 'I RESIGN'
> CALL SHOW
> WRITE (*, *)
> STOP
> END IF
> PIECE=BOARD(Y, X)
> CALL MAKEMOVE(A, B, X, Y)
> WRITE (*, '(A)', ADVANCE='NO') 'MY MOVE: '
> WRITE (*, '(A)'), ACHAR(65+A) // ACHAR(56-B) // '-' // ACHAR(65+X) // > ACHAR(56-Y)
1. Previous line has syntax error, with superfluous comma before the first ACHAR.
2. Call(s) to QUEEN are in error ; dummy arguments XX and YY
in QUEEN have not been defined as arrays.
3. Variable NULL has been assigned, but is never used.
4. For the move E2-E4 (i.e., P-K4), a subscript error immediately occurs.
The error occurs in KNIGHT, and the offending line is:
IF (X>=0 .AND. Y>=7) THEN
The second comparison apparently should be Y<=7.
5. The knight behaves as if it were a pawn when doing captures.
It would be good to include some comment documentation.
Dean Menezes
On Sun, 25 May 2008, robin wrote:
> 5. The knight behaves as if it were a pawn when doing captures.
>
> It would be good to include some comment documentation.
>
I was unable to see the knight capturing as a pawn. I was able to use
the knight to capture normally as a knight and was not able to use the
knight to capture as a pawn. Can you give a list of moves?
Here is the program with the other bugs you mentioned fixed:
MODULE GLOBALS
! Global variables:
! level = current recursion level for calculation
! maxlevel = maximum recursion level
! score = current score (evaluation)
! besta, bestb, bestx, besty = holds best moves for each recursion level
! wcksflag, wcqsflag = flags to detemine castling abilities
! board = the 8x8 array to hold chessboard
INTEGER , PARAMETER :: MAXLEVEL = 5
INTEGER LEVEL, SCORE, BOARD(0:7, 0:7), BESTA(0:7)
INTEGER BESTB(1:MAXLEVEL), BESTX(1:MAXLEVEL), BESTY(1:MAXLEVEL)
LOGICAL WCKSFLAG, WCQSFLAG
END MODULE GLOBALS
PROGRAM CHESS
USE GLOBALS
IMPLICIT INTEGER (A-Z)
! initialize board to starting position
BOARD = RESHAPE( (/ -500, -100, 0, 0, 0, 0, 100, 500, &
-270, -100, 0, 0, 0, 0, 100, 270, &
-300, -100, 0, 0, 0, 0, 100, 300, &
-900, -100, 0, 0, 0, 0, 100, 900, &
-7500, -100, 0, 0, 0, 0, 100, 5000, &
-300, -100, 0, 0, 0, 0, 100, 300, &
-270, -100, 0, 0, 0, 0, 100, 270, &
-500, -100, 0, 0, 0, 0, 100, 500 /), SHAPE(BOARD))
LEVEL=0; A=-1; RES=0; CFLAG=0
WCKSFLAG = .FALSE.; WCQSFLAG = .FALSE.
! main loop: get white move from user, calculate black move
DO
SCORE=0
CALL IO(A, B, X, Y, RES)
RES=EVALUATE(-1, 10000)
A=BESTA(1); B=BESTB(1); X=BESTX(1); Y=BESTY(1)
END DO
END PROGRAM CHESS
! figure out if white is in check
FUNCTION INCHECK()
USE GLOBALS
IMPLICIT INTEGER (A-Z)
DIMENSION XX(0:26), YY(0:26), CC(0:26)
DO B = 0, 7
DO A = 0, 7
IF (BOARD(B, A)>=0) CYCLE
CALL MOVELIST(A, B, XX, YY, CC, NDX)
! iterate through move list and see if
! piece can get to king
DO I = 0, NDX, 1
X = XX(I)
Y = YY(I)
IF (BOARD(Y, X) == 5000) THEN
INCHECK = 1
RETURN
END IF
END DO
END DO
END DO
INCHECK = 0
RETURN
END FUNCTION INCHECK
RECURSIVE FUNCTION EVALUATE (ID, PRUNE) RESULT (RES)
USE GLOBALS
IMPLICIT INTEGER(A-Z)
DIMENSION XX(0:26), YY(0:26), CC(0:26)
LEVEL=LEVEL+1
BESTSCORE=10000*ID
DO B=7,0, -1
DO A=7,0, -1
! generate the moves for all the pieces
! and iterate through them
IF (SGN(BOARD(B,A))/=ID) CYCLE
CALL MOVELIST (A, B, XX, YY, CC, NDX)
DO I=0,NDX,1
X=XX(I); Y=YY(I); C=CC(I)
OLDSCORE=SCORE; MOVER=BOARD(B,A); TARG=BOARD(Y,X)
! make the move and evaluate the new position
! recursively. Targ holds the relative value of the piece
! allowing use to calculate material gain/loss
CALL MAKEMOVE (A, B, X, Y, C)
IF (LEVEL<MAXLEVEL) THEN
SCORE=SCORE+EVALUATE(-ID, &
BESTSCORE-TARG+ID*(8-ABS(4-X)-ABS(4-Y)))
END IF
SCORE=SCORE+TARG-ID*(8-ABS(4-X)-ABS(4-Y))
! we want to minimize the maximum possible loss
! for black
IF ((ID<0 .AND. SCORE>BESTSCORE) .OR. &
(ID>0 .AND. SCORE<BESTSCORE)) THEN
BESTA(LEVEL)=A; BESTB(LEVEL)=B
BESTX(LEVEL)=X; BESTY(LEVEL)=Y
BESTSCORE=SCORE
IF ((ID<0 .AND. BESTSCORE>=PRUNE) .OR. &
(ID>0 .AND. BESTSCORE<=PRUNE)) THEN
BOARD(B,A)=MOVER; BOARD(Y,X)=TARG; SCORE=OLDSCORE
LEVEL=LEVEL-1
RES = BESTSCORE
RETURN
END IF
END IF
BOARD(B,A)=MOVER; BOARD(Y,X)=TARG; SCORE=OLDSCORE
END DO
END DO
END DO
LEVEL=LEVEL-1
RES=BESTSCORE
RETURN
END FUNCTION EVALUATE
! make a move given the start square and end square
! currently always promotes to queen
SUBROUTINE MAKEMOVE (A, B, X, Y, C)
USE GLOBALS
IMPLICIT INTEGER (A-Z)
BOARD(Y, X)=BOARD(B, A); BOARD(B, A)=0
IF (Y == 0 .AND. BOARD(Y, X) == 100) BOARD(Y, X)= C
IF (Y == 7 .AND. BOARD(Y, X) == -100) BOARD(Y, X)= C
RETURN
END SUBROUTINE MAKEMOVE
! select appropriate subprogram to populate xx and yy arrays
! with piece moves
SUBROUTINE MOVELIST (A, B, XX, YY, CC, NDX)
USE GLOBALS
IMPLICIT INTEGER (A-Z)
DIMENSION XX(0:26), YY(0:26), CC(0:26)
PIECE=ABS(BOARD(B, A)); NDX=-1
SELECT CASE (PIECE)
CASE (100)
CALL PAWN(A, B, XX, YY, CC, NDX)
CASE (270)
CALL KNIGHT(A, B, XX, YY, NDX)
CASE (300)
CALL BISHOP(A, B, XX, YY, NDX)
CASE (500)
CALL ROOK(A, B, XX, YY, NDX)
CASE (900)
CALL QUEEN(A, B, XX, YY, NDX)
CASE DEFAULT
CALL KING(A, B, XX, YY, NDX)
END SELECT
RETURN
END SUBROUTINE MOVELIST
! queen is a combination of rook and bishop
SUBROUTINE QUEEN (A, B, XX, YY, NDX)
USE GLOBALS
IMPLICIT INTEGER (A-Z)
DIMENSION XX(0:26), YY(0:26)
CALL ROOK(A, B, XX, YY, NDX)
CALL BISHOP(A, B, XX, YY, NDX)
RETURN
END SUBROUTINE QUEEN
SUBROUTINE KING (A, B, XX, YY, NDX)
USE GLOBALS
IMPLICIT INTEGER (A-Z)
DIMENSION XX(0:26), YY(0:26)
ID=SGN(BOARD(B, A))
! negative = left or up
! positive = right or down
! zero = no change
DO DY=-1, 1
IF (B+DY<0 .OR. B+DY>7) CYCLE
DO DX=-1, 1
IF (A+DX<0 .OR. A+DX>7) CYCLE
IF (ID/=SGN(BOARD(B+DY,A+DX))) THEN
NDX=NDX+1; XX(NDX)=A+DX; YY(NDX)=B+DY
END IF
END DO
END DO
RETURN
END SUBROUTINE KING
SUBROUTINE PAWN (A, B, XX, YY, CC, NDX)
USE GLOBALS
IMPLICIT INTEGER (A-Z)
DIMENSION XX(0:26), YY(0:26), CC(0:26)
ID = SGN(BOARD(B, A))
IF (((A - 1) >= 0) .AND. ((A - 1) <= 7) .AND. &
((B - ID) >= 0) .AND. ((B - ID) <= 7)) THEN
IF (SGN(BOARD((B - ID), (A - 1))) == -ID) THEN
IF (((ID<0) .AND. (B == 6)) .OR. ((ID>0) .AND. &
(B == 1))) THEN
CC(NDX+1) = 270*ID
CC(NDX+2) = 300*ID
CC(NDX+3) = 500*ID
CC(NDX+4) = 900*ID
DO I=1, 4
NDX = NDX + 1
XX(NDX) = A - 1
YY(NDX) = B - ID
END DO
ELSE
NDX = NDX + 1
XX(NDX) = A - 1
YY(NDX) = B - ID
END IF
END IF
END IF
IF (((A + 1) >= 0) .AND. ((A + 1) <= 7) .AND. ((B - ID) >= 0) &
.AND. ((B - ID) <= 7)) THEN
IF (SGN(BOARD((B - ID), (A + 1))) == -ID) THEN
IF (((ID<0) .AND. (B == 6)) .OR. ((ID>0) .AND. &
(B == 1))) THEN
CC(NDX+1) = 270*ID
CC(NDX+2) = 300*ID
CC(NDX+3) = 500*ID
CC(NDX+4) = 900*ID
DO I=1, 4
NDX = NDX + 1
XX(NDX) = A + 1
YY(NDX) = B - ID
END DO
ELSE
NDX = NDX + 1
XX(NDX) = A + 1
YY(NDX) = B - ID
END IF
END IF
END IF
IF ((A >= 0) .AND. (A <= 7) .AND. ((B - ID) >= 0) .AND. &
((B - ID) <= 7)) THEN
IF (BOARD((B - ID), A) == 0) THEN
IF (((ID<0) .AND. (B == 6)) .OR. ((ID>0) .AND. &
(B == 1))) THEN
CC(NDX+1) = 270*ID
CC(NDX+2) = 300*ID
CC(NDX+3) = 500*ID
CC(NDX+4) = 900*ID
DO I=1, 4
NDX = NDX + 1
XX(NDX) = A
YY(NDX) = B - ID
END DO
ELSE
NDX = NDX + 1
XX(NDX) = A
YY(NDX) = B - ID
END IF
IF (((ID < 0) .AND. (B == 1)) .OR. ((ID > 0) .AND. &
(B == 6))) THEN
IF (BOARD((B - ID - ID), A) == 0) THEN
NDX = NDX + 1
XX(NDX) = A
YY(NDX) = B - ID - ID
END IF
END IF
END IF
END IF
END SUBROUTINE PAWN
SUBROUTINE BISHOP (A, B, XX, YY, NDX)
USE GLOBALS
IMPLICIT INTEGER (A-Z)
DIMENSION XX(0:26), YY(0:26)
END SUBROUTINE BISHOP
SUBROUTINE ROOK (A, B, XX, YY, NDX)
USE GLOBALS
IMPLICIT INTEGER (A-Z)
DIMENSION XX(0:26), YY(0:26)
END SUBROUTINE ROOK
SUBROUTINE KNIGHT (A, B, XX, YY, NDX)
USE GLOBALS
IMPLICIT INTEGER (A-Z)
DIMENSION XX(0:26), YY(0:26)
IF (X>=0 .AND. Y<=7) THEN
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
END IF
X=A-1; Y=B+1
IF (X>=0 .AND. Y<=7) THEN
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
END IF
X=A+1; Y=B+2
IF (X<=7 .AND. Y<=7) THEN
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
END IF
X=A+2; Y=B+1
IF (X<=7 .AND. Y<=7) THEN
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
END IF
RETURN
END SUBROUTINE KNIGHT
SUBROUTINE SHOW
USE GLOBALS
IMPLICIT INTEGER (A-Z)
DO B=0, 7
WRITE (*, '(A)') ' +---+---+---+---+---+---+---+---+'
WRITE (*, '(A)', ADVANCE='NO') ACHAR(56-B) // ' |'
DO A=0, 7
SELECT CASE (BOARD(B, A))
CASE (-7500)
WRITE (*, '(A)', ADVANCE='NO') ' *k|'
CASE (-900)
WRITE (*, '(A)', ADVANCE='NO') ' *q|'
CASE (-500)
WRITE (*, '(A)', ADVANCE='NO') ' *r|'
CASE (-300)
WRITE (*, '(A)', ADVANCE='NO') ' *b|'
CASE (-270)
WRITE (*, '(A)', ADVANCE='NO') ' *n|'
CASE (-100)
WRITE (*, '(A)', ADVANCE='NO') ' *p|'
CASE (-0)
WRITE (*, '(A)', ADVANCE='NO') ' |'
CASE (100)
WRITE (*, '(A)', ADVANCE='NO') ' P |'
CASE (270)
WRITE (*, '(A)', ADVANCE='NO') ' N |'
CASE (300)
WRITE (*, '(A)', ADVANCE='NO') ' B |'
CASE (500)
WRITE (*, '(A)', ADVANCE='NO') ' R |'
CASE (900)
WRITE (*, '(A)', ADVANCE='NO') ' Q |'
CASE (5000)
WRITE (*, '(A)', ADVANCE='NO') ' K |'
END SELECT
END DO
WRITE (*, *) ''
END DO
WRITE (*, '(A)') ' +---+---+---+---+---+---+---+---+'
WRITE (*, '(A)') ' A B C D E F G H'
RETURN
END SUBROUTINE SHOW
SUBROUTINE IO (A, B, X, Y, RES)
USE GLOBALS
IMPLICIT INTEGER (A-Z)
CHARACTER (LEN=10) INPUT
LOGICAL WCKSOLD, WCQSOLD
DIMENSION XX(0:26), YY(0:26), CC(0:26)
IF (A>=0) THEN
IF (RES<-2500) THEN
PRINT *, 'I RESIGN'
CALL SHOW
WRITE (*, *)
STOP
END IF
PIECE=BOARD(Y, X)
CALL MAKEMOVE(A, B, X, Y)
WRITE (*, '(A)', ADVANCE='NO') 'MY MOVE: '
WRITE (*, '(A)') ACHAR(65+A) // ACHAR(56-B) // '-' // ACHAR(65+X) //
&
ACHAR(56-Y)
SELECT CASE (PIECE)
CASE (100)
PRINT *, 'I TOOK YOUR PAWN'
CASE (270)
PRINT *, 'I TOOK YOUR KNIGHT'
CASE (300)
PRINT *, 'I TOOK YOUR BISHOP'
CASE (500)
PRINT *, 'I TOOK YOUR ROOK'
CASE (900)
PRINT *, 'I TOOK YOUR QUEEN'
CASE (5000)
PRINT *, 'I TOOK YOUR KING'
END SELECT
END IF
DO
CALL SHOW
WRITE (*, '(A)', ADVANCE='NO') 'YOUR MOVE: '
READ (*, *) INPUT
CALL UPCASE(INPUT)
IF ((INPUT == 'QUIT') .OR. (INPUT == 'BYE') .OR. (INPUT == 'EXIT'))
THEN
STOP
END IF
IF ((INPUT == 'O-O') .OR. (INPUT == '0-0')) THEN
IF (INCHECK() /= 0) CYCLE ! cannot castle out of check
IF (WCKSFLAG) CYCLE
IF (BOARD(7, 7) /= 500) CYCLE
IF ((BOARD (7,6) /= 0) .OR. (BOARD(7,5) /=0)) CYCLE
BOARD(7, 4) = 0
BOARD(7, 5) = 5000
IF (INCHECK() /= 0) THEN ! cannot castle through check
BOARD(7, 4) = 5000
BOARD(7, 5) = 0
CYCLE
ELSE
BOARD(7, 4) = 5000
BOARD(7, 5) = 0
END IF
BOARD(7, 6) = 5000
BOARD(7, 4) = 0
BOARD(7, 5) = 500
BOARD(7, 7) = 0
IF (INCHECK() /= 0) THEN ! cannot castle into check
BOARD(7, 6) = 0
BOARD(7, 4) = 5000
BOARD(7, 5) = 0
BOARD(7, 7) = 500
CYCLE
ELSE
WCKSFLAG = .TRUE.
WCQSFLAG = .TRUE.
RETURN
END IF
END IF
IF ((INPUT == 'O-O-O') .OR. (INPUT == '0-0-0')) THEN
IF (INCHECK() /= 0) CYCLE ! cannot castle out of check
IF (WCQSFLAG) CYCLE
IF (BOARD(7,0) /= 500) CYCLE
IF ((BOARD(7,1) /= 0) .OR. (BOARD(7,2) /= 0) .OR. &
(BOARD(7,3) /= 0)) CYCLE
BOARD(7, 4) = 0
BOARD(7, 3) = 5000
IF (INCHECK() /= 0) THEN ! cannot castle through check
BOARD(7, 4) = 5000
BOARD(7, 3) = 0
CYCLE
ELSE
BOARD(7, 4) = 5000
BOARD(7, 3) = 0
END IF
BOARD(7, 2) = 5000
BOARD(7, 4) = 0
BOARD(7, 3) = 500
BOARD(7, 0) = 0
IF (INCHECK() /= 0) THEN ! cannot castle into check
BOARD(7, 2) = 0
BOARD(7, 4) = 5000
BOARD(7, 3) = 0
BOARD(7, 0) = 500
CYCLE
ELSE
WCKSFLAG = .TRUE.
WCQSFLAG = .TRUE.
RETURN
END IF
END IF
B = 8 - (IACHAR(INPUT(2:2)) - 48)
A = IACHAR(INPUT(1:1)) - 65
X = IACHAR(INPUT(4:4)) - 65
Y = 8 - (IACHAR(INPUT(5:5)) - 48)
IF ((B>7) .OR. (B<0) .OR. (A>7) .OR. (A<0) .OR. (X>7) .OR. (X<0) .OR.
&
(Y>7) .OR. (Y<0)) CYCLE
IF (BOARD(B,A)<=0) CYCLE
IF ((Y == 2) .AND. (B == 3) .AND. ((X == A-1) .OR. (X == A+1))) THEN
IF ((BOARD(B,A) == 100) .AND. (BOARD(Y,X) == 0) &
.AND. (BOARD(Y+1,X) ==-100)) THEN
IF ((BESTB(1) == 1) .AND. (BESTA(1) == X)) THEN
MOVER = BOARD(B,A)
TARGET = BOARD(Y,X)
CALL MAKEMOVE(A,B,X,Y,C)
IF ((INCHECK()) == 0) RETURN
BOARD(B,A) = MOVER
BOARD(Y, X) = TARGET
BOARD(Y+1,X) = -100
CYCLE
END IF
END IF
END IF
! check if selected white move is on list of moves
CALL MOVELIST(A, B, XX, YY, CC, NDX)
DO K = 0, NDX, 1
IF ((X == XX(K)) .AND. (Y == YY(K))) THEN
MOVER = BOARD(B, A)
TARG = BOARD(Y, X)
IF (Y == 0) THEN
WRITE (*, '(A)', ADVANCE='NO') 'PROMOTION PIECE: '
READ (*, *) INPUT
CALL UPCASE(INPUT)
DO
SELECT CASE (INPUT)
CASE ('P', 'PAWN')
C = 100
CASE ('N', 'KT', 'KNIGHT', 'HORSE')
C = 270
CASE ('B', 'BISHOP')
C = 500
CASE ('Q', 'QUEEN')
C = 900
CASE DEFAULT
CYCLE
END SELECT
EXIT
END DO
END IF
CALL MAKEMOVE(A, B, X, Y, C)
IF (MOVER == 5000) THEN
WCQSOLD = WCQSFLAG
WCKSOLD = WCKSFLAG
WCKSFLAG = .TRUE.
WCQSFLAG = .TRUE.
END IF
IF ((A == 0) .AND. (B == 7) .AND. (MOVER == 500)) THEN
WCQSOLD = WCQSFLAG
WCQSFLAG = .TRUE.
END IF
IF ((A == 7) .AND. (B == 7) .AND. (MOVER == 500)) THEN
WCKSOLD = WCKSFLAG
WCKSFLAG = .TRUE.
END IF
IF (INCHECK() == 0) RETURN
BOARD(B, A) = MOVER
BOARD(Y, X) = TARG
IF (MOVER == 5000) THEN
WCQSFLAG = WCQSOLD
WCKSFLAG = WCKSOLD
END IF
IF ((A == 0) .AND. (B == 7) .AND. (MOVER == 500)) THEN
WCQSFLAG = WCQSOLD
END IF
IF ((A == 7) .AND. (B == 7) .AND. (MOVER == 500)) THEN
WCKSFLAG = WCKSOLD
END IF
EXIT
END IF
END DO
END DO
END SUBROUTINE IO
! get sign of number. a piece's
! represents it's piece color
FUNCTION SGN(N)
USE GLOBALS
IMPLICIT INTEGER (A-Z)
IF (N < 0) THEN
SGN = -1
ELSE IF (N == 0) THEN
SGN = 0
ELSE
SGN = 1
END IF
END FUNCTION SGN
! convert string to uppercase
SUBROUTINE UPCASE (STRING)
USE GLOBALS
IMPLICIT INTEGER (A-Z)
CHARACTER (LEN = *) STRING
LS = LEN(STRING)
DO LC = 1, LS
IF (LGE(STRING(LC:LC), 'a') .AND. LLE(STRING(LC:LC), 'z')) THEN
STRING(LC:LC) = ACHAR(IACHAR(STRING(LC:LC))-32)
END IF
END DO
RETURN
END SUBROUTINE UPCASE
robin
news:alpine.WNT.1.10.0805251650080.8396@DEANSIM1...
>
> On Sun, 25 May 2008, robin wrote:
>
> > 5. The knight behaves as if it were a pawn when doing captures.
> >
> > It would be good to include some comment documentation.
> >
> I was unable to see the knight capturing as a pawn. I was able to use
> the knight to capture normally as a knight and was not able to use the
> knight to capture as a pawn. Can you give a list of moves?
> Here is the program with the other bugs you mentioned fixed:
Dean,
Thanks.
However, the new code has at least one new bug -
in line 446, the call to MAKEMOVE has too few arguments.
The variable CFLAG is given a value, but never used.
The bug with the Knight capturing as if it were a pawn
is still present.
The computer's moves are quite different from the
previous version of CHESS, so it takes longer to arrive at a
position where the Knight captures as if it were a pawn. Here
are the moves:
e2-e4
g1-f3
f3-f5
d1-e2
b1-c3
c1-d2
At this point, the program responds by the knight capturing my
knight in the adjacent diagonal square.
robin
There also is a problem with capturing a pawn en passant.
White's move for the pawn is carried out (the computer permits
the diagonal move, but then fails to remove from the board
the black pawn that white captured en passant).
BTW, the new board display is a big improvement.
dean.m...@gmail.com
> "Dean Menezes" <dean.mene...@yahoo.com> wrote in message
I found the bug. There was a typo here:
X=A-1; Y=B+1
IF (X>=0 .AND. Y<=7) THEN
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
END IF
That would make the knight move 1 square left and 1 square down, i.e.,
1 square diagonally. One of the 1's should be a 2 so that it will
move like a knight.
samand...@yahoo.com
! xx = x coordinates
! yy = y coordinates
! cc = pawn promotion if applicable
! ndx = index into xx, yy, cc arrays showing the number of
! elements that the arrays have been populated with
! four diagonal directions
DO DXY=1, 7
X=A-DXY; IF (X<0) EXIT
Y=B+DXY; IF (Y>7) EXIT
IF (ID/=SGN(BOARD(Y, X))) THEN ! cannot capture piece of same color
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
IF (BOARD(Y, X)/=0) EXIT ! cannot jump over pieces
END DO
DO DXY=1, 7
X=A+DXY; IF (X>7) EXIT
Y=B+DXY; IF (Y>7) EXIT
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
IF (BOARD(Y, X)/=0) EXIT
END DO
DO DXY=1, 7
X=A-DXY; IF (X<0) EXIT
Y=B-DXY; IF (Y<0) EXIT
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
IF (BOARD(Y, X)/=0) EXIT
END DO
DO DXY=1, 7
X=A+DXY; IF (X>7) EXIT
Y=B-DXY; IF (Y<0) EXIT
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
IF (BOARD(Y, X)/=0) EXIT
END DO
END SUBROUTINE BISHOP
SUBROUTINE ROOK (A, B, XX, YY, NDX)
USE GLOBALS
IMPLICIT INTEGER (A-Z)
DIMENSION XX(0:26), YY(0:26)
ID=SGN(BOARD(B, A))
! four different orthagonal directions
! 2 vertical, 1 horizontal
! or 2 horizontal, 1 vertical
X=A-1; Y=B-2
IF (X>=0 .AND. Y>=0) THEN
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
END IF
X=A-2; Y=B-1
IF (X>=0 .AND. Y>=0) THEN
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
END IF
X=A+1; Y=B-2
IF (X<=7 .AND. Y>=0) THEN
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
END IF
X=A+2; Y=B-1
IF (X<=7 .AND. Y>=0) THEN
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
END IF
X=A-1; Y=B+2
IF (X>=0 .AND. Y<=7) THEN
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
END IF
X=A-2; Y=B+1
IF (X>=0 .AND. Y<=7) THEN
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
END IF
X=A+1; Y=B+2
IF (X<=7 .AND. Y<=7) THEN
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
END IF
X=A+2; Y=B+1
IF (X<=7 .AND. Y<=7) THEN
IF (ID/=SGN(BOARD(Y, X))) THEN
NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y
END IF
END IF
RETURN
END SUBROUTINE KNIGHT
! display chessboard
! io -- input/output:
! display black move and get white move
SUBROUTINE IO (A, B, X, Y, RES)
USE GLOBALS
IMPLICIT INTEGER (A-Z)
CHARACTER (LEN=10) INPUT
LOGICAL WCKSOLD, WCQSOLD
DIMENSION XX(0:26), YY(0:26), CC(0:26)
IF (A>=0) THEN
IF (RES<-2500) THEN
PRINT *, 'I RESIGN'
CALL SHOW
WRITE (*, *)
STOP
END IF
PIECE=BOARD(Y, X)
CALL MAKEMOVE(A, B, X, Y, C)
! castling
! en passant capture
IF ((Y == 2) .AND. (B == 3) .AND. ((X == A-1) .OR. (X == A+1))) THEN
IF ((BOARD(B,A) == 100) .AND. (BOARD(Y,X) == 0) &
.AND. (BOARD(Y+1,X) ==-100)) THEN
IF ((BESTB(1) == 1) .AND. (BESTA(1) == X)) THEN
MOVER = BOARD(B,A)
TARG = BOARD(Y,X)
CALL MAKEMOVE(A,B,X,Y,C)
BOARD(Y+1,X)=0
IF ((INCHECK()) == 0) RETURN
BOARD(B,A) = MOVER
BOARD(Y, X) = TARG
John
> IF (Y == 0) THEN
> WRITE (*, '(A)', ADVANCE='NO') 'PROMOTION PIECE: '
> READ (*, *) INPUT
> CALL UPCASE(INPUT)
> DO
> SELECT CASE (INPUT)
> CASE ('P', 'PAWN')
> C = 100
> CASE ('N', 'KT', 'KNIGHT', 'HORSE')
> C = 270
> CASE ('B', 'BISHOP')
> C = 500
> CASE ('Q', 'QUEEN')
> C = 900
> CASE DEFAULT
> CYCLE
> END SELECT
> EXIT
> END DO
> END IF
In the IO subroutine, isn't the DO loop around the pawn promotion in the
wrong place? I think it should probably be above the
WRITE (*, '(A)', ADVANCE='NO') 'PROMOTION PIECE: '
statement so that the cycle statement for an invalid input will result
in another read. Also, I think the case ('P','PAWN') should be case
('R', 'ROOK').
John
John Harper
>
> > SELECT CASE (INPUT)
> > CASE ('P', 'PAWN')
> > C = 100
> > CASE ('N', 'KT', 'KNIGHT', 'HORSE')
> > C = 270
> > CASE ('B', 'BISHOP')
> > C = 500
> > CASE ('Q', 'QUEEN')
> > C = 900
> > CASE DEFAULT
> > CYCLE
> > END SELECT
>Also, I think the case ('P','PAWN') should be case ('R', 'ROOK').
John correctly pointed out that that SELECT CASE needs fixing but
IMHO his fix gives wrong C values for 'R' and 'B'. I suggest
SELECT CASE (INPUT)
CASE ('N', 'KT', 'KNIGHT', 'HORSE')
C = 270
CASE ('B', 'BISHOP')
C = 300
CASE ('R', 'ROOK')
C = 500
CASE ('Q', 'QUEEN')
C = 900
CASE DEFAULT
CYCLE
END SELECT
-- John Harper, School of Mathematics, Statistics and Computer Science,
Victoria University, PO Box 600, Wellington 6140, New Zealand
e-mail john....@vuw.ac.nz phone (+64)(4)463 6780 fax (+64)(4)463 5045
dean.m...@gmail.com
Yes. the new code is at this URL:
http://samanddeanus.no-ip.org/chess.f90
A windows exe is here:
robin
news:b66ee54c-af80-4579...@l64g2000hse.googlegroups.com...
> > In the IO subroutine, isn't the DO loop around the pawn promotion in the
> > wrong place? I think it should probably be above the WRITE statement
>
> Yes. the new code is at this URL:
>
> http://samanddeanus.no-ip.org/chess.f90
Dean,
It plays a good game now. Congratulations.
fj
> <dean.mene...@gmail.com> wrote in message
Sorry but castling does not seem to work ... (I tried to move the King
as it is usual to do)
dean.m...@gmail.com
queenside. You can use zeroes, capital letters, or lowercase letters.
fj
Thank you. You program is remarkably short !
James Van Buskirk
news:b66ee54c-af80-4579...@l64g2000hse.googlegroups.com...
> Yes. the new code is at this URL:
> http://samanddeanus.no-ip.org/chess.f90
I couldn't resist trying out the program. It grabbed material,
spurned development, and had incredible fighting spirit, playing on
even in the face of checkmate! In short, a very entertaining
program:
1. e2-e4 e7-e5
2. f2-f4 e5-f4 I TOOK YOUR PAWN
3. g1-f3 d7-d5
4. e4-d5 c8-g4
5. f1-c4 d8-e7
6. e1-f2 e7-c5
7. d2-d4 c5-c4 I TOOK YOUR BISHOP
8. h1-e1 e8-d8
9. b1-c3 g7-g5
10. c3-e4 c4-d5 I TOOK YOUR PAWN
11. e4-g5 f7-f6
12. d1-e2 g4-d7
13. c2-c4 d5-a5
14. g5-f7 d8-c8
15. f7-h8 PROMOTION PIECE: Q
15. ... f8-b4
16. c1-d2 c7-c5
17. h8-f7 b4-d2 I TOOK YOUR BISHOP
18. e2-d2 a5-c7
19. d4-d5 b7-b5
20. e1-e4 f6-f5
21. e4-e2 g8-f6
22. d5-d6 f6-g4
23. f2-g1 c7-c6
24. d2-f4 b5-c4 I TOOK YOUR PAWN
25. a1-c1 c4-c3
26. c1-c3 c6-d5
27. f3-e5 d5-d1
28. f4-f1 d1-d4
29. g1-h1 g4-e5 I TOOK YOUR KNIGHT
30. e2-e5 d7-c6
31. e5-c5 f5-f4
32. f7-e5 f4-f3
33. e5-c6 b8-c6 I TOOK YOUR KNIGHT
34. c5-c6 c8-d7
35. f1-f3 d4-e5
36. f3-f7 d7-d8
37. c6-c8 PROMOTION PIECE: Q
37. ... a8-c8 I TOOK YOUR ROOK
38. c3-c8 PROMOTION PIECE: Q
38. ... d8-c8 I TOOK YOUR ROOK
39. f7-c7 c8-c7 I TOOK YOUR QUEEN
40. d6-c7 e5-e1 still fighting :)
--
write(*,*) transfer((/17.392111325966148d0,6.5794487871554595D-85, &
6.0134700243160014d-154/),(/'x'/)); end
Beliavsky
> <dean.mene...@gmail.com> wrote in message
>
> news:b66ee54c-af80-4579...@l64g2000hse.googlegroups.com...
>
> > Yes. the new code is at this URL:
> >http://samanddeanus.no-ip.org/chess.f90
>
> I couldn't resist trying out the program. It grabbed material,
> spurned development, and had incredible fighting spirit, playing on
> even in the face of checkmate! In short, a very entertaining
> program:
>
> 1. e2-e4 e7-e5
> 2. f2-f4 e5-f4 I TOOK YOUR PAWN
> 3. g1-f3 d7-d5
> 4. e4-d5 c8-g4
> 5. f1-c4 d8-e7
> 6. e1-f2 e7-c5
> 7. d2-d4 c5-c4 I TOOK YOUR BISHOP
> 8. h1-e1 e8-d8
> 9. b1-c3 g7-g5
> 10. c3-e4 c4-d5 I TOOK YOUR PAWN
> 11. e4-g5 f7-f6
> 12. d1-e2 g4-d7
> 13. c2-c4 d5-a5
> 14. g5-f7 d8-c8
> 15. f7-h8 PROMOTION PIECE: Q
The comment "PROMOTION PIECE: Q" makes no sense. A knight was moved,
and only pawns can be promoted.
e p chandler
The program asks anyway, even when the piece that reaches the 8th rank
is NOT a pawn. I suspect that JVB captured his screens to a file and
condensed them into chess notation from there.
Note that in move 39 black is checkmated - a pawn-queen checkmate, but
the king moves anyway and takes the attacking queen which is protected
by the advanced pawn. The program allows white to take the king with
that pawn. Even without the king on the chessboard, the "zombile"
program checkmates white's trapped king. This is the threatened move
that JVB has been parrying at the end.
I repeat my earlier suggestion that the OP deal more effectively with
check and checkmate.
- e
dean.m...@gmail.com
>
> I repeat my earlier suggestion that the OP deal more effectively with
> check and checkmate.
OK, I fixed the pawn promotion IF statement to make sure the moving
piece is a pawn. I also made the EVALUATE statement recognize
checkmate and stalemate. I have it on my website at the same address:
http://samanddeanus.no-ip.org/chess.f90
and a Windows EXE:
Beliavsky
Thanks. The most interesting part of a chess program IMO is the
algorithm to evaluate positions at the end of move trees. Looking at
the code, it seems your program considers only material advantage and
checkmate in judging positions. Is that right?
Below is a game I won against your program. It could play better if it
had an opening book. Even without an opening book, the move 3 ... f6-
f4 is surprising, since it does not attack anything and exposes the
queen to attack.
It would be a nice feature if at the end of the game the program
offered to to write the moves of the game to a file, so that it could
be reviewed later.
1. e2-e4 e7-e5
2. g1-f3 d8-f6
3. b1-c3 f6-f4
4. d2-d4 f4-g4
5. h2-h3 g4-e6
6. f3-e5 f8-b4
7. f1-c4 d7-d5
8. c4-d5 b4-c3
9. b2-c3 e6-f6
10. e5-f7 c7-c6
11. d5-b3 g7-g6
12. e4-e5 f6-g7
13. d1-f3 c8-f5
14. g2-g4 f5-c2
15. f7-d6 e8-d8
16. c1-g5 d8-d7
17. e5-e6 d7-c7
18. d6-e8 c7-b6
19. g5-d8 b6-a6
20. e8-g7 g8-h6
21. e6-e7 h6-g4
22. h3-g4 b7-b5
23. g7-e6 a6-b7
24. e6-c5 b7-c8
25. b3-e6 resigns
James Van Buskirk
news:f39670e5-233f-4588...@l17g2000pri.googlegroups.com...
On Jun 3, 10:27 am, dean.mene...@gmail.com wrote:
> > OK, I fixed the pawn promotion IF statement to make sure the moving
> > piece is a pawn. I also made the EVALUATE statement recognize
> > checkmate and stalemate. I have it on my website at the same address:
> > http://samanddeanus.no-ip.org/chess.f90
> Thanks. The most interesting part of a chess program IMO is the
> algorithm to evaluate positions at the end of move trees. Looking at
> the code, it seems your program considers only material advantage and
> checkmate in judging positions. Is that right?
> Below is a game I won against your program. It could play better if it
> had an opening book. Even without an opening book, the move 3 ... f6-
> f4 is surprising, since it does not attack anything and exposes the
> queen to attack.
I have seen many chess programs that move the queen all over the
place. Sometimes in doing so they will make surprising good
moves.
> It would be a nice feature if at the end of the game the program
> offered to to write the moves of the game to a file, so that it could
> be reviewed later.
At least in the Windows version after the game is over you can
start a new game and then get the moves from the old game from the
input buffer by hitting the up arrow key, unless the game lasted a
long time, in which case the input buffer may be incomplete.
The new version does seem to play a little better than the old one,
if a little slower. As an example, after:
1. e2-e4 e7-e5
2. g1-f3 d8-f6
3. f3-e5 f6-e5
4. b1-c3
The old version played:
4. ... e5-d4
5. f1-e2 f7-f5
6. O-O f5-e4
7. c3-e4 d4-e4
8. f1-e1 e4-d4
9. e2-h5 e8-d8
10. e1-e8 1-0
But the new version now plays:
4. ... c7-c5
5. f1-c4 e5-d4
6. d1-e2 g7-g5
7. d2-d3 d4-e5
8. e2-h5 e5-f6
9. c1-g5 f6-g7
10. O-O-O f8-d6
11. e4-e5 d6-e5
12. h1-e1 g8-e7
13. g5-e7 e5-f4
14. c1-b1 g7-g6
15. e7-f6 f4-e3
16. h5-e5 1-0
So it is lasting almost twice as long as before considering that
there are still two moves left to mate in the second game. It's a
lot harder to win quickly given that the program can always see a
mate in two.