The QBasic / QB64 Discussion Forum      Other Subforums, Links and Downloads
 
 

 Return to Index  

This should give you a fighting chance.

January 6 2007 at 2:13 PM
Pete  (no login)


Response to Re: Chess Program Version -1

 
It looks like from the data you provided in your last post that my assumption of the board consturction and colors were correct. I used the math function I posted earlier and correct a reversed variable in a sub. Find the multiple '''' marks to see those corrections. Here is the code that at least gets white pieces moving. You have a lot of work to go.

--------------------------------------------------------------------------

DECLARE SUB SQUARE (A, B, C)
DECLARE SUB SHOWMAN (A, B, FLAG)
DECLARE SUB SHOW ()
DECLARE SUB IO (A, B, X, Y, RESULT)
DECLARE FUNCTION INCHECK (X)
DECLARE SUB MAKEMOVE (A, B, X, Y)
DECLARE SUB KNIGHT (A, B, XX(), YY(), NDX)
DECLARE SUB KING (A, B, XX(), YY(), NDX)
DECLARE SUB QUEEN (A, B, XX(), YY(), NDX)
DECLARE SUB ROOK (A, B, XX(), YY(), NDX)
DECLARE SUB BISHOP (A, B, XX(), YY(), NDX)
DECLARE SUB MOVELIST (A, B, XX(), YY(), NDX)
DECLARE SUB PAWN (A, B, XX(), YY(), NDX)
DECLARE FUNCTION EVALUATE (ID, PRUNE)
DIM SHARED BOARD(0 TO 7, 0 TO 7)
DIM SHARED BESTA(0 TO 7), BESTB(0 TO 7), BESTX(0 TO 7), BESTY(0 TO 7)
DIM SHARED LEVEL, MAXLEVEL, SCORE, CFLAG
CFLAG = 0
LEVEL = 0: MAXLEVEL = 5
DATA -500,-270,-300,-900,-7500,-300,-270,-500
DATA -100,-100,-100,-100, -100,-100,-100,-100
DATA    0,   0,   0,   0,    0,   0,   0,   0
DATA    0,   0,   0,   0,    0,   0,   0,   0
DATA    0,   0,   0,   0,    0,   0,   0,   0
DATA    0,   0,   0,   0,    0,   0,   0,   0
DATA  100, 100, 100, 100,  100, 100, 100, 100
DATA  500, 270, 300, 900, 5000, 300, 270, 500
FOR X = 0 TO 7
FOR Y = 0 TO 7
READ Z
BOARD(X, Y) = Z
NEXT Y
NEXT X
A = -1: RESULT = 0
DO
SCORE = 0
CALL IO(A, B, X, Y, RESULT)
CLS : CALL SHOW
RESULT = EVALUATE(-1, 10000)
A = BESTA(1): B = BESTB(1): X = BESTX(1): Y = BESTY(1)
LOOP

SUB BISHOP (A, B, XX(), YY(), NDX)
ID = SGN(BOARD(B, A))
FOR DXY = 1 TO 7
X = A - DXY: IF X < 0 THEN GOTO 3
Y = B + DXY: IF Y > 7 THEN GOTO 3
IF ID <> SGN(BOARD(Y, X)) THEN
NDX = NDX + 1: XX(NDX) = X: YY(NDX) = Y
END IF
IF BOARD(Y, X) <> 0 THEN GOTO 3
NEXT
3 REM
FOR DXY = 1 TO 7
X = A + DXY: IF X > 7 THEN GOTO 4
Y = B + DXY: IF Y > 7 THEN GOTO 4
IF ID <> SGN(BOARD(Y, X)) THEN
NDX = NDX + 1: XX(NDX) = X: YY(NDX) = Y
END IF
IF BOARD(Y, X) <> 0 THEN GOTO 4
NEXT
4 REM
FOR DXY = 1 TO 7
X = A - DXY: IF X < 0 THEN GOTO 5
Y = B - DXY: IF Y < 0 THEN GOTO 5
IF ID <> SGN(BOARD(Y, X)) THEN
NDX = NDX + 1: XX(NDX) = X: YY(NDX) = Y
END IF
IF BOARD(Y, X) <> 0 THEN GOTO 4
NEXT
5 REM
FOR DXY = 1 TO 7
X = A + DXY: IF X > 7 THEN GOTO 6
Y = B - DXY: IF Y < 0 THEN GOTO 6
IF ID <> SGN(BOARD(Y, X)) THEN
NDX = NDX + 1: XX(NDX) = X: YY(NDX) = Y
END IF
IF BOARD(Y, X) <> 0 THEN GOTO 6
NEXT
6 REM
END SUB

FUNCTION EVALUATE (ID, PRUNE)
DIM XX(27), YY(27)
LEVEL = LEVEL + 1
BESTSCORE = 1000 * ID
FOR B = 7 TO 0
FOR A = 7 TO 0
IF SGN(BOARD(B, A)) <> ID THEN GOTO 1
IF LEVEL = 1 THEN CALL SHOWMAN(A, B, 8)
CALL MOVELIST(A, B, XX(), YY(), NDX)
FOR I = 0 TO NDX
X = XX(I): Y = YY(I)
IF LEVEL = 1 THEN
LOCATE 1, 1
PRINT "TRYING:"; CHR$(65 + A); 8 - B; "-"; CHR$(65 + X); 8 - Y
CALL SHOWMAN(X, Y, 8)
END IF
OLDSCORE = SCORE: MOVER = BOARD(B, A): TARGET = BOARD(X, Y)
CALL MAKEMOVE(A, B, X, Y)
IF (LEVEL < MAXLEVEL) THEN SCORE = SCORE + EVALUATE(-ID, BESTSCORE - TARGET + ID * (8 - INT(ABS(4 - X)) - INT(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) = TARGET: SCORE = OLDSCORE
IF LEVEL = 1 THEN CALL SHOWMAN(X, Y, 0)
IF LEVEL = 1 THEN CALL SHOWMAN(A, B, 0)
LEVEL = LEVEL - 1
EVALUATE = BESTSCORE: GOTO 2
END IF
END IF
BOARD(B, A) = MOVER: BOARD(Y, X) = TARGET: SCORE = OLDSCORE
IF LEVEL = 1 THEN CALL SHOWMAN(X, Y, 0)
NEXT I
IF LEVEL = 1 THEN CALL SHOWMAN(A, B, 0)
1 NEXT A
NEXT B
LEVEL = LEVEL - 1
EVALUATE = BESTSCORE
2 REM
END FUNCTION

FUNCTION INCHECK (X)
DIM XX(27), YY(27), NDX
FOR B = 0 TO 7
FOR A = 0 TO 7
IF BOARD(B, A) >= 0 THEN GOTO 14
CALL MOVELIST(A, B, XX(), YY(), NDX)
FOR I = 0 TO NDX STEP 1
X = XX(I): Y = YY(I)
IF BOARD(Y, X) = 5000 THEN
PRINT "YOU ARE IN CHECK!"
PRINT "                    "
PRINT "                 "
INCHECK = 1
GOTO 14
END IF
NEXT
NEXT
NEXT
INCHECK = 0
14 REM
END FUNCTION

SUB IO (A, B, X, Y, RESULT)
DIM XX(0 TO 26), YY(0 TO 26)
CLS
IF A >= 0 THEN
IF RESULT < -2500 THEN
PRINT "I RESIGN"
SLEEP
SYSTEM
END IF
PIECE = BOARD(Y, X)
CALL MAKEMOVE(A, B, X, Y)
PRINT "MY MOVE: "; CHR$(65 + 1); 8 - B; "-"; CHR$(65 + X); 8 - Y
IF PIECE <> 0 THEN
PRINT "I TOOK YOUR ";
IF PIECE = 100 THEN PRINT "PAWN"
IF PIECE = 270 THEN PRINT "KNIGHT"
IF PIECE = 300 THEN PRINT "BISHOP"
IF PIECE = 500 THEN PRINT "ROOK"
IF PIECE = 900 THEN PRINT "QUEEN"
IF PIECE = 5000 THEN PRINT "KING"
END IF
NULL = INCHECK(0)
END IF
DO
CALL SHOW
LOCATE 24, 1: INPUT "YOUR MOVE: ", IN$
IF UCASE$(IN$) = "QUIT" THEN CLS : END
IF UCASE$(IN$) = "O-O" OR IN$ = "0-0" THEN
IF CFLAG <> 0 THEN GOTO 16
IF BOARD(7, 7) <> 500 THEN GOTO 16
IF BOARD(7, 6) <> 0 OR BOARD(7, 5) <> 0 THEN GOTO 16
BOARD(7, 6) = 5000
BOARD(7, 4) = 0
BOARD(7, 5) = 500
BOARD(7, 7) = 0
CFLAG = 1: GOTO 17
END IF
IF UCASE$(IN$) = "O-O-O" OR IN$ = "0-0-0" THEN
IF CFLAG <> 0 THEN GOTO 16
IF BOARD(7, 0) <> 500 THEN GOTO 16
IF BOARD(7, 1) <> 0 OR BOARD(7, 2) <> 0 OR BOARD(7, 3) <> 0 THEN GOTO 16
BOARD(7, 2) = 5000
BOARD(7, 4) = 0
BOARD(7, 3) = 500
BOARD(7, 0) = 0
CFLAG = 1: GOTO 17
END IF
IF LEN(IN$) < 5 THEN GOTO 16
B = 8 - (ASC(MID$(IN$, 2, 1)) - 48)
A = ASC(UCASE$(MID$(IN$, 1, 1))) - 65
X = ASC(UCASE$(MID$(IN$, 4, 1))) - 65
Y = 8 - (ASC(MID$(IN$, 5, 1)) - 48)
IF BOARD(B, A) <= 0 THEN GOTO 16
CALL MOVELIST(A, B, XX(), YY(), NDX)
FOR K = 0 TO NDX STEP 1
IF X = XX(K) AND Y = YY(K) THEN
MOVER = BOARD(B, A): TARGET = BOARD(Y, X)
CALL MAKEMOVE(A, B, X, Y)
LOCATE 1, 1: IF INCHECK(0) = 0 THEN GOTO 17
BOARD(B, A) = MOVER: BOARD(Y, X) = TARGET
GOTO 16
END IF
NEXT
16 CLS
LOOP
17 REM
END SUB

SUB KING (A, B, XX(), YY(), NDX)
ID = SGN(BOARD(B, A))
FOR DY = -1 TO 1
IF B + DY < 0 OR B + DY > Y THEN GOTO 12
FOR DX = -1 TO 1
IF A + DX < 0 OR A + DX > 7 THEN GOTO 11
IF ID <> SGN(BOARD(B + DY, A + DX)) THEN
NDX = NDX + 1: XX(NDX) = A + DX
YY(NDX) = B + DY
END IF
11 NEXT
12 NEXT
END SUB

SUB KNIGHT (A, B, XX(), YY(), NDX)
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 < 8 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 < 8 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 < 8 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 < 8 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 < 8 AND Y < 8 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 < 8 THEN
IF ID <> SGN(BOARD(Y, X)) THEN
NDX = NDX + 1: XX(NDX) = X: YY(NDX) = Y
END IF
END IF
END SUB

SUB MAKEMOVE (A, B, X, Y)
BOARD(Y, X) = BOARD(B, A): '''''''''''not a,b, b,a
BOARD(B, A) = 0: '''''''''''not a,b, b,a
IF Y = 0 AND BOARD(Y, X) = 100 THEN BOARD(Y, X) = 900
IF Y = 7 AND BOARD(Y, X) = -100 THEN BOARD(Y, X) = -900
END SUB

SUB MOVELIST (A, B, XX(), YY(), NDX)
PIECE = INT(ABS(BOARD(B, A))): NDX = -1
IF PIECE = 100 THEN
CALL PAWN(A, B, XX(), YY(), NDX)
ELSEIF PIECE = 270 THEN CALL KNIGHT(A, B, XX(), YY(), NDX)
ELSEIF PIECE = 300 THEN CALL BISHOP(A, B, XX(), YY(), NDX)
ELSEIF PIECE = 500 THEN CALL ROOK(A, B, XX(), YY(), NDX)
ELSEIF PIECE = 500 THEN CALL QUEEN(A, B, XX(), YY(), NDX)
ELSE CALL KING(A, B, XX(), YY(), NDX)
END IF

END SUB

SUB PAWN (A, B, XX(), YY(), NDX)
ID = SGN(BOARD(B, A))
IF A > 0 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 < 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 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 SUB

SUB QUEEN (A, B, XX(), YY(), NDX)
CALL BISHOP(A, B, XX(), YY(), NDX)
CALL ROOK(A, B, XX(), YY(), NDX)

END SUB

SUB ROOK (A, B, XX(), YY(), NDX)
ID = SGN(BOARD(B, A))
FOR X = A - 1 TO 0 STEP -1
IF ID <> SGN(BOARD(B, X)) THEN
NDX = NDX + 1: XX(NDX) = X: YY(NDX) = B
END IF
IF BOARD(B, X) <> 0 THEN GOTO 7
NEXT
7 REM
FOR X = A + 1 TO 7 STEP 1
IF ID <> SGN(BOARD(B, X)) THEN
NDX = NDX = 1: XX(NDX) = X: YY(NDX) = B
END IF
IF BOARD(B, X) <> 0 THEN GOTO 8
NEXT
8 REM
FOR Y = B - 1 TO 0 STEP -1
IF ID <> SGN(BOARD(Y, A)) THEN
NDX = NDX + 1: XX(NDX) = A: YY(NDX) = Y
END IF
IF BOARD(Y, A) <> 0 THEN GOTO 9
NEXT
9 REM
FOR Y = B + 1 TO 7 STEP 1
IF ID <> SGN(BOARD(B, A)) THEN
NDX = NDX + 1: XX(NDX) = A: YY(NDX) = Y
END IF
IF BOARD(Y, A) <> 0 THEN GOTO 10
NEXT
10 REM
END SUB

SUB SHOW
LOCATE 3, 30
COLOR 7, 0
PRINT "A  B  C  D  E  F  G  H"
FOR K = 0 TO 25
LOCATE 4, 28 + K
COLOR 6, 0
PRINT CHR$(220)
NEXT
FOR B = 0 TO 7
LOCATE 2 * B + 5, 26
COLOR 7, 0
PRINT CHR$(56 - B)
LOCATE 2 * B + 5, 28
COLOR 6, 0
PRINT CHR$(219)
LOCATE 2 * B + 6, 28
COLOR 6, 0
PRINT CHR$(219)
FOR A = 0 TO 7
IF ((A + B) MOD 2) <> 0 THEN
COLOUR = 8
ELSE COLOUR = 12
END IF
CALL SQUARE(3 * A + 31, 2 * B + 5, COLOUR)
NEXT
LOCATE 2 * B + 5, 53
COLOR 6, 0
PRINT CHR$(219)
LOCATE 2 * B + 6, 53
COLOR 6, 0
PRINT CHR$(219)
LOCATE 2 * B + 6, 55
COLOR 7, 0
PRINT CHR$(56 - B)
NEXT
FOR K = 0 TO 25
LOCATE 21, 28 + K
COLOR 6, 0
PRINT CHR$(223)
NEXT
LOCATE 22, 30
COLOR 7, 0
PRINT "A  B  C  D  E  F  G  H"
FOR B = 0 TO 7
FOR A = 0 TO 7
CALL SHOWMAN(A, B, 0)
NEXT
NEXT
COLOR 7, 0
END SUB

SUB SHOWMAN (A, B, FLAG)
IF BOARD(B, A) < 0 THEN BACK = 0
IF BOARD(B, A) > 0 THEN BACK = 7
FORE = 7 - BACK + FLAG
IF BOARD(B, A) = 0 THEN
IF ((A + B) MOD 2) <> 0 THEN BACK = 8 ELSE BACK = 12
FORE = BACK + -1 * (FLAG > 0)
END IF
N$ = " "
PIECE = INT(ABS(BOARD(B, A)))
IF PIECE = 0 THEN N$ = CHR$(219)
IF PIECE = 100 THEN N$ = "P"
IF PIECE = 270 THEN N$ = "N"
IF PIECE = 300 THEN N$ = "B"
IF PIECE = 500 THEN N$ = "R"
IF PIECE = 900 THEN N$ = "Q"
IF PIECE = 5000 OR PIECE = 7500 THEN N$ = "K"
LOCATE 2 * B + 5 - (BOARD(B, A) > 0), 3 * A + 30
COLOR FORE, BACK
PRINT N$
LOCATE 1, 1
COLOR 7, 0
END SUB

SUB SQUARE (A, B, C)
MT$ = CHR$(219): MT$ = MT$ + MT$ + MT$
LOCATE B, A - 2
COLOR C, C
PRINT MT$
LOCATE B + 1, A - 2
COLOR C, C
PRINT MT$
COLOR 7, 0
END SUB



    
This message has been edited by iorr5t on Jan 7, 2007 8:14 AM


 
 Respond to this message   
Response TitleAuthor and Date
Good work figuring that much out. I added some edits, etc. (View Thread) on Jan 7
   Patched KNIGHT subroutine on Jan 7
      Mac...Pete on Jan 7
         Thanksqbguy on Jan 7
            Re: Thanksqbguy on Jan 7
               Rook sub is next part that needs debugging...Pete on Jan 7
                  Fixedqbguy on Jan 7
                     Never mindqbguy on Jan 7
                        Fixed (really)qbguy on Jan 13
                           AIqbguy on Jan 13
                              AI or two player.roy on Jan 14
                           Good work on Rook and Queen! Next bug - King won't move.Pete on Jan 14
                              Fourth line of KING SUB change Y to 7roy on Jan 14
                                 Found a bug in EVALUATE functionqbguy on Jan 20
                                    You need to save the board positions.roy on Jan 21
                                       Re: You need to save the board positions.asdf on Feb 23
                                          The code was an example of what was needed to preventroy on Feb 24
                                             Easy level chess gameroy on Feb 24
                                                Working Program By Meqbguy on Mar 18
 Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement  

Newbies usually go to www.qbasic.com and click on The QBasic Forum
Forum regulars have their own ways, which include The QBasic Community Forums