SCREEN 0 'Pantalla de texto
WIDTH 40 'Ancho 40
DEFINT A-Z '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, 15), H(64, 15, 7) 'Direcciones, direccion para pieza y distancia
DIM A(2, 64) 'Tipo, bando y pieza en casilla (0vacia,1PB,2PN,3R,4C,5A,6T,7D)
DIM B(2, 2) 'Control de jugada (real o simulada)
DIM N(2, 16) 'Situacion de pieza por bando y pieza en casilla
DIM M(200, 2) 'Jugadas posibles
DIM X(64), Y(64) 'Coordenadas para casillas
DIM R(2), K(64) 'Casilla rey y control torres
DIM T(2), F(64), A$(7, 2) 'Tinta, fondo y caracter pieza
FOR E = 0 TO 15 'Direcciones posibles,del 8 al 15 para el caballo
READ IX(E), IY(E) 'Incremento segun direccion
NEXT
FOR A = 0 TO 7 'Tipo de pieza
READ A$(A, 0), A$(A, 1), A$(A, 2) 'Casillas de 3X3 ASCII
READ D(A) 'Numero de direcciones segun tipo de pieza
FOR D = 1 TO D(A)
READ E(A, D) 'Direccion
NEXT D, A
FOR T = 1 TO 2 'Bando
R(T) = 56 * T - 51 'Casilla rey de inicio
K(R(T) - 4) = 7 'Control para enroque
K(R(T) + 3) = 3 '(Direccion)
FOR P = 1 TO 16 'Pieza
READ A 'Tipo de pieza
N = 48 * T - 48 + P 'Casilla inicial segun bando
A(0, N) = A 'Tipo de pieza en casilla
A(1, N) = T 'Bando
A(2, N) = P 'Pieza para casilla
N(T, P) = N 'Casilla para pieza
NEXT P, T
T(0) = 7 'Tinta neutra
T(1) = 7 'Tinta blancas
T(2) = 0 'Tinta negras
F = 1 'Fondo casilla inicial
FOR N = 1 TO 64 'Casillas del tablero
Y = INT((N - 1) / 8) 'Fila
X = N - 1 - 8 * Y 'Columna
F(N) = F 'Fondo de casilla
F = 5 + 4 * (F = 5) 'Alterna fondo
Y(N) = 1 + 3 * (7 - Y) 'Fila para casilla
X(N) = 1 + 3 * X 'Columna
GOSUB 1090 'Plasmar en pantalla
IF X = 7 THEN F = F(N) 'Primera columna, repite fondo
FOR E = 0 TO 15 'Total de direcciones
H = 0
IX = IX(E) 'Incremento segun direccion
IY = IY(E)
V = X + 1 'Copia coordenadas
W = Y
100 V = V + IX 'Incremento
W = W + IY
IF V < 1 OR V > 8 OR W < 0 OR W > 7 GOTO 200
'Salta si supera los limites del tablero
H = H + 1
C(N, E, H) = V + 8 * W '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 H(N, E, A)= H: IF A < 4 THEN H(N, E, A)= 1 - (A < 3 AND D= 2 AND A(0, N)= A)
'Ajusta distancia segun direccion y pieza (Peon al frente 2 inicial)
NEXT
NEXT A, E, N
T = 1 'Bando en juego
TT = 2 'Bando contrario
300 M = 0 'Jugadas posibles
FOR P = 1 TO 16 'Piezas bando en juego
N = N(T, P) 'Casilla de la pieza
A = A(0, N) 'Tipo
FOR D = 1 TO D(A) 'Numero de direcciones
N2 = 0 'Al paso=0
N4 = N 'Control de enroque
E = E(A, D) 'Direccion
H1 = H(N, E, A) 'Distancia
IF A = 3 AND N = R(T) THEN IF D = K(N + 3) OR D = K(N - 4) AND A(0, N - 3) = 0 THEN H1 = 2
'Habilita enroque
FOR H = 1 TO H1
C = C(N, E, H) 'Casilla (1,64)
IF A(1, C) = T GOTO 450 'Ocupada, siguiente direccion
IF A > 2 GOTO 350 'Rutina del peon
IF D = 2 EQV A(0, C) = 0 GOTO 400 'Validar avance o captura
IF A(0, C) OR C <> N3 GOTO 450 'Casilla objetivo<>Casilla de captura al paso
N2 = N1 'Validar al paso
350 IF A = 3 AND H = 2 THEN N4 = 0: IF A(0, C) GOTO 450 'No enroca en jaque o destino ocupado
400 JQ = 0 'Control de jaque
FOR PP = 1 TO 16 'Piezas rivales
NN = N(TT, PP) 'Casilla de la pieza
AA = A(0, NN) 'Tipo
IF NN = C OR NN = N2 THEN AA = 0 'Si va a ser capturada no cuenta
FOR DD = 1 TO D(AA) 'Direcciones
EE = E(AA, DD) 'Direccion
HH1 = H(NN, EE, AA) 'Distancia
IF AA < 3 AND DD = 2 THEN HH1 = 0 'Peon al frente
FOR HH = 1 TO HH1
CC = C(NN, EE, HH) 'Casilla objetivo
IF CC = N4 OR CC = N2 OR A(0, CC) = 0 AND CC <> C GOTO 410 'Se considera vacia
HH = HH1 'Casilla ocupada
IF CC = C AND A(0, N) = 3 THEN JQ = 1: DD = 8: PP = 16: IF A = 3 THEN H = H1
IF A(0, CC) = 3 AND A(1, CC) = T THEN JQ = 1: DD = 8: PP = 16 'Jaque
410 NEXT HH, DD, PP
IF JQ GOTO 450 'Hay jaque
M = M + 1 'Validar jugada
M(M, 0) = N 'Origen
M(M, 1) = C 'Destino
M(M, 2) = N2 'Casilla del peon capturado al paso
450 IF A(0, C) THEN H = H1 'Siguiente por captura
NEXT H, D, P
COLOR 7, 0
LOCATE 1, 28
PRINT "Total="; M; 'Total de jugadas
L = R(T) 'Casilla del rey en origen
550 N = L
A = A(0, N)
F = F(N)
IF A(1, N) = TT THEN F = T(A(1, N))
COLOR F, T(T) 'Invierte tinta y fondo simulando cursor
GOSUB 1100 'Plasmar pieza
GOSUB 1000 'Lectura de teclado
IF A$ = CHR$(13) GOTO 600 'INTRO elige Origen
A$ = RIGHT$(A$, 1) 'Caracter derecho (Teclas de direccion =2 caracteres)
IF A$ = "M" AND L < 64 THEN L = L + 1
IF A$ = "K" AND L > 1 THEN L = L - 1
IF A$ = "H" AND L < 57 THEN L = L + 8
IF A$ = "P" AND L > 8 THEN L = L - 8
GOSUB 1090 'Plasmar casilla normal
GOTO 550 'Vuelve a cursor
600 S = 0 'Numero de movimiento
N = 0 'Control posible/no posible
Q = 0 'Control promocion
620 IF Q > 4 THEN Q = Q - 1: A = Q: GOTO 650 'De dama a caballo
630 S = S + 1 'Movimiento siguiente
IF S < M + 1 GOTO 640 'Salta si esta en rango
IF N = 0 THEN GOTO 550 'La pieza elegida no se puede mover
GOTO 600 'Misma pieza
640 N0 = M(S, 0) 'Origen
IF N0 <> L GOTO 630 'No coincide con la elegida
N = M(S, 1) 'Destino
A = A(0, N0) 'Tipo
IF A < 3 AND (N < 9 OR N > 56) THEN Q = 7: A = 7 'Peon en zona de promocion
650 COLOR T(T), 3 'Color de destino
GOSUB 1100 'Pieza elegida en destino
GOSUB 1000 'Cualquier tecla
GOSUB 1090 'Normaliza destino
IF A$ <> CHR$(13) GOTO 620 'No se confirma jugada
IF Q THEN A(0, N0) = Q 'Hay promocion
680 N1 = N 'Casilla destino
FOR V = 0 TO 2
N = M(S, V) 'Casilla origen, destino y al paso
FOR W = 0 TO 2
B(V, W) = A(W, N) 'Guarda tipo, bando y pieza
A(W, N) = 0
IF V = 1 THEN A(W, N) = B(0, W)
NEXT
IF N THEN GOSUB 1090 'Plasmar o limpiar
NEXT
N(T, B(0, 2)) = N1 'Pieza movida
N(TT, B(1, 2)) = 0 'Capturadas
N(TT, B(2, 2)) = 0
K(N0) = 0 'Por si es torre
K(N1) = 0
IF A <> 3 GOTO 700 'Comprobar enroque
IF R(T) = N0 THEN K(N0 + 3) = 0: K(N0 - 4) = 0 'Desactiva control enroque
N = (N0 + N1) / 2 'Destino torre
M(S, 1) = N
IF N0 - N1 = 2 THEN M(S, 0) = N0 - 4: GOTO 680 'Origen torre
IF N1 - N0 = 2 THEN M(S, 0) = N0 + 3: GOTO 680
700 N3 = 0
IF A < 3 AND ABS(N0 - N1) = 16 THEN N3 = (N0 + N1) / 2 'Peon +2 activa al paso
SWAP T, TT 'Cambio de turno
GOTO 300
1000 IF INKEY$ <> "" GOTO 1000 'Lectura de teclado
1010 A$ = INKEY$
IF A$ = "" GOTO 1010
IF A$ = CHR$(27) THEN IF M THEN GOSUB 1090: GOTO 550 ELSE RUN
'Si no hay movimiento legal ESC reinicia, si lo hay vuelve a cursor
RETURN
1090 A = A(0, N) 'Tipo de pieza
COLOR T(A(1, N)), F(N) 'Tinta del bando y fondo de casilla
1100 FOR W = 0 TO 2
LOCATE Y(N) + W, X(N) 'Coordenadas
PRINT A$(A, W); 'Caracter 3X3
NEXT
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 " þ "
DATA " Û "
DATA " ß ",3,1,0,7
DATA " þ "
DATA " Û "
DATA " ß ",3,3,4,5
DATA " Å "
DATA "ÞÛÝ"
DATA "ÞÜÝ",8,0,1,2,3,4,5,6,7
DATA " Üþ"
DATA "þÛ "
DATA "Þ Ý",8,8,9,10,11,12,13,14,15
DATA " þ "
DATA " Û "
DATA "ÞßÝ",4,1,3,5,7
DATA "þþþ"
DATA "ÞÛÝ"
DATA " ß ",4,0,2,4,6
DATA "þÜþ"
DATA "ÞßÝ"
DATA "ÞÛÝ",8,0,1,2,3,4,5,6,7
'Tipo de piezas
DATA 6,4,5,7,3,5,4,6,1,1,1,1,1,1,1,1
DATA 2,2,2,2,2,2,2,2,6,4,5,7,3,5,4,6
Control de jugadas posibles, realizadas o simuladas.