SCREEN 1 'Pantalla grafica
DEFINT A-Y 'Variables enteras
DIM C(64, 7, 7) 'Casilla de origen,direccion y alcance
DIM IX(15), IY(15) 'Incremento segun direccion
DIM O(7, 7), H(7, 64, 7) 'Direccion para pieza y alcance
DIM A(32), T(32), N(32) 'Tipo, bando y casilla de pieza (0vacia,1PB,2PN,3C,4A,5T,6D,7R)
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), 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) 'Tinta, fondo
DIM JJ(200, 9), L(16), LL(16) 'Jugadas permitidas y control contadores
DIM MX(200), E(7, 64) 'Control ordenacion y destino repetido
DIM U(7, 7), D(15) 'Comprueba jaques y direccion de peon
DIM B$(7), D$(201, 2) 'Inicial y totales
DIM E$(200), C$(64), X$(64), Y$(64) 'Casillas
FOR V = 2 TO 199 'Totales
D$(V, 1) = RIGHT$(" " + STR$(V - 1), 4) + " "
D$(V, 2) = D$(V, 1)
NEXT
D$(0, 1) = "(0-1)"
D$(0, 2) = "(1-0)"
D$(1, 1) = "(«-«)"
D$(1, 2) = "(«-«)"
D$(200, 1) = "(«-«)"
D$(200, 2) = "(«-«)"
D$(201, 1) = "(1-0)"
D$(201, 2) = "(0-1)"
FOR D = 0 TO 15 'Direcciones posibles,del 8 al 15 para el caballo
L(D + 1) = 1 OR L(D) = 1 'Maximos y minimos
LL(D + 1) = 400 AND L(D) = 1
D(D) = 1 AND L(D) < 1 'Ataque de peon
READ IX(D), IY(D) 'Incremento segun direccion
NEXT
FOR A = 1 TO 7 'Tipo de pieza
READ B$(A), GG(A), D1(A), D2(A), D3(A) 'Inicial, alcance y direcciones
FOR D = D1(A) TO D2(A) STEP D3(A)
O(A, D) = 1
IF A < 3 * D(D) THEN U(A + L(A), D) = 2 'Alcance +1
IF A > 3 THEN U(A, D) = 8: U(7, D) = 2
NEXT D, A
I(1, 2) = 3 'Tinta
I(2, 1) = 3
FOR T = 1 TO 2 'Bando
R(T) = 56 * T - 51 'Casilla rey de inicio
PR(T) = 17 * T - 5 'Pieza del rey
P1(T) = 16 * T - 15 'Blancas
P2(T) = 16 * T 'Negras
FOR P = P1(T) TO P2(T) 'Pieza
READ A
A(P) = A 'Tipo de pieza
T(P) = T 'Bando
N(P) = 2 + 15 * T - L(T) * P 'Casilla para pieza
P(N(P)) = P 'Pieza para casilla
IF A < 3 THEN Q(N(P)) = A + L(A) 'Casillas origen de promocion
NEXT P, T
FOR N = 1 TO 64 'Casillas del tablero
Y = INT((N - 1) / 8) 'Fila
X = N - 1 - 8 * Y 'Columna
X$(N) = CHR$(X + 97)
Y$(N) = CHR$(Y + 49)
C$(N) = X$(N) + Y$(N) 'Casilla
F = 2 + (F = 2) 'Alterna fondo
F(N) = F 'Fondo de casilla
Y(N) = 24 * (7 - Y) 'Fila
X(N) = 24 * X 'Columna
GOSUB 2000 'Plasmar en pantalla
IF X = 7 THEN F = F(N - 1) 'Primera columna, repite fondo
FOR D = 0 TO 15 'Total de direcciones
H = 0 'Alcance
IX = IX(D) 'Incremento segun direccion
IY = IY(D)
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 'Supera los limites del tablero
IF D < 8 THEN H = H + 1: C(N, D, H) = XX + 8 * YY: GOTO 100 ELSE 'Casilla destino
C(N, D - 8, 0) = XX + 8 * YY: H(3, N, D - 8) = -1 'Destino y alcance del caballo
200 FOR A = 1 TO 7 * SGN(H) 'Si hay alcance
IF O(A, D) THEN 'Ajusta alcance segun direccion y pieza
IF A > 3 THEN H(A, N, D) = H 'Limite
IF A < 3 OR A = 7 THEN H(A, N, D) = 1: IF Q(N) = A + L(A) THEN H(A, N, D) = 2 - D(D)
END IF 'Peon al frente 2 inicial
NEXT A, D, 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) = D1(AA(J)) 'Direccion inicial
360 HH(J) = H(AA(J), NN(J), DD(J)) 'Alcance total
IF HH(J) = 0 GOTO 470 'No hay alcance
G(J) = GG(AA(J)) 'Alcance inicial (0 para el caballo)
380 CC(J) = C(NN(J), DD(J), G(J)) 'Casilla destino
IF T(P(CC(J))) = T GOTO 470 'Mismo bando
V(J) = 2 'Jugada simple
IF AA(J) = T THEN 'Rutina peon
IF D(DD(J)) = SGN(P(CC(J))) 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 2 * 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))) = 7 THEN JQ = 1: GOTO 500 'Rey amenazado
IF AA(J) = Q(NN(J)) THEN A(P(NN(J))) = 6: M(J, 0) = 6 'Promocion
IF AA(J) = 7 AND K(R(T)) = 0 THEN 'Rutina enroque
IF G(J) = 2 THEN IF P(CC(J)) + JQ(J) 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: HH(J) = 2 - JQ: M(J, 4) = CC(J): JQ = 0 'Sin jaque en inicio
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
B(J, V) = P(N) 'Guarda pieza de casilla
IF L(V) = 1 THEN N(P(N)) = M(J, V + 1): P(N) = 0 ELSE 'Origen
N(P(N)) = 0: P(N) = B(J, V - 1) '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 D = 0 TO 7 'Direcciones para busqueda de jaques
P = P(C(N, D, 0))
IF T(P) = TT AND A(P) = 3 THEN JQ = 1: D = 7 'Jaque con caballo
FOR G = 1 TO H(6, N, D)
P = P(C(N, D, G))
IF P THEN
IF T(P) = TT AND G < U(A(P), D) THEN JQ = 1: D = 7 'Jaque
G = 7
END IF
NEXT G, D
RETURN
450 IF M(J, 0) THEN
M(J, 0) = M(J, 0) - 1 'Subpromocion
IF AA(J) < A(P(NN(J))) THEN A(P(NN(J))) = M(J, 0): IF M(J, 0) > 2 GOTO 410
GOTO 450
END IF
IF P(CC(J)) = 0 AND G(J) < HH(J) THEN G(J) = G(J) + 1: GOTO 380 'Alcance mas
470 IF DD(J) < D2(AA(J)) THEN DD(J) = DD(J) + D3(AA(J)): GOTO 360 'Direccion mas
480 IF PP(J) < P2(T) THEN PP(J) = PP(J) + 1: GOTO 340 'Pieza siguiente
IF J(1, J) = 0 THEN GOSUB 440: J(1, J) = J(1, J) + 1 - JQ: JQ = 0 'Mate o ahogado
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
P(N) = B(J, V)
N(P(N)) = N
NEXT
JQ(J) = JQ
IF JQ GOTO 540
J(1, J) = J(1, J) + 2
IF J = MAX GOTO 450
IF J = 1 THEN
S = J(1, 1) / 2
E$(S) = ""
V = 1
520 IF J(V, V + 1) > 1 THEN 'Guarda valor mayor
JJ(S, V) = J(V, V + 1) / 2
IF V < MAX - 1 THEN V = V + 1: GOTO 520
ELSE JJ(S, V) = J(V, V + 1) - 1
JJ(S, V + 1) = 199 - JJ(S, V)
V = V + SGN(LL(MAX - V))
END IF
MX(S) = V
W(S) = V(1)
FOR V = 0 TO V(1) 'Guarda jugada
S(S, V) = M(1, V)
NEXT
E = E(AA(1), CC(1))
IF E AND AA(1) > 2 THEN 'Repite pieza a destino
E$(S) = X$(NN(1)) 'Letra columna
E$(E) = X$(S(E, 1))
IF E$(S) = E$(E) THEN E$(S) = Y$(NN(1)): E$(E) = Y$(S(E, 1))
ELSE E(AA(1), CC(1)) = S
END IF
ELSE FOR V = 1 TO MAX - J 'Evaluar contadores
IF L(V) = SGN(J(V + 1, J + V) - J(V, J + V)) THEN J(V + 1, J + V) = J(V, J + V)
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 JJ = J(1, 1) / 2 'Total jugadas
FOR V = 1 TO JJ 'Reinicio repetidos
E(A(P(S(V, 1))), S(V, 2)) = 0
NEXT
Z = TIMER - ZT + .1
M = R(T) 'Casilla del rey en origen
LOCATE 1, 26
PRINT "Tiempo="; LEFT$(STR$(Z), 5); " "
LOCATE 2, 27
PRINT "Nivel="; MAX
JJ(0, 0) = LL(MAX) - 2 * L(MAX)
FOR V = 1 TO 5 'Ordenar maximos o minimos
C$ = " "
S = 0
FOR W = 1 TO JJ
L = SGN(JJ(W, ABS(MX(W))) - JJ(S, MX(S)))
IF MX(W) > 0 AND (L = L(MAX) OR L = 0 AND MX(W) < MX(S)) THEN S = W
NEXT
MX(S) = -MX(S)
IF S THEN 'Mejor eleccion en pantalla
GOSUB 1500
X = 2 - SGN(LL(T + MAX))
D$ = D$(JJ(S, -MX(S)) + 1, X) 'Totales
IF X = 1 THEN C$ = D$ + B$ + " " ELSE C$ = " " + B$ + D$
END IF
LOCATE 3 + V, 25
PRINT C$
NEXT
610 FOR V = 10 TO 16
LOCATE V, 25
IF V = 10 THEN PRINT " BLANCAS NEGRAS" ELSE PRINT " "
NEXT
LOCATE 12, 15 + 10 * T
IF JJ THEN PRINT D$(JJ + 1, T) ELSE PRINT D$(J(1, 1), T) 'Total de jugadas
N = M 'Origen
A = A(P(N)) 'Pieza
I = T(P(N)) 'Tinta
F = I(T, 2) 'Fondo
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
G(0) = 0
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 = 7 THEN PR(T) = P
P = P2(T)
END IF
NEXT
GOTO 250
620 S = JJ + 1 AND A$ = "K" 'Numero de movimiento
N = 0 'Control posible/no posible
630 S = S + (1 OR A$ = "K") 'Movimiento siguiente
IF S <= JJ AND S GOTO 640 'Salta si esta en rango
IF N GOTO 620 'Misma pieza
GOTO 610 'Vueve al cursor
640 IF S(S, 1) <> M GOTO 630 'No coincide con la elegida
GOSUB 1500
LOCATE 11, 18 + 8 * T
PRINT B$
X = T
Y = 12
FOR V = 1 TO MAX 'Plasmar maximos
X = X + 1
IF X = 3 THEN X = 1: Y = Y + 1
LOCATE Y, 15 + 10 * X
IF V > ABS(MX(S)) OR JJ(S, V) > 198 THEN PRINT " " ELSE PRINT D$(JJ(S, V) + 1, X)
NEXT
N = C
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 - C) / 8
IF S(S, 0) THEN A(P(M)) = S(S, 0) 'Promocion
NN(0) = M 'Casilla origen
CC(0) = C 'Casilla destino
FOR V = 1 TO W(S) 'Realiza movimiento
N = S(S, V)
K(N) = 1
B(0, V) = P(N)
IF L(V) = 1 THEN N(P(N)) = S(S, V + 1): P(N) = 0 ELSE 'Origen
N(P(N)) = 0: P(N) = B(0, V - 1) 'Destino
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 JJ > 0 THEN GOSUB 2000: GOTO 610 ELSE SYSTEM
'Si no hay movimiento legal ESC finaliza, si lo hay vuelve a cursor
RETURN
1500 N = S(S, 1) 'Origen
C = S(S, 2) 'Destino
A = A(P(N))
B$ = B$(A) 'Inicial
IF A < 3 AND ASC(C$(N)) - ASC(C$(C)) THEN E$(S) = X$(N) 'Peon captura
B$ = B$ + E$(S) 'Inicial de origen
IF P(C) THEN B$ = B$ + "x" 'Captura
B$ = B$ + C$(C) 'Destino
IF S(S, 0) THEN A = S(S, 0): B$ = B$ + B$(A) 'Promocion
IF A = 7 THEN
IF C - N = 2 THEN B$ = "0-0"
IF N - C = 2 THEN B$ = "0-0-0"
END IF
B$ = SPACE$(5 - LEN(B$)) + B$
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 CABALLO
IF A = 4 THEN RESTORE ALFIL
IF A = 5 THEN RESTORE TORRE
IF A = 6 THEN RESTORE DAMA
IF A = 7 THEN RESTORE REY
FOR YY = Y(N) + 2 TO Y(N) + 22
READ P$
FOR XX = 1 TO 22
W = VAL(MID$(P$, XX, 1))
IF W THEN PSET (X(N) + XX, YY), I(I, W)
NEXT XX, YY
END IF
RETURN
'Incremento segun direccion
DATA -1,1,0,1,1,1,1,0,1,-1,0,-1,-1,-1,-1,0
DATA 1,2,2,1,2,-1,1,-2,-1,-2,-2,-1,-2,1,-1,2
'Piezas,control caballo,direccion de inicio, final y pasos
DATA "",1,0,2,1
DATA "",1,4,6,1
DATA "C",0,0,7,1
DATA "A",1,0,6,2
DATA "T",1,1,7,2
DATA "D",1,0,7,1
DATA "R",1,0,7,1
'Tipo de piezas
DATA 1,1,1,1,1,1,1,1,5,3,4,7,6,4,3,5
DATA 2,2,2,2,2,2,2,2,5,3,4,6,7,4,3,5
PEON:
DATA 0000000000000000000000
DATA 0000000001111000000000
DATA 0000000012222100000000
DATA 0000000122222210000000
DATA 0000000122222210000000
DATA 0000000122222210000000
DATA 0000000012222100000000
DATA 0000000001221000000000
DATA 0000000111111110000000
DATA 0000001222222221000000
DATA 0000000111111110000000
DATA 0000000001221000000000
DATA 0000000001221000000000
DATA 0000000012222100000000
DATA 0000000122222210000000
DATA 0000001222222221000000
DATA 0000001222222221000000
DATA 0000011111111111100000
DATA 0000122222222222210000
DATA 0000111111111111110000
DATA 0000000000000000000000
CABALLO:
DATA 0000000001000000000000
DATA 0000000001100110000000
DATA 0000000001211221000000
DATA 0000000011222122100000
DATA 0000000122222212210000
DATA 0000001222222221221000
DATA 0000012221122221221000
DATA 0000012221222221221000
DATA 0000122222222221221000
DATA 0001222222222222122100
DATA 0012222222222222122100
DATA 0122222222212222122100
DATA 0122122211122222122100
DATA 0011221100122222212210
DATA 0000110001222222212210
DATA 0000000001222222212210
DATA 0000000012222222212210
DATA 0000000012222222212210
DATA 0000000122222222212210
DATA 0000001111111111111110
DATA 0000000000000000000000
ALFIL:
DATA 0111111111111111000000
DATA 0012222222222222100000
DATA 0001222211111112210000
DATA 0000112122222221221000
DATA 0000001222222222122100
DATA 0000012222222222212210
DATA 0000121222222222221210
DATA 0001222121122222221210
DATA 0012212212212222221210
DATA 0122122221212222221210
DATA 0012212212212222221210
DATA 0001222121122222221210
DATA 0000121222222222212210
DATA 0000012222222222101210
DATA 0000001122222221001210
DATA 0000000012222210000110
DATA 0000001122222221100000
DATA 0000012222222222211000
DATA 0000122222211122222100
DATA 0001222211100011111100
DATA 0011111100000000000000
TORRE:
DATA 0000000000000000000000
DATA 0001111001111001111000
DATA 0001221001221001221000
DATA 0001221001221001221000
DATA 0001221111221111221000
DATA 0001222222222222221000
DATA 0001222222222222221000
DATA 0001111111111111111000
DATA 0000012222222222100000
DATA 0000012222222222100000
DATA 0000012222222222100000
DATA 0000012222222222100000
DATA 0000012222222222100000
DATA 0000012222222222100000
DATA 0000012222222222100000
DATA 0000111111111111110000
DATA 0001222222222222221000
DATA 0001222222222222221000
DATA 0011111111111111111100
DATA 0122222222222222222210
DATA 0111111111111111111110
DAMA:
DATA 0000000110000110000000
DATA 0000001221001221000000
DATA 0110001221001221000110
DATA 1221000110000110001221
DATA 1221000110000110001221
DATA 0121000121001210001210
DATA 0012100121001210012100
DATA 0001210121001210121000
DATA 0000121122112211210000
DATA 0000122122112212210000
DATA 0000122222222222210000
DATA 0000122222222222210000
DATA 0000122222222222210000
DATA 0001111111111111111000
DATA 0012222222222222222100
DATA 0001111111111111111000
DATA 0000122212222122210000
DATA 0000122212222122210000
DATA 0001111111111111111000
DATA 0012222222222222222100
DATA 0011111111111111111100
REY:
DATA 0000000000110000000000
DATA 0000000011221100000000
DATA 0000000000110000000000
DATA 0001110001221000111000
DATA 0012221012222101222100
DATA 0122222101221012222210
DATA 0122212210110122122210
DATA 0122121221001221212210
DATA 0122122122112212212210
DATA 0012212212222122122100
DATA 0001221221221221221000
DATA 0000122122112212210000
DATA 0000122212222122210000
DATA 0001111111111111111000
DATA 0012222222222222222100
DATA 0001111111111111111000
DATA 0000122212222122210000
DATA 0000122212222122210000
DATA 0001111111111111111000
DATA 0012222222222222222100
DATA 0011111111111111111100