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, 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), K(64), Q(64) 'Casilla rey ,control de enroque y promocion
DIM I(2), F(64), A$(7, 2) 'Tinta, fondo y caracter pieza
DIM J(9, 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
NEXT
FOR A = 0 TO 7 'Tipo de pieza
Q(A + 9) = 2 'Casillas de promocion
Q(A + 49) = 1
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
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) = 32 * T - 32 + P 'Casilla para pieza
P(N(P)) = P 'Pieza para casilla
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, D, A)=H: IF A < 4 THEN H(N, D, A)=1 - (A < 3 AND D = 2 AND A(P(N)) = A)
'Ajusta distancia segun direccion y pieza (Peon al frente 2 inicial)
NEXT D, A, E, N
T = 1 'Turno
TT = 2
MAX = 5 'Profundidad de calculo
300 J = 1 'Inicio rutina principal
S = 1
JQ = 0 'Rey no amenazado
320 PP(J) = P1(T) 'Numero de pieza
340 NN(J) = N(PP(J)) 'Casilla de la pieza
IF NN(J) = 0 GOTO 470 '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 460 '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 450 'Mismo bando
IF AA(J - 1) = 3 AND G(J - 1) = 2 THEN IF CC(J) = R(TT) OR CC(J) = M(J - 1, 4) THEN JQ = 1: GOTO 500
'Casillas enroque amenazadas
V(J) = 2 'Jugada simple
IF AA(J) > 2 GOTO 400 '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 OR J = MAX GOTO 460 'No evalua al paso
IF CC(J) = (NN(J - 1) + CC(J - 1)) / 2 THEN V(J) = 4: M(J, 3) = 0: M(J, 4) = CC(J - 1) ELSE GOTO 460
'Casilla de captura al paso
400 IF A(P(CC(J))) = 3 THEN JQ = 1: GOTO 500 'Rey amenazado
IF J = MAX GOTO 450 'Nivel maxino no se simula
IF AA(J) = Q(NN(J)) THEN A(P(NN(J))) = 7: M(J, 3) = 7 'Promocion
IF AA(J) <> 3 OR K(R(T)) GOTO 410 'Rutina enroque
IF G(J) = 2 THEN IF P(CC(J)) GOTO 460 ELSE V(J) = 4: GOTO 410
M(J, 4) = CC(J) 'Destino enroque
IF DD(J) = 3 AND K(R(T) + 3) = 0 THEN GG(J) = 2: M(J, 3) = R(T) + 3 'Origen enroque
IF DD(J) = 7 AND K(R(T) - 4) = 0 AND A(P(R(T) - 3)) = 0 THEN GG(J) = 2: M(J, 3) = R(T) - 4
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 = 1 THEN FOR V = 1 TO 4: J1(V) = 0: J2(V) = 200: NEXT: J3(4) = 0 'Contadores
J = J + 1 'Nivel siguiente
SWAP T, TT 'Cambio de bando
GOTO 320
420 IF J1(3) < J2(3) THEN J2(3) = J1(3) 'Contador nivel 3
IF J3(4) < J2(4) THEN J3(4) = J2(4) 'Guarda nivel 4
425 J1(3) = 0
J1(4) = 0
J2(4) = 200
GOTO 440
430 IF J1(4) < J2(4) THEN J2(4) = J1(4) 'Contador nivel 4
435 J1(4) = 0
440 IF AA(J) = A(P(NN(J))) GOTO 450
M(J, 3) = M(J, 3) - 1 'Subpromocion
IF M(J, 3) > 3 THEN A(P(NN(J))) = M(J, 3): GOTO 410
A(P(NN(J))) = AA(J)
450 IF P(CC(J)) GOTO 460 'Casilla ocupada
IF G(J) < GG(J) THEN G(J) = G(J) + 1: GOTO 380 'Alcance mas
460 IF DD(J) < D(AA(J)) THEN DD(J) = DD(J) + 1: GOTO 360 'Direccion mas
470 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 'Fin busqueda de jugadas
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
SWAP T, TT
IF JQ THEN JQ = 0: ON J GOTO 440, 425, 435, 440 'Hubo jaque
J1(J) = J1(J) + 1
ON J - 1 GOTO 420, 430, 440
J(2, S) = J1(2) 'Guarda valor mayor
J(3, S) = J2(3) * SGN(J1(2))
J(4, S) = J3(4) * SGN(J2(3))
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
S = S + 1 'Aumenta jugadas posibles
GOTO 440
600 SS = S
M = R(T) 'Casilla del rey en origen
610 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 = M 'Origen
A = A(P(N))
F = F(N) 'Fondo
IF T(P(N)) = TT THEN F = I(TT)
COLOR F, I(T) 'Invierte tinta y fondo simulando cursor
GOSUB 1200 'Plasmar pieza
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 1100 'Plasmar casilla normal
GOTO 610 'Vuelve a cursor
620 S = SS AND A$ = "K" 'Numero de movimiento
N = 0 'Control posible/no posible
630 S = S + (1 OR A$ = "K") 'Movimiento siguiente
IF S < SS 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
COLOR 7, 0
LOCATE 47 - 23 * TT, 26
PRINT J(2, S); J(4, S); " "; 'Jugadas del rival
LOCATE 47 - 23 * T, 30
PRINT J(3, S); " "; 'Propias
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
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 1100 'Plasmar o limpiar
NEXT
SWAP T, TT
GOTO 300
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 SS - 1 THEN GOSUB 1100: GOTO 610 ELSE RUN
'Si no hay movimiento legal ESC reinicia, si lo hay vuelve a cursor
RETURN
1100 A = A(P(N)) 'Tipo de pieza
COLOR I(T(P(N))), 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
El árbol de variantes alcanza el nivel 5 por lo que el tiempo de ejecución es elevado.