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), B(64) 'Tipo de pieza en casilla y bando (0vacia,1PB,2PN,3R,4C,5A,6T,7D)
DIM N(2, 16), P(64) 'Situacion de pieza por bando y pieza en casilla
DIM M(200, 2) 'Jugadas posibles
DIM X(64), Y(64) 'Coordenadas para casillas
DIM G(64), K(64), Q(64) 'Casilla amenazada,ya usada y fila de coronacion
DIM T(2), F(64), A$(7, 2) 'Tinta, fondo y caracter pieza
FOR N = 1 TO 8
Q(N + 32) = 1 'Casillas de captura al paso
Q(N + 24) = 2
Q(N) = 3 'Casillas de coronacion
Q(N + 56) = 3
NEXT
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
FOR P = 1 TO 16 'Pieza
READ A 'Tipo de pieza
N = 48 * T - 48 + P 'Casilla inicial segun bando
A(N) = A 'Tipo de pieza en casilla
B(N) = T 'Bando
N(T, P) = N 'Casilla para pieza
P(N) = P 'Pieza para casilla
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)
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)
'Ajustando distancia segun direccion y pieza (Peon al frente 0)
NEXT
NEXT A, E, N
T = 1 'Bando en juego
TT = 2 'Bando contrario
300 FOR P = 1 TO 16 'Casillas amenazadas
N = N(TT, P) 'Casilla pieza rival
A = A(N) 'Tipo de pieza (0,7)
FOR D = 1 TO D(A) 'Direcciones de ataque
E = E(A, D) 'Direccion (de 0 a 15 sentido agujas del reloj)
FOR H = 1 TO H(N, E, A) 'Distancia
C = C(N, E, H) 'Casilla objetivo
G(C) = 1 'Activa amenaza
IF A(C) THEN H = 7 'Fin si esta ocupada
NEXT H, D, P
M = 0 'Jugadas posibles
FOR P = 1 TO 16 'Piezas bando en juego
N = N(T, P) 'Casilla de la pieza
A = A(N) 'Tipo
FOR D = 1 TO D(A) 'Numero de direcciones
E = E(A, D) 'Direccion
H1 = H(N, E, A) 'Distancia
IF A < 3 AND D = 2 THEN H1 = 2 - K(N) 'Habilitando peon al frente
IF A = 3 AND K(N) = 0 AND G(N) = 0 AND H1 THEN H1 = 2 'Habilitando enroque
FOR H = 1 TO H1
C = C(N, E, H) 'Casilla (1,64)
IF B(C) = T THEN H = H1: GOTO 450 'Ocupada, siguiente direccion
IF A > 2 GOTO 350 'Rutina del peon
IF D = 2 THEN IF A(C) = 0 GOTO 400 ELSE H = H1: GOTO 450
'Validar si el destino esta libre hacia adelante
IF A(C) GOTO 400 'Validar si hay captura lateral
IF Q(N) <> T GOTO 450 'Zona de captura al paso
N2 = C - 8 'Casilla de captura al paso (blancas)
IF A = 1 AND A(N2) = 2 AND N0 = C + 8 AND N1 = N2 GOTO 400
'Condiciones=Peones opuestos y ultimo movimiento de salto a destino
N2 = C + 8
IF A = 2 AND A(N2) = 1 AND N0 = C - 8 AND N1 = N2 GOTO 400
N2 = 0 'Si no es valida poner a cero
GOTO 450
350 IF A > 3 GOTO 400 'Rutina del rey
IF G(C) THEN H = H1: GOTO 450 'Casilla destino amenazada
IF H = 1 GOTO 400 'Primer movimiento
IF A(C) GOTO 450 'Casilla ocupada para enroque
IF E = 2 AND K(C + 1) = 0 GOTO 400 'Torre no movida
IF E = 6 AND A(C - 1) = 0 AND K(C - 2) = 0 GOTO 400 'Casilla del caballo libre
GOTO 450
400 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
N2 = 0
IF A(C) THEN H = H1 'Siguiente por captura
450 NEXT H, D, P
J = 0 'Jugadas no validas por quedar el rey en jaque
FOR S = 1 TO M 'Total de movimientos
N0 = M(S, 0) 'Origen
N1 = M(S, 1) 'Destino
N2 = M(S, 2) 'Al paso
FOR P = 1 TO 16 'Piezas rivales
N = N(TT, P) 'Casilla de la pieza
IF N = N1 OR N = N2 GOTO 510 'Si es capturada no cuenta
A = A(N) 'Tipo
IF A = 3 GOTO 510 'El rey no da jaque
FOR D = 1 TO D(A) 'Direcciones
E = E(A, D) 'Direccion
FOR H = 1 TO H(N, E, A)
C = C(N, E, H) 'Casilla objetivo
IF C = N0 OR C = N2 OR A(C) = 0 AND C <> N1 GOTO 500 'Se considera vacia
H = 7
IF C = N1 AND A(N0) = 3 THEN J = J + 1: M(S, 0) = 0: D = 8: P = 16 'Jaque
IF A(C) = 3 AND B(C) = T THEN J = J + 1: M(S, 0) = 0: D = 8: P = 16
500 NEXT H, D
510 NEXT P, S 'Analizar siguiente movimiento
COLOR 7, 0
LOCATE 1, 28
PRINT "Total="; M - J; 'Total de jugadas menos las no validas
NN = 56 * T - 51 'Casilla del rey en origen
550 N = NN
A = A(N)
F = F(N)
IF B(N) = TT THEN F = T(B(N))
COLOR F, T(T) 'Invertimos 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 NN < 64 THEN NN = NN + 1
IF A$ = "K" AND NN > 1 THEN NN = NN - 1
IF A$ = "H" AND NN < 57 THEN NN = NN + 8
IF A$ = "P" AND NN > 8 THEN NN = NN - 8
GOSUB 1090 'Plasmar casilla normal
GOTO 550 'Vuelve a cursor
600 IF B(N) <> T GOTO 550 'Solo piezas propias
610 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 610 'Misma pieza
640 N0 = M(S, 0) 'Origen
IF N0 <> NN GOTO 630 'No coincide con la elegida
N = M(S, 1) 'Destino
A = A(N0) 'Tipo
IF A < 3 AND Q(N) = 3 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 confirmamos jugada
IF A THEN N(TT, P(N)) = 0 'Pieza capturada
680 P(N) = P(N0) 'Pieza en casilla igual a la de origen
P(N0) = 0
N(T, P(N)) = N 'Casilla de pieza, la de destino
A = A(N0) 'Tipo de pieza de origen
IF Q THEN A = Q 'Hubo promocion
A(N) = A 'Asignar tipo, bando y casilla usada de destino
B(N) = T
K(N) = 1
N1 = N
N = N0
A(N) = 0 'Asignar tipo, bando y casilla usada de origen
B(N) = 0
K(N) = 1
GOSUB 1090 'Vaciar origen
N = N1
GOSUB 1090 'Plasmar destino
IF A <> 3 GOTO 690 'Comprobar enroque
N = (N0 + N) / 2 'Destino torre
IF N0 - N1 = 2 THEN N0 = N0 - 4: GOTO 680 'Origen torre
IF N1 - N0 = 2 THEN N0 = N0 + 3: GOTO 680
690 N = M(S, 2) 'Al paso?
IF N = 0 GOTO 700 'No
A(N) = 0
B(N) = 0
N(TT, P(N)) = 0 'Peon de al paso desactivado
P(N) = 0
GOSUB 1090 'Vaciar casilla
700 FOR N = 1 TO 64 'Normalizar casillas amenazadas
G(N) = 0
NEXT
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 - J THEN GOSUB 1090: GOTO 550 ELSE RUN
'Si no hay movimiento legal ESC reinicia, si lo hay vuelve a cursor
RETURN
1090 A = A(N) 'Tipo de pieza
COLOR T(B(N)), F(N) 'Tinta del bando y fondo de casilla
1100 FOR V = 0 TO 2
LOCATE Y(N) + V, X(N) 'Coordenadas
PRINT A$(A, V); '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
