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(64, 2) 'Tipo, bando y pieza en casilla (0vacia,1PB,2PN,3R,4C,5A,6T,7D)
DIM B(10, 4, 2) 'Control de jugada (real o simulada)
DIM N(2, 16) 'Situacion de pieza por bando
DIM S(200, 4), M(10, 4) 'Jugadas posibles
DIM V(15), V1(4), V2(4) 'Control simulacion
DIM X(64), Y(64) 'Coordenadas para casillas
DIM R(2), K(64) 'Casilla rey y control torres
DIM I(2), F(64), A$(7, 2) 'Tinta, fondo y caracter pieza
DIM J(10, 200) 'Jugadas permitidas
FOR E = 0 TO 15 'Direcciones posibles,del 8 al 15 para el caballo
READ IX(E), IY(E) 'Incremento segun direccion
V(E) = 2
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
TT = 2 * T - 1
V1(TT) = TT + 1
V2(TT + 1) = TT
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(N, 0) = A 'Tipo de pieza en casilla
A(N, 1) = T 'Bando
A(N, 2) = P 'Pieza para casilla
N(T, P) = N 'Casilla para pieza
NEXT P, T
I(0) = 7 'Tinta neutra
I(1) = 7 'Tinta blancas
I(2) = 0 'Tinta negras
FOR N = 1 TO 64 'Casillas del tablero
Y = INT((N - 1) / 8) 'Fila
X = N - 1 - 8 * Y 'Columna
IF F = 1 THEN F = 5 ELSE F = 1 'Alterna fondo
F(N) = F 'Fondo de casilla
Y(N) = 1 + 3 * (7 - Y) 'Fila para casilla
X(N) = 1 + 3 * X 'Columna
GOSUB 1100 '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 H(N,E,A) = H: IF A < 4 THEN H(N,E,A) = 1 - (A < 3 AND D = 2 AND A(N, 0) = A)
'Ajusta distancia segun direccion y pieza (Peon al frente 2 inicial)
NEXT D, A, E, N
V(0) = 0
T = 1 'Turno
TT = 2
300 J = 0
S = 0
J(0, 0) = 0
GOSUB 800 'Comprobar jaques
J = 1
S = 1
FOR P = 1 TO 16 'Piezas bando en juego
N = N(T, P) 'Casilla de la pieza
A = A(N, 0) 'Tipo
FOR D = 1 TO D(A) 'Numero de direcciones
E = E(A, D) 'Direccion
H1 = H(N, E, A) 'Distancia
IF A <> 3 OR N <> R(T) OR J(0, 0) = 0 GOTO 350 'Condiciones enroque
IF D = K(N + 3) THEN H1 = 2: M3 = N + 3 'Habilita enroque
IF D = K(N - 4) AND A(N - 3, 0) = 0 THEN H1 = 2: M3 = N - 4
350 FOR H = 1 TO H1
C = C(N, E, H) 'Casilla (1,64)
IF A(C, 1) = T GOTO 450 'Ocupada, siguiente direccion
M(1, 1) = N 'Origen
M(1, 2) = C 'Destino
M(1, 3) = 0 'Enroque, promocion
M(1, 4) = 0 'Enroque y al paso
IF A = 3 AND H = 2 THEN M(1, 3) = M3: M(1, 4) = (N + C) / 2: IF J(1, S) = 0 OR A(C, 0) GOTO 450
'Condiciones enroque
IF A > 2 GOTO 400 'Rutina del peon
IF C < 9 OR C > 56 THEN A(N, 0) = 7: M(1, 3) = 7 'Promocion
IF D = 2 EQV A(C, 0) = 0 GOTO 400 'Validar avance o captura
IF A(C, 0) OR C <> N3 GOTO 450 'Casilla objetivo<>Casilla de captura al paso
M(1, 4) = M2 'Validar al paso
400 V(1) = 2 'Jugada simple
IF M(1, 4) THEN V(1) = 4 'Compuesta
FOR V = 1 TO 3
J(V, S) = 0
NEXT
J3 = 200
GOSUB 800 'Simulacion
IF J(1, S) = 0 GOTO 450 'No vale
J(3, S) = J3 'Valor minimo
FOR V = 1 TO 4
S(S, V) = M(1, V) 'Guarda jugada
NEXT
S = S + 1
IF A <> A(N, 0) THEN A(N, 0) = A(N, 0) - 1: IF A(N, 0) > 3 THEN M(1, 3) = A(N, 0): GOTO 400
'Subpromocion
450 A(N, 0) = A
IF A(C, 0) THEN H = H1 'Siguiente direccion por captura
NEXT H, D, P
SS = S
L = R(T) 'Casilla del rey en origen
550 COLOR 7, 0
LOCATE 47 - 23 * T, 26 'Bando en juego
PRINT SS - 1; " "; 'Total de jugadas
LOCATE 47 - 23 * TT, 26 'Bando rival
PRINT " ";
N = L 'Origen
A = A(N, 0)
F = F(N) 'Fondo
IF A(N, 1) = TT THEN F = I(A(N, 1))
COLOR F, I(T) 'Invierte tinta y fondo simulando cursor
GOSUB 1200 '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 1100 'Plasmar casilla normal
GOTO 550 'Vuelve a cursor
600 S = 0 'Numero de movimiento
N = 0 'Control posible/no posible
630 S = S + 1 'Movimiento siguiente
IF S < SS 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 M1 = S(S, 1) 'Origen
IF M1 <> L GOTO 630 'No coincide con la elegida
N = S(S, 2) 'Destino
A = A(M1, 0) 'Tipo
IF A < 3 AND S(S, 3) THEN A = S(S, 3) 'Peon promociona
COLOR 7, 0
LOCATE 47 - 23 * TT, 26
PRINT J(2, S); " "; 'Jugadas rivales
LOCATE 47 - 23 * T, 30
PRINT J(3, S); " ";
COLOR I(T), 3 'Color de destino
GOSUB 1200 'Pieza elegida en destino
GOSUB 1000 'Cualquier tecla
GOSUB 1100 'Normaliza destino
IF A$ <> CHR$(13) GOTO 630 'INTRO confirma jugada
IF A(M1, 0) < 3 AND S(S, 3) THEN A(M1, 0) = S(S, 3) 'Promocion
M2 = N 'Casilla destino
V0 = 2
IF S(S, 4) THEN V0 = 4
FOR V = 1 TO V0 'Simulacion
M = S(S, V) 'Casilla origen, destino y al paso
N(A(M, 1), A(M, 2)) = S(S, V1(V)) 'Pieza movida
FOR W = 0 TO 2
B(0, V, W) = A(M, W) 'Guarda tipo, bando y pieza
A(M, W) = B(0, V2(V), W) 'Destino
NEXT W, V
FOR V = 1 TO V0
N = S(S, V)
IF N THEN K(N) = 0: GOSUB 1100 'Plasmar o limpiar
NEXT
IF A = 3 AND R(T) = M1 THEN K(M1 + 3) = 0: K(M1 - 4) = 0 'Desactiva control enroque
N3 = 0
IF A < 3 AND ABS(M1 - M2) = 16 THEN N3 = (M1 + M2) / 2 'Peon +2 activa al paso
SWAP T, TT 'Cambio de turno
GOTO 300
800 FOR V = 1 TO V(J) 'Simulacion
M = M(J, V) 'Casilla origen, destino y al paso
N(A(M, 1), A(M, 2)) = M(J, V1(V)) 'Pieza movida
FOR W = 0 TO 2
B(J, V, W) = A(M, W) 'Guarda tipo, bando y pieza
A(M, W) = B(J, V2(V), W) 'Destino
NEXT W, V
PP(J) = 1
810 NN(J) = N(TT, PP(J)) 'Casilla de la pieza
IF NN(J) = 0 GOTO 890 'Pieza activa
AA(J) = A(NN(J), 0) 'Tipo
DD(J) = 1
820 EE(J) = E(AA(J), DD(J)) 'Direccion
HH1(J) = H(NN(J), EE(J), AA(J)) 'Distancia
IF HH1(J) = 0 GOTO 880
HH(J) = 1
830 CC(J) = C(NN(J), EE(J), HH(J)) 'Casilla objetivo
IF A(CC(J), 1) = TT OR AA(J) < 3 AND (DD(J) = 2 EQV A(CC(J), 1) > 0) GOTO 850
'Pieza propia o peon sin uso
IF A(CC(J), 0) = 3 GOTO 900 'Rey rival
IF J AND J < 3 THEN J = J + 1: SWAP T, TT: M(J, 1) = NN(J - 1): M(J, 2) = CC(J - 1): GOTO 800
'Tercer nivel
850 IF A(CC(J), 0) GOTO 880 'Casilla ocupada
HH(J) = HH(J) + 1 'Siguiente distancia
IF HH(J) <= HH1(J) GOTO 830
880 DD(J) = DD(J) + 1 'Siguiente direccion
IF DD(J) <= D(AA(J)) GOTO 820
890 PP(J) = PP(J) + 1 'Siguiente pieza
IF PP(J) < 17 GOTO 810
J(J, S) = J(J, S) + 1 'Jugada permitida
900 FOR V = 1 TO V(J)
M = M(J, V) 'Casilla origen, destino y al paso
N(B(J, V, 1), B(J, V, 2)) = M 'Pieza movida
FOR W = 0 TO 2
A(M, W) = B(J, V, W) 'Recupera tipo, bando y pieza
NEXT W, V
IF J < 2 THEN RETURN
J = J - 1 'Baja un nivel
SWAP T, TT
IF J = 2 GOTO 850
IF J(3, S) < J3 THEN J3 = J(3, S) 'Minimo en tercer nivel
J(3, S) = 0
GOTO 850
1000 IF INKEY$ <> "" GOTO 1000 'Lectura de teclado
1010 A$ = INKEY$
IF A$ = "" GOTO 1010
IF A$ = CHR$(27) THEN IF SS - 1 THEN GOSUB 1100: GOTO 550 ELSE RUN
'Si no hay movimiento legal ESC reinicia, si lo hay vuelve a cursor
RETURN
1100 A = A(N, 0) 'Tipo de pieza
COLOR I(A(N, 1)), F(N) 'Tinta del bando y fondo de casilla
1200 FOR YY = 0 TO 2
LOCATE Y(N) + YY, X(N) 'Coordenadas
PRINT A$(A, YY); '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