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 S(200, 2) 'Jugadas posibles
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 M(200), E(7, 64) 'Control ordenacion y destino repetido
DIM U(7, 7), D(15) 'Comprueba jaques y direccion ataque de peon
DIM B$(7), D$(200, 2) 'Inicial y totales
DIM E$(200), C$(64), X$(64), Y$(64) 'Repetidos y casillas
FOR V = 2 TO 198 '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$(199, 1) = "(«-«)"
D$(199, 2) = "(«-«)"
D$(200, 1) = "(1-0)"
D$(200, 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 THEN H(A, N, D) = 1: IF A(P(N)) = A THEN H(A, N, D) = 2 - D(D)
IF A = 7 THEN H(A, N, D) = 1: IF A(P(N)) = 7 AND (D = 7 OR D = 3) THEN H(A, N, D) = 2
END IF 'Peon al frente inicial y enroque =2
NEXT A, D, N
T = 1 'Turno
TT = 2
250 M = 2 'Profundidad de calculo
GOTO 540
300 ZT = TIMER
J = 1 'Inicio rutina principal
320 PN1(J) = P1(T) 'Numero de pieza
340 N1(J) = N(PN1(J)) 'Casilla de la pieza
IF N1(J) = 0 GOTO 480 'Pieza nula
AA(J) = A(PN1(J)) 'Tipo de pieza
DD(J) = D1(AA(J)) 'Direccion inicial
360 HH(J) = H(AA(J), N1(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 N2(J) = C(N1(J), DD(J), G(J)) 'Casilla destino
PN2(J) = P(N2(J))
IF T(PN2(J)) = T GOTO 470 'Mismo bando
IF AA(J) = T THEN 'Rutina peon
IF D(DD(J)) = SGN(PN2(J)) GOTO 400 'Peon util
IF PN2(J) OR AA(J - 1) > 2 OR G(J - 1) < 2 GOTO 470 'No evalua al paso
IF 2 * N2(J) = N1(J - 1) + N2(J - 1) THEN N3(J) = 2: N4(J) = N2(J - 1) ELSE GOTO 470
END IF 'Casilla de captura al paso
400 IF A(PN2(J)) = 7 THEN JQ = 1: GOTO 500 'Rey amenazado
IF AA(J) = Q(N1(J)) THEN A(PN1(J)) = 6: N0(J) = 6 'Promocion
IF AA(J) = 7 AND G(J) = 2 THEN 'Rutina enroque
IF K(R(T)) + PN2(J) + JQ(J) GOTO 470 'Rey movio, destino ocupado, intermedia con amenaza
GOSUB 440
IF JQ THEN JQ = 0: GOTO 470 'Jaque en origen
IF DD(J) = 3 AND K(R(T) + 3) = 0 THEN N3(J) = R(T) + 3 'Enroque corto
IF DD(J) = 7 AND K(R(T) - 4) = 0 AND P(R(T) - 3) = 0 THEN N3(J) = R(T) - 4
IF N3(J) = 0 GOTO 470
N4(J) = (N1(J) + N2(J)) / 2 'Destino torre
END IF
410 K(N1(J)) = K(N1(J)) + 1 'Casilla origen usada
K(N2(J)) = K(N2(J)) + 1 'Destino
N(PN1(J)) = N2(J)
N(PN2(J)) = 0
P(N1(J)) = 0
P(N2(J)) = PN1(J)
IF N3(J) THEN
IF N3(J) = 2 THEN 'Al paso
PN4(J) = P(N4(J))
N(PN4(J)) = 0
P(N4(J)) = 0
ELSE PN3(J) = P(N3(J)) 'Torre de enroque
N(PN3(J)) = N4(J)
P(N3(J)) = 0
P(N4(J)) = PN3(J)
END IF
END IF
IF J < M 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: EXIT FOR '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
EXIT FOR
END IF
NEXT G, D
RETURN
450 IF N0(J) THEN
N0(J) = N0(J) - 1 'Subpromocion
IF AA(J) < A(PN1(J)) THEN A(PN1(J)) = N0(J): IF N0(J) > 2 GOTO 410
GOTO 450
END IF
IF PN2(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 PN1(J) < P2(T) THEN PN1(J) = PN1(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 K(N1(J)) = K(N1(J)) - 1 'Restaura jugada simulada
K(N2(J)) = K(N2(J)) - 1
N(PN1(J)) = N1(J)
N(PN2(J)) = N2(J)
P(N1(J)) = PN1(J)
P(N2(J)) = PN2(J)
IF N3(J) THEN
IF N3(J) = 2 THEN 'Al paso
N(PN4(J)) = N4(J)
P(N4(J)) = PN4(J)
ELSE N(PN3(J)) = N3(J) 'Enroque
P(N3(J)) = PN3(J)
P(N4(J)) = 0
END IF
N3(J) = 0
END IF
JQ(J) = JQ
IF JQ GOTO 540
J(1, J) = J(1, J) + 2
IF J = M GOTO 450
IF J > 1 THEN
FOR V = 1 TO M - 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
ELSE S = J(1, 1) / 2 'Guarda jugada
E$(S) = ""
M(S) = M - 1
FOR V = 1 TO M(S)
IF J(V, V + 1) > 1 THEN 'Guarda valor mayor
JJ(S, V) = J(V, V + 1) / 2 + 1
ELSE JJ(S, V) = J(V, V + 1) 'Mate o ahogado
JJ(S, V + 1) = 200 - JJ(S, V)
M(S) = V + SGN(LL(M - V))
EXIT FOR
END IF
NEXT
S(S, 0) = N0(1)
S(S, 1) = N1(1)
S(S, 2) = N2(1)
E = E(AA(1), N2(1))
IF E AND AA(1) > 2 THEN 'Repite pieza a destino
E$(S) = X$(N1(1)) 'Letra columna
E$(E) = X$(S(E, 1))
IF E$(S) = E$(E) THEN E$(S) = Y$(N1(1)): E$(E) = Y$(S(E, 1))
ELSE E(AA(1), N2(1)) = S
END IF
END IF
540 JQ = 0
FOR V = J TO M - 1 'Reinicio de contadores
FOR W = 1 TO M - 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
N1 = R(T) 'Casilla del rey en origen
LOCATE 1, 26
PRINT "Tiempo="; LEFT$(STR$(Z), 5); " "
LOCATE 2, 27
PRINT "Nivel="; M
JJ(0, 0) = LL(M) - 1
FOR V = 1 TO 5 'Ordenar maximos o minimos
C$ = " "
S = 0
FOR W = 1 TO JJ
L = SGN(JJ(W, ABS(M(W))) - JJ(S, M(S)))
IF M(W) > 0 AND (L = L(M) OR L = 0 AND M(W) < M(S)) THEN S = W
NEXT
M(S) = -M(S)
IF S THEN 'Mejor eleccion en pantalla
GOSUB 1500
X = 2 - SGN(LL(T + M))
D$ = D$(JJ(S, -M(S)), 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 = N1 '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 N1 < 64 THEN N1 = N1 + 1
IF A$ = "K" AND N1 > 1 THEN N1 = N1 - 1
IF A$ = "H" AND N1 < 57 THEN N1 = N1 + 8
IF A$ = "P" AND N1 > 8 THEN N1 = N1 - 8
GOSUB 2100 'Plasmar casilla normal
IF A$ = "+" AND M < 9 THEN M = M + 1: GOTO 540
IF A$ = "-" AND M > 2 THEN M = M - 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
EXIT FOR
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 'Vuelve al cursor
640 IF S(S, 1) <> N1 GOTO 630 'No coincide con la elegida
GOSUB 1500
LOCATE 11, 18 + 8 * T
PRINT B$
X = T
Y = 12
FOR V = 1 TO M 'Plasmar maximos
X = X + 1
IF X = 3 THEN X = 1: Y = Y + 1
LOCATE Y, 15 + 10 * X
IF V > ABS(M(S)) OR JJ(S, V) > 198 THEN PRINT " " ELSE PRINT D$(JJ(S, V), X)
NEXT
N = N2
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(N1))
G(0) = 0 'Control al paso
IF AA(0) < 3 THEN
IF S(S, 0) THEN A(P(N1)) = S(S, 0) 'Promocion
G(0) = ABS(N1 - N2) / 8 'Al paso posible
IF ABS(N1 - N2) / 8 <> G(0) AND P(N2) = 0 THEN N = N2(0): N(P(N)) = 0: P(N) = 0: GOSUB 2100
END IF
N1(0) = N1 'Casilla origen
N2(0) = N2 'Casilla destino
K(N1) = 1 'Casilla origen usada
K(N2) = 1 'Destino
650 N(P(N1)) = N2
N(P(N2)) = 0
P(N2) = P(N1)
P(N1) = 0
N = N1
GOSUB 2100
N = N2
GOSUB 2100
IF A = 7 AND ABS(N1 - N2) = 2 THEN N2 = (N1 + N2) / 2: N1 = N3: GOTO 650
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
N2 = S(S, 2) 'Destino
A = A(P(N))
B$ = B$(A) 'Inicial de pieza
IF A < 3 AND ASC(C$(N)) - ASC(C$(N2)) THEN E$(S) = X$(N) 'Peon captura
B$ = B$ + E$(S) 'Inicial de origen
IF P(N2) THEN B$ = B$ + "x" 'Captura
B$ = B$ + C$(N2) 'Destino
IF S(S, 0) THEN A = S(S, 0): B$ = B$ + B$(A) 'Promocion
IF A = 7 AND N2 - N = 2 THEN B$ = "0-0": N3 = N2 + 1 'Enroque
IF A = 7 AND N - N2 = 2 THEN B$ = "0-0-0": N3 = N2 - 2
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
