SCREEN 1 'Pantalla grafica
DEFINT A-Y 'Variables enteras
DIM C(64, 15, 7) 'Casilla de origen,direccion y distancia
DIM IX(15), IY(15) 'Incremento segun direccion
DIM D(7), E(7, 8), H(64, 8, 7) 'Direcciones, direccion para pieza y distancia
DIM A(32), T(32), N(32) 'Tipo, bando y casilla de pieza (0vacia,1PB,2PN,3R,4C,5A,6T,7D)
DIM P(64), P1(2), P2(2) 'Pieza en casilla, inicio y fin
DIM B(9, 4) 'Control de jugada (real o simulada)
DIM S(200, 4), M(9, 4) 'Jugadas posibles
DIM V(9), V1(4), V2(4), W(200) 'Control simulacion
DIM X(64), Y(64) 'Coordenadas para casillas
DIM R(2), PR(2), K(64), Q(64) 'Casilla y pieza del rey ,control de enroque y promocion
DIM I(2, 2), F(64), A$(7, 2) 'Tinta, fondo y caracter pieza
DIM JJ(9, 200), L(16), LL(16) 'Jugadas permitidas y control contadores
DIM MX(200) 'Control ordenacion
DIM U(7, 7) 'Comprueba jaques
FOR E = 0 TO 15 'Direcciones posibles,del 8 al 15 para el caballo
L(E + 1) = 1 OR L(E) = 1
LL(E + 1) = 199 AND L(E) = 1
READ IX(E), IY(E) 'Incremento segun direccion
NEXT
FOR A = 0 TO 7 'Tipo de pieza
Q(A + 9) = 2 'Casillas de promocion
Q(A + 49) = 1
READ B$(A), D(A) 'Numero de direcciones segun tipo de pieza
FOR D = 1 TO D(A)
READ E
E(A, D) = E 'Direccion
IF A = 1 AND D <> 2 THEN U(2, E) = 2
IF A = 2 AND D <> 2 THEN U(1, E) = 2
IF A = 3 THEN U(3, E) = 2
IF A > 4 THEN U(A, E) = 8
NEXT D, A
I(1, 2) = 3
I(2, 1) = 3
FOR T = 1 TO 2 'Bando
TT = 2 * T - 1
V1(TT) = TT + 1
V2(TT + 1) = TT
R(T) = 56 * T - 51 'Casilla rey de inicio
PR(T) = 17 * T - 5
P1(T) = 16 * T - 15
P2(T) = 16 * T
FOR P = P1(T) TO P2(T) 'Pieza
READ A 'Tipo de pieza
A(P) = A 'Tipo de pieza en casilla
T(P) = T 'Bando
N(P) = 2 + 15 * T - L(T) * P 'Casilla para pieza
P(N(P)) = P 'Pieza para casilla
NEXT P, T
FOR N = 1 TO 64 'Casillas del tablero
Y = INT((N - 1) / 8) 'Fila
X = N - 1 - 8 * Y 'Columna
F = 2 + (F = 2) 'Alterna fondo
F(N) = F 'Fondo de casilla
Y(N) = 24 * (7 - Y) 'Fila para casilla
X(N) = 24 * X 'Columna
GOSUB 2000 'Plasmar en pantalla
IF X = 7 THEN F = F(N - 1) 'Primera columna, repite fondo
FOR E = 0 TO 15 'Total de direcciones
H = 0
IX = IX(E) 'Incremento segun direccion
IY = IY(E)
XX = X + 1 'Copia coordenadas
YY = Y
100 XX = XX + IX 'Incremento
YY = YY + IY
IF XX < 1 OR XX > 8 OR YY < 0 OR YY > 7 GOTO 200
'Salta si supera los limites del tablero
H = H + 1
C(N, E, H) = XX + 8 * YY 'Casilla destino segun direccion y distancia
IF E < 8 GOTO 100
200 FOR A = 1 TO 7 * SGN(H) 'Si hay distancia
FOR D = 1 TO D(A)
IF E = E(A, D) THEN 'Ajusta distancia segun direccion y pieza
H(N, D, A) = H
IF A < 4 THEN H(N, D, A) = 1
IF A < 3 AND D = 2 AND A(P(N)) = A THEN H(N, D, A) = 2
END IF 'Peon al frente 2 inicial
NEXT D, A, E, N
T = 1 'Turno
TT = 2
250 MAX = 2 'Profundidad de calculo
GOTO 540
300 ZT = TIMER
J = 1 'Inicio rutina principal
320 PP(J) = P1(T) 'Numero de pieza
340 NN(J) = N(PP(J)) 'Casilla de la pieza
IF NN(J) = 0 GOTO 480 'Pieza nula
AA(J) = A(PP(J)) 'Tipo de pieza
DD(J) = 1 'Direccion
360 GG(J) = H(NN(J), DD(J), AA(J)) 'Alcance
IF GG(J) = 0 GOTO 470 'No hay alcance
G(J) = 1
EE(J) = E(AA(J), DD(J)) 'Direccion segun pieza
380 CC(J) = C(NN(J), EE(J), G(J)) 'Casilla destino
IF T(P(CC(J))) = T GOTO 460 'Mismo bando
V(J) = 2 'Jugada simple
IF AA(J) < 3 THEN 'Rutina peon
IF DD(J) = 2 EQV P(CC(J)) = 0 GOTO 400 'Peon util
IF P(CC(J)) OR AA(J - 1) > 2 OR G(J - 1) < 2 GOTO 470 'No evalua al paso
IF CC(J) + CC(J) = NN(J - 1) + CC(J - 1) THEN V(J) = 4: M(J, 3) = 0: M(J, 4) = CC(J - 1) ELSE GOTO 470
END IF 'Casilla de captura al paso
400 IF A(P(CC(J))) = 3 THEN JQ = 1: GOTO 500 'Rey amenazado
IF AA(J) = Q(NN(J)) THEN A(P(NN(J))) = 7: M(J, 3) = 7 'Promocion
IF AA(J) = 3 AND K(R(T)) = 0 THEN 'Rutina enroque
IF G(J) = 2 THEN IF P(CC(J)) + JJQ GOTO 470 ELSE V(J) = 4: GOTO 410
M(J, 3) = 0 'Destino libre, intermedia sin amenaza
IF DD(J) = 3 AND K(R(T) + 3) = 0 THEN M(J, 3) = R(T) + 3 'Enroque corto
IF DD(J) = 7 AND K(R(T) - 4) = 0 AND P(R(T) - 3) = 0 THEN M(J, 3) = R(T) - 4
IF M(J, 3) THEN GOSUB 440: IF JQ = 0 THEN GG(J) = 2: M(J, 4) = CC(J)
JQ = 0 'Origen sin jaque
END IF
410 M(J, 1) = NN(J) 'Simula origen
M(J, 2) = CC(J) 'Simula destino
FOR V = 1 TO V(J) 'Ejecuta jugada para simulacion
N = M(J, V) 'Casilla origen, destino, al paso y enroque
K(N) = K(N) + 1 'Casilla usada
N(P(N)) = M(J, V1(V)) 'Pieza movida
B(J, V) = P(N) 'Guarda pieza de casilla
P(N) = B(J, V2(V)) 'Destino
NEXT
IF J < MAX THEN J = J + 1: SWAP T, TT: GOTO 320 'Nivel siguiente
GOSUB 440
GOTO 510
440 N = N(PR(T)) 'Casilla del rey
FOR E = 0 TO 7 'Direcciones para busqueda de jaques
P = P(C(N, E + 8, 1))
IF T(P) = TT AND A(P) = 4 THEN JQ = 1
FOR G = 1 TO H(N, E + 1, 7)
P = P(C(N, E, G))
IF P THEN
IF T(P) = TT AND G < U(A(P), E) THEN JQ = 1
G = 8
END IF
NEXT G, E
RETURN
450 IF AA(J) < A(P(NN(J))) THEN
M(J, 3) = M(J, 3) - 1 'Subpromocion
A(P(NN(J))) = M(J, 3)
IF M(J, 3) > 3 GOTO 410
GOTO 450
END IF
460 IF P(CC(J)) = 0 AND G(J) < GG(J) THEN G(J) = G(J) + 1: GOTO 380 'Alcance mas
470 IF DD(J) < D(AA(J)) THEN DD(J) = DD(J) + 1: GOTO 360 'Direccion mas
480 IF PP(J) < P2(T) THEN PP(J) = PP(J) + 1: GOTO 340 'Pieza siguiente
500 J = J - 1 'Nivel menos
IF J = 0 GOTO 600
SWAP T, TT
510 FOR V = 1 TO V(J) 'Recupera jugada simulada
N = M(J, V)
K(N) = K(N) - 1
N(B(J, V)) = N
P(N) = B(J, V)
NEXT
JJQ = JQ
IF JQ GOTO 540
J(1, J) = J(1, J) + 1
IF J = MAX GOTO 450
IF J = 1 THEN
S = J(1, 1)
MX(S) = 0
FOR V = 1 TO MAX - 1
JJ(V, S) = J(V, V + 1) 'Guarda valor mayor
NEXT
IF AA(1) = Q(NN(1)) THEN S(S, 3) = M(1, 3) 'Promocion
W(S) = V(1)
FOR V = 1 TO V(1) 'Valida jugada
S(S, V) = M(1, V)
NEXT
ELSE FOR W = 1 TO MAX - J 'Evaluar contadores
IF L(W) = SGN(J(W + 1, J + W) - J(W, J + W)) THEN J(W + 1, J + W) = J(W, J + W)
NEXT
END IF
540 JQ = 0
FOR V = J TO MAX - 1 'Reinicio de contadores
FOR W = 1 TO MAX - V
J(W, V + W) = LL(W)
NEXT W, V
IF J GOTO 450
GOTO 300
600 Z = TIMER - ZT + .1
M = R(T) 'Casilla del rey en origen
LOCATE 1, 26
PRINT "Tiempo="; LEFT$(STR$(Z), 5); " "
JJ(MAX - 1, 0) = LL(MAX) - L(MAX)
LOCATE 2, 27
PRINT "Nivel="; MAX
JJ(MAX - 1, 0) = LL(MAX) - L(MAX)
FOR V = 1 TO 5 'Ordenar maximos o minimos
S = 0
FOR W = 1 TO J(1, 1)
IF L(MAX) = SGN(JJ(MAX - 1, W) - JJ(MAX - 1, S)) AND MX(W) = 0 THEN S = W
NEXT
MX(S) = 1
LOCATE 3 + V, 26
IF S THEN 'Mejor eleccion en pantalla
N = S(S, 2)
Y = INT((N - 1) / 8) 'Fila
X = N - 8 * Y 'Columna
B$ = B$(A(P(S(S, 1)))) + CHR$(X + 96) + CHR$(Y + 49) 'Inicial
C$ = " "
D$ = RIGHT$(" " + STR$(JJ(MAX - 1, S)), 4) + " " IF L(TT + MAX) = 1 THEN PRINT D$; B$; C$ ELSE PRINT C$; B$; D$
ELSE PRINT " "
END IF
NEXT
LOCATE 10, 26
PRINT "BLANCAS NEGRAS"
610 FOR V = 11 TO 16
LOCATE V, 26
PRINT " "
NEXT
LOCATE 11, 19 + 8 * T
PRINT J(1, 1) 'Total de jugadas
N = M 'Origen
A = A(P(N))
I = T(P(N))
F = I(T, 2)
GOSUB 2200 'Plasmar cursor
GOSUB 1000 'Lectura de teclado
IF A$ = CHR$(13) GOTO 620 'INTRO elige origen
IF A$ = "M" AND M < 64 THEN M = M + 1
IF A$ = "K" AND M > 1 THEN M = M - 1
IF A$ = "H" AND M < 57 THEN M = M + 8
IF A$ = "P" AND M > 8 THEN M = M - 8
GOSUB 2100 'Plasmar casilla normal
IF A$ = "+" AND MAX < 9 THEN MAX = MAX + 1: GOTO 540
IF A$ = "-" AND MAX > 2 THEN MAX = MAX - 1: GOTO 540
A = ASC(A$)
IF A < 48 OR A > 57 GOTO 610
A = A - 48
IF A = 0 THEN 'Vacia casilla
P = P(N)
IF P THEN A(P) = 0: N(P) = 0: P(N) = 0: K(N) = 1: GOSUB 2100
GOTO 250
END IF
IF A = TT THEN SWAP T, TT 'Cambia turno
IF A = 8 THEN 'Vacia tablero
FOR P = 1 TO 32
N = N(P)
IF N THEN A(P) = 0: N(P) = 0: P(N) = 0: K(N) = 1: GOSUB 2100
NEXT
GOTO 250
END IF
IF A = 9 THEN RUN 'Reinicio
IF P(N) GOTO 250 'Vuelve a cursor
FOR P = P1(T) TO P2(T) 'Activa pieza
IF N(P) = 0 THEN
A(P) = A
N(P) = N
P(N) = P
K(N) = 1
GOSUB 2000
IF A = 3 THEN PR(T) = P
P = P2(T)
END IF
NEXT
GOTO 250
620 S = J(1, 1) + 1 AND A$ = "K" 'Numero de movimiento
N = 0 'Control posible/no posible
630 S = S + (1 OR A$ = "K") 'Movimiento siguiente
IF S <= J(1, 1) AND S GOTO 640 'Salta si esta en rango
IF N = 0 THEN GOTO 610 'La pieza elegida no se puede mover
GOTO 620 'Misma pieza
640 IF S(S, 1) <> M GOTO 630 'No coincide con la elegida
N = S(S, 2) 'Destino
A = A(P(M)) 'Tipo
IF A = Q(M) THEN A = S(S, 3) 'Peon promociona
X = T
Y = 11
W = 1
FOR V = 1 TO MAX - 1 'Plasmar maximos
X = X + 1
IF X = 3 THEN X = 1: Y = Y + 1
LOCATE Y, 19 + 8 * X
IF W THEN W = JJ(V, S): PRINT W; " " ELSE PRINT " "
NEXT
F = F(N)
GOSUB 2200 'Pieza elegida en destino
GOSUB 1000 'Cualquier tecla
GOSUB 2000 'Normaliza destino
I = T
IF A$ <> CHR$(13) GOTO 630 'INTRO confirma jugada
AA(0) = A(P(M))
G(0) = 0 'Control al paso
IF AA(0) < 3 THEN G(0) = ABS(M - N) / 8
IF AA(0) = Q(M) THEN A(P(M)) = S(S, 3) 'Promocion
NN(0) = M 'Casilla origen
CC(0) = N 'Casilla destino
FOR V = 1 TO W(S) 'Realiza movimiento
N = S(S, V)
K(N) = 1
N(P(N)) = S(S, V1(V))
B(0, V) = P(N)
P(N) = B(0, V2(V))
IF N THEN GOSUB 2100 'Plasmar o limpiar
NEXT
SWAP T, TT
GOTO 540
1000 IF INKEY$ <> "" GOTO 1000 'Lectura de teclado
1010 A$ = RIGHT$(INKEY$, 1) 'Caracter derecho (Teclas de direccion =2 caracteres)
IF A$ = "" GOTO 1010
IF A$ = CHR$(27) THEN IF J(1, 1) THEN GOSUB 2000: GOTO 610 ELSE SYSTEM
'Si no hay movimiento legal ESC finaliza, si lo hay vuelve a cursor
RETURN
2000 I = T(P(N)) 'Bando
2100 A = A(P(N)) 'Tipo de pieza
F = F(N) 'Fondo de casilla
2200 LINE (X(N), Y(N))-(X(N) + 23, Y(N) + 23), F, BF
IF A THEN
RESTORE PEON
IF A = 3 THEN RESTORE REY
IF A = 4 THEN RESTORE CABALLO
IF A = 5 THEN RESTORE ALFIL
IF A = 6 THEN RESTORE TORRE
IF A = 7 THEN RESTORE DAMA
FOR YY = Y(N) TO Y(N) + 23
READ P$
FOR XX = 0 TO 23
W = VAL(MID$(P$, XX + 1, 1))
IF W THEN PSET (X(N) + XX, YY), I(I, W)
NEXT XX, YY
END IF
RETURN
'Incremento segun direccion
DATA 0,1,1,1,1,0,1,-1,0,-1,-1,-1,-1,0,-1,1
DATA 1,2,2,1,2,-1,1,-2,-1,-2,-2,-1,-2,1,-1,2
'Piezas,numero de direcciones y direcciones
DATA " ",0
DATA " ",3,1,0,7
DATA " ",3,3,4,5
DATA "R",8,0,1,2,3,4,5,6,7
DATA "C",8,8,9,10,11,12,13,14,15
DATA "A",4,1,3,5,7
DATA "T",4,0,2,4,6
DATA "D",8,0,1,2,3,4,5,6,7
'Tipo de piezas
DATA 1,1,1,1,1,1,1,1,6,4,5,3,7,5,4,6
DATA 2,2,2,2,2,2,2,2,6,4,5,7,3,5,4,6
PEON:
DATA 000000000000000000000000
DATA 000000000000000000000000
DATA 000000000000000000000000
DATA 000000000011110000000000
DATA 000000000122221000000000
DATA 000000001222222100000000
DATA 000000001222222100000000
DATA 000000001222222100000000
DATA 000000000122221000000000
DATA 000000000012210000000000
DATA 000000001111111100000000
DATA 000000012222222210000000
DATA 000000001111111100000000
DATA 000000000012210000000000
DATA 000000000012210000000000
DATA 000000000012210000000000
DATA 000000000122221000000000
DATA 000000001222222100000000
DATA 000000012222222210000000
DATA 000000012222222210000000
DATA 000000111111111111000000
DATA 000001222222222222100000
DATA 000001111111111111100000
DATA 000000000000000000000000
REY:
DATA 000000000000000000000000
DATA 000000000000000000000000
DATA 000000000001100000000000
DATA 000000000112211000000000
DATA 000000000001100000000000
DATA 000011100012210001110000
DATA 000122210122221012221000
DATA 001222221012210122222100
DATA 001222122101101221222100
DATA 001221212210012212122100
DATA 001221221221122122122100
DATA 000122122122221221221000
DATA 000012212212212212210000
DATA 000001221221122122100000
DATA 000001222122221222100000
DATA 000011111111111111110000
DATA 000122222222222222221000
DATA 000011111111111111110000
DATA 000001222122221222100000
DATA 000001222122221222100000
DATA 000011111111111111110000
DATA 000122222222222222221000
DATA 000111111111111111111000
DATA 000000000000000000000000
CABALLO:
DATA 000000000000000000000000
DATA 000000000000000000000000
DATA 000000000010000000000000
DATA 000000000011001100000000
DATA 000000000012112210000000
DATA 000000000112221221000000
DATA 000000001222222122100000
DATA 000000012222222212210000
DATA 000000122211222212210000
DATA 000000122212222212210000
DATA 000001222222222212210000
DATA 000012222222222221221000
DATA 000122222222222221221000
DATA 001222222222122221221000
DATA 001221222111222221221000
DATA 000112211001222222122100
DATA 000001100012222222122100
DATA 000000000012222222122100
DATA 000000000122222222122100
DATA 000000000122222222122100
DATA 000000001222222222122100
DATA 000000011111111111111100
DATA 000000000000000000000000
DATA 000000000000000000000000
ALFIL:
DATA 000000000000000000000000
DATA 000000000000000000000000
DATA 001111111111111110000000
DATA 000122222222222221000000
DATA 000012222111111122100000
DATA 000001121222222212210000
DATA 000000012222222221221000
DATA 000000122222222222122100
DATA 000001212222222222212100
DATA 000012221211222222212100
DATA 000122122122122222212100
DATA 001221222212122222212100
DATA 000122122122122222212100
DATA 000012221211222222212100
DATA 000001212222222222122100
DATA 000000122222222221012100
DATA 000000011222222210012100
DATA 000000000122222100001100
DATA 000000011222222211000000
DATA 000000122222222222110000
DATA 000001222222111222221000
DATA 000012222111000111111000
DATA 000111111000000000000000
DATA 000000000000000000000000
TORRE:
DATA 000000000000000000000000
DATA 000000000000000000000000
DATA 000000000000000000000000
DATA 000011110011110011110000
DATA 000012210012210012210000
DATA 000012210012210012210000
DATA 000012211112211112210000
DATA 000012222222222222210000
DATA 000012222222222222210000
DATA 000011111111111111110000
DATA 000000122222222221000000
DATA 000000122222222221000000
DATA 000000122222222221000000
DATA 000000122222222221000000
DATA 000000122222222221000000
DATA 000000122222222221000000
DATA 000000122222222221000000
DATA 000001111111111111100000
DATA 000012222222222222210000
DATA 000012222222222222210000
DATA 000111111111111111111000
DATA 001222222222222222222100
DATA 001111111111111111111100
DATA 000000000000000000000000
DAMA:
DATA 000000000000000000000000
DATA 000000000000000000000000
DATA 000000001100001100000000
DATA 000000012210012210000000
DATA 001100012210012210001100
DATA 012210001100001100012210
DATA 012210001100001100012210
DATA 001210001210012100012100
DATA 000121001210012100121000
DATA 000012101210012101210000
DATA 000001211221122112100000
DATA 000001221221122122100000
DATA 000001222222222222100000
DATA 000001222222222222100000
DATA 000001222222222222100000
DATA 000011111111111111110000
DATA 000122222222222222221000
DATA 000011111111111111110000
DATA 000001222122221222100000
DATA 000001222122221222100000
DATA 000011111111111111110000
DATA 000122222222222222221000
DATA 000111111111111111111000
DATA 000000000000000000000000
