Chess player: Difference between revisions
Chess player en QBASIC
No edit summary |
(Chess player en QBASIC) |
||
Line 14:
or use those components as part of a complete program, demonstrating your language's support for modularity.
=={{header|BASIC}}==
{{works with|QBasic}}
El código es de Dean Menezes
Encontrado en: http://www.petesqbsite.com/sections/express/issue23/Tut_QB_Chess.txt
<lang qbasic>DEFINT A-Z
DECLARE SUB SQUARE (A, B, C)
DECLARE SUB SHOWMAN (A, B, FLAG)
DECLARE SUB SHOWBD ()
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 SHOWBD
RESULT = EVALUATE(-1, 10000)
A = BESTA(1)
B = BESTB(1)
X = BESTX(1)
Y = BESTY(1)
LOOP
end
SUB BISHOP (A, B, XX(), YY(), NDX)
ID = SGN(BOARD(B, A))
FOR DXY = 1 TO 7
X = A - DXY
Y = B + DXY
IF X < 0 OR X > 7 OR Y < 0 OR Y > 7 THEN EXIT FOR
GOSUB 3
IF BOARD(Y, X) THEN EXIT FOR
NEXT
FOR DXY = 1 TO 7
X = A + DXY
Y = B + DXY
IF X < 0 OR X > 7 OR Y < 0 OR Y > 7 THEN EXIT FOR
GOSUB 3
IF BOARD(Y, X) THEN EXIT FOR
NEXT
FOR DXY = 1 TO 7
X = A - DXY
Y = B - DXY
IF X < 0 OR X > 7 OR Y < 0 OR Y > 7 THEN EXIT FOR
GOSUB 3
IF BOARD(Y, X) THEN EXIT FOR
NEXT
FOR DXY = 1 TO 7
X = A + DXY
Y = B - DXY
IF X < 0 OR X > 7 OR Y < 0 OR Y > 7 THEN EXIT FOR
GOSUB 3
IF BOARD(Y, X) THEN EXIT FOR
NEXT
EXIT SUB
3 REM
IF ID <> SGN(BOARD(Y, X)) THEN
NDX = NDX + 1
XX(NDX) = X
YY(NDX) = Y
END IF
RETURN
END SUB
FUNCTION EVALUATE (ID, PRUNE)
DIM XX(0 TO 26), YY(0 TO 26)
LEVEL = LEVEL + 1
BESTSCORE = 10000 * ID
FOR B = 7 TO 0 STEP -1
FOR A = 7 TO 0 STEP -1
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(Y, X)
CALL MAKEMOVE(A, B, X, Y)
IF (LEVEL < MAXLEVEL) THEN SCORE = SCORE + EVALUATE(-ID, BESTSCORE - TARGET + ID * (8 - ABS(4 - X) - ABS(4 - Y)))
SCORE = SCORE + TARGET - 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) = 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
EXIT FUNCTION
END IF
END IF
BOARD(B, A) = MOVER
BOARD(Y, X) = TARGET
SCORE = OLDSCORE
IF (LEVEL = 1) THEN CALL SHOWMAN(X, Y, 0)
NEXT
1
IF (LEVEL = 1) THEN CALL SHOWMAN(A, B, 0)
NEXT
NEXT
LEVEL = LEVEL - 1
EVALUATE = BESTSCORE
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 6
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
EXIT FUNCTION
END IF
NEXT
6 '
NEXT
NEXT
INCHECK = 0
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 + A); 8 - B; "- "; CHR$(65 + X); 8 - Y
IF PIECE 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 SHOWBD
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 THEN GOTO 16
IF BOARD(7, 7) <> 500 THEN GOTO 16
IF BOARD(7, 6) OR BOARD(7, 5) THEN GOTO 16
BOARD(7, 6) = 5000
BOARD(7, 4) = 0
BOARD(7, 5) = 500
BOARD(7, 7) = 0
CFLAG = 1
EXIT SUB
END IF
IF UCASE$(IN$) = "O-O-O" OR IN$ = "0-0-0" THEN
IF CFLAG THEN GOTO 16
IF BOARD(7, 0) <> 500 THEN GOTO 16
IF BOARD(7, 1) OR BOARD(7, 2) OR BOARD(7, 3) THEN GOTO 16
BOARD(7, 2) = 5000
BOARD(7, 4) = 0
BOARD(7, 3) = 500
BOARD(7, 0) = 0
CFLAG = 1
EXIT SUB
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 B > 7 OR B < 0 OR A > 7 OR A < 0 OR X > 7 OR X < 0 OR Y > 7 OR Y < 0 THEN GOTO 16
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 EXIT SUB
BOARD(B, A) = MOVER
BOARD(Y, X) = TARGET
GOTO 16
END IF
NEXT
16 '
CLS
LOOP
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 > 7 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)
ID = SGN(BOARD(B, A))
X = A - 1
Y = B - 2
GOSUB 5
X = A - 2
Y = B - 1
GOSUB 5
X = A + 1
Y = B - 2
GOSUB 5
X = A + 2
Y = B - 1
GOSUB 5
X = A - 1
Y = B + 2
GOSUB 5
X = A - 2
Y = B + 1
GOSUB 5
X = A + 1
Y = B + 2
GOSUB 5
X = A + 2
Y = B + 1
GOSUB 5
EXIT SUB
5 '
IF X < 0 OR X > 7 OR Y < 0 OR Y > 7 THEN RETURN
IF ID <> SGN(BOARD(Y, X)) THEN NDX = NDX + 1: XX(NDX) = X: YY(NDX) = Y
RETURN
END SUB
SUB MAKEMOVE (A, B, X, Y)
BOARD(Y, X) = BOARD(B, A)
BOARD(B, A) = 0
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 = 900 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 - 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 - 2 * ID
END IF
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)) THEN EXIT FOR
NEXT
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)) THEN EXIT FOR
NEXT
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)) THEN EXIT FOR
NEXT
FOR Y = B + 1 TO 7 STEP 1
IF ID <> SGN(BOARD(Y, A)) THEN
NDX = NDX + 1
XX(NDX) = A
YY(NDX) = Y
END IF
IF (BOARD(Y, A)) THEN EXIT FOR
NEXT
END SUB
SUB SHOWBD
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) 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) AND 1 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</lang>
=={{header|Go}}==
| |||