SCREEN 13 'Pantalla grafica
DEFINT A-Z 'Variables enteras
DIM n(64, 7, 7) 'Casilla de origen, direccion, alcance = Casilla destino
DIM h(7, 64, 7) 'Tipo de pieza, casilla, direccion = Alcance
DIM Ix(15), Iy(15) 'Incremento segun direccion
DIM g(7), d1(7), d2(7), d3(7) 'Direcciones
DIM u(7, 7), d(7) 'Comprueba jaques y avance del peon
DIM a(32), t(32), c(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), J(9, 9), JJ(200, 9) 'Control de jugadas
DIM r(2), pr(2) 'Casilla y pieza del rey
DIM k(64), Q(64) 'Control de enroque y promocion
DIM i(2, 2), f(64) 'Tinta, fondo
DIM L(9), LL(9) ' Control contadores
DIM e(7, 64) 'Direcciones segun tipo
DIM x(64), y(64) 'Coordenadas para casillas
DIM aa(9), dd(9), gg(9), hh(9) 'Rutina principal
DIM c0(9), c1(9), c2(9), c3(9), c4(9) 'Casillas
DIM pc1(9), pc2(9), pc3(9), pc4(9) 'Piezas
DIM pieza(5, 23, 23)
DIM z(7), R$(2)
LOCATE 1, 26:
PRINT "Blancas Negras"
LOCATE 2, 26
PRINT "------- ------"
R$(1) = "(0-1)"
R$(2) = "(1-0)"
r(1) = 5: r(2) = 61 'Casilla rey de inicio
p1(1) = 1: p2(1) = 16 'Blancas de 1 a 16
p1(2) = 17: p2(2) = 32 'Negras de 17 a 32
i(1, 1) = 0: i(1, 2) = 15 'Perfil
i(2, 1) = 15: i(2, 2) = 0
d(1) = 2: d(5) = 1 'Peon al frente
L(1) = 1: L(2) = -1: L(3) = 1: L(4) = -1: L(5) = 1: L(6) = -1: L(7) = 1: L(8) = -1: L(9) = 1
LL(2) = 400: LL(4) = 400: LL(6) = 400: LL(8) = 400
FOR d = 0 TO 15 'Direcciones posibles,del 8 al 15 para el caballo
t(d + 1) = 1
t(d + 17) = 2
READ Ix(d), Iy(d) 'Incremento segun direccion
NEXT
FOR a = 1 TO 7 'Tipo de pieza
READ z(a), gg(a), d1(a), d2(a), d3(a) 'Pieza,caballo, alcance y direcciones
FOR d = d1(a) TO d2(a) STEP d3(a)
e(a, d) = 1
IF a < 3 AND d(d) = 0 THEN u(a + L(a), d) = 2 'Alcance +1
IF a > 3 THEN u(a, d) = 8: u(7, d) = 2
NEXT d, a
p2 = 33
FOR v = 0 TO 7
FOR w = 7 TO 0 STEP -1
c = 64 - 8 * v - w
READ a
IF a > 0 THEN p1 = p1 + 1: a(p1) = a: c(p1) = c: p(c) = p1: IF a = 7 THEN pr(1) = p1
IF a < 0 THEN p2 = p2 - 1: a(p2) = -a: c(p2) = c: p(c) = p2: IF a = -7 THEN pr(2) = p2
NEXT w, v
FOR c = 1 TO 64: READ Q(c): NEXT
FOR a = 0 TO 5: FOR v = 0 TO 23: READ p$: FOR w = 0 TO 23
pieza(a, v, w) = ASC(MID$(p$, w + 1, 1)) - 48
NEXT w, v, a
FOR c = 1 TO 64 'Casillas del tablero
y = (c - 1) \ 8 'Fila
x = c - 8 * y 'Columna
y(c) = 24 * (7 - y)
x(c) = 24 * x - 24
f(c) = 1 - 2 * (f = 1) 'Alterna fondo
a = a(p(c))
i = t(p(c))
f = f(c)
i(i, 0) = f
ii = f
FOR v = 0 TO 23: FOR w = 0 TO 23: IF a THEN ii = i(i, pieza(z(a), v, w))
PSET (x(c) + w, v + y(c)), ii: NEXT w, v
IF x = 8 THEN f = f(c - 1) 'Primera columna, repite fondo
FOR d = 0 TO 15 'Total de direcciones
xx = x 'Copia coordenadas
yy = y
FOR h = 0 TO 6
xx = xx + Ix(d) 'Incremento
yy = yy + Iy(d)
IF xx < 1 OR xx > 8 OR yy < 0 OR yy > 7 THEN EXIT FOR 'Supera los limites del tablero
IF d > 7 THEN
n(c, d - 8, 0) = xx + 8 * yy 'Destino del caballo
h(3, c, d - 8) = -1
EXIT FOR
END IF
n(c, d, h + 1) = xx + 8 * yy 'Casilla destino
NEXT
FOR a = 1 TO 7 * SGN(h)
IF e(a, d) THEN 'Ajusta alcance segun direccion y pieza
IF a > 3 THEN h(a, c, d) = h 'Limite
IF a < 3 THEN h(a, c, d) = 1 - (Q(c) = 3 - a AND (d = 1 OR d = 5))
IF a = 7 THEN h(a, c, d) = 1 - (r(t(p(c))) = c AND (d = 3 OR d = 7))
END IF 'Peon al frente inicial y enroque =2
NEXT a, d, c
t = 1 'Turno blancas
tt = 2 'Rival negras
m = 3 'Profundidad de calculo
Inicio:
J = 0
FOR v = 0 TO m - 1 'Reinicio de contadores
FOR w = 1 TO m - v
J(w, v + w) = LL(w)
NEXT w, v
n = 1
Pieza:
pc1(n) = p1(t) 'Primera pieza
Origen:
c1(n) = c(pc1(n)) 'Casilla de la pieza
IF c1(n) = 0 GOTO Siguiente
k(c1(n)) = k(c1(n)) + 1 'Simulacion de origen
p(c1(n)) = 0
aa(n) = a(pc1(n)) 'Tipo de pieza
dd(n) = d1(aa(n)) 'Direccion inicial
Alcance:
hh(n) = h(aa(n), c1(n), dd(n)) 'Alcance total
IF hh(n) = 0 GOTO Direccion
g(n) = gg(aa(n)) 'Alcance inicial (0 para el caballo)
Destino:
c2(n) = n(c1(n), dd(n), g(n)) 'Casilla destino
pc2(n) = p(c2(n)) 'Pieza en destino
IF t(pc2(n)) = t GOTO Direccion 'Mismo bando
IF aa(n) < 3 THEN 'Rutina peon
IF d(dd(n)) = t(pc2(n)) THEN 'Evaluar captura al paso
IF pc2(n) OR Q(c1(n)) + t GOTO Direccion
IF aa(n - 1) > 2 OR g(n - 1) < 2 GOTO Direccion
IF c2(n) + c2(n) <> c1(n - 1) + c2(n - 1) GOTO Direccion
c3(n) = 2 'Control
c4(n) = c2(n - 1) 'Casilla del peon a capturar
pc4(n) = p(c4(n)) 'Simular captura
c(pc4(n)) = 0
p(c4(n)) = 0
ELSE IF Q(c1(n)) = t THEN a(pc1(n)) = 6: c0(n) = 6 'Promocion
END IF
END IF
IF aa(n) = 7 AND g(n) = 2 THEN 'Rutina enroque
IF k(r(t)) > 1 OR pc2(n) GOTO Direccion 'Rey movido, destino ocupado
c = r(t) 'Casilla del rey en origen
GOSUB Jaque
IF JQ THEN JQ = 0: GOTO Direccion
IF dd(n) = 3 THEN 'Enroque corto
IF k(c + 3) OR p(c + 3) <> pr(t) + 3 * L(t) GOTO Direccion
c3(n) = c + 3
c4(n) = c + 1 'Destino torre
END IF
IF dd(n) = 7 THEN
IF k(c - 4) + p(c - 3) OR p(c - 4) <> pr(t) - 4 * L(t) GOTO Direccion
c3(n) = c - 4
c4(n) = c - 1
END IF
pc3(n) = p(c3(n)) 'Simulacion de enroque
c(pc3(n)) = c4(n)
p(c3(n)) = 0
p(c4(n)) = pc3(n)
END IF
Simulacion:
c(pc1(n)) = c2(n)
c(pc2(n)) = 0
p(c2(n)) = pc1(n)
c = c(pr(t)) 'Casilla del rey
GOSUB Jaque
IF n < m AND JQ = 0 THEN
n = n + 1 'Nivel siguiente
SWAP t, tt
GOTO Pieza
END IF
Restaurar:
c(pc2(n)) = c2(n)
p(c2(n)) = pc2(n)
IF c3(n) THEN
IF c3(n) = 2 THEN 'Al paso
c(pc4(n)) = c4(n)
p(c4(n)) = pc4(n)
ELSE c(pc3(n)) = c3(n) 'Enroque
p(c3(n)) = pc3(n)
p(c4(n)) = 0
END IF
c3(n) = 0
END IF
IF JQ = 0 THEN
J(1, n) = J(1, n) + 2 'Jugadas posibles
IF n = 1 THEN
J = J + 1 'Guardar jugada
FOR v = 1 TO m - 1
JJ(J, v) = J(v, v + 1) - 1
IF JJ(J, v) > 0 THEN JJ(J, v) = JJ(J, v) \ 2 + 1
NEXT
s(J, 0) = c0(1)
s(J, 1) = c1(1)
s(J, 2) = c2(1)
ELSE FOR v = 1 TO m - n 'Evaluar contadores
IF L(v) = SGN(J(v + 1, n + v) - J(v, n + v)) THEN
J(v + 1, n + v) = J(v, n + v)
END IF
NEXT
END IF
ELSE JQ = 0
IF aa(n) = 7 THEN hh(n) = 1 'No hay enroque
END IF
FOR v = n TO m - 1 'Reinicio de contadores
FOR w = 1 TO m - v
J(w, v + w) = LL(w)
NEXT w, v
IF c0(n) THEN 'Subpromocion
c0(n) = c0(n) - 1
IF c0(n) > 2 THEN a(pc1(n)) = c0(n): GOTO Simulacion
a(pc1(n)) = t
c0(n) = 0
END IF
IF pc2(n) = 0 AND g(n) < hh(n) THEN g(n) = g(n) + 1: GOTO Destino
Direccion:
IF dd(n) < d2(aa(n)) THEN dd(n) = dd(n) + d3(aa(n)): GOTO Alcance
k(c1(n)) = k(c1(n)) - 1 'Restaura origen
c(pc1(n)) = c1(n)
p(c1(n)) = pc1(n)
Siguiente:
IF pc1(n) < p2(t) THEN pc1(n) = pc1(n) + 1: GOTO Origen 'Pieza siguiente
IF J(1, n) = 0 THEN 'Mate o ahogado
c = c(pr(t)) 'Casilla del rey
GOSUB Jaque
J(1, n) = 1 - JQ
JQ = 0
END IF
n = n - 1
IF n THEN SWAP t, tt: GOTO Restaurar
c1 = r(t) 'Casilla del rey en origen
Cursor:
FOR v = 1 TO m + 1
LOCATE 2 + (v + 1) \ 2, 34 - 7 * (v MOD 2)
J$ = RIGHT$(" " + STR$(J), 3)
IF J = 0 THEN J$ = "(1/2)"
IF J(1, 1) = 0 THEN J$ = R$(t)
IF v - t THEN J$ = " "
PRINT J$
NEXT
c = c1 'Origen
a = a(p(c)) 'Pieza
i = t(p(c)) 'Tinta
ii = 6 + t
i(i, 0) = ii
FOR v = 0 TO 23: FOR w = 0 TO 23: IF a THEN ii = i(i, pieza(z(a), v, w))
PSET (x(c) + w, v + y(c)), ii: NEXT w, v
WHILE INKEY$ <> "": WEND
a$ = ""
WHILE a$ = "": a$ = RIGHT$(INKEY$, 1): WEND
IF a$ = CHR$(27) AND J = 0 THEN SYSTEM
IF a$ <> CHR$(13) THEN
IF a$ = "M" AND c1 < 64 THEN c1 = c1 + 1
IF a$ = "K" AND c1 > 1 THEN c1 = c1 - 1
IF a$ = "H" AND c1 < 57 THEN c1 = c1 + 8
IF a$ = "P" AND c1 > 8 THEN c1 = c1 - 8
a = a(p(c))
i = t(p(c))
ii = f(c)
i(i, 0) = ii
FOR v = 0 TO 23: FOR w = 0 TO 23: IF a THEN ii = i(i, pieza(z(a), v, w))
PSET (x(c) + w, v + y(c)), ii: NEXT w, v
IF a$ = "+" AND m < 9 THEN m = m + 1: GOTO Inicio
IF a$ = "-" AND m > 2 THEN m = m - 1: GOTO Inicio
GOTO Cursor
END IF
c2 = 0 'Casilla destino
s = 0
Eleccion:
s = s + (1 OR a$ = "K") 'Movimiento siguiente
IF s < 1 OR s > J THEN 'Fuera de rango
IF c2 = 0 GOTO Cursor
s = J + 1 AND s < 1
GOTO Eleccion
END IF
IF s(s, 1) <> c1 GOTO Eleccion
a = a(p(c1))
IF s(s, 0) THEN a = s(s, 0)
c2 = s(s, 2) 'Destino
c3 = 0
IF a = 7 AND c2 - c1 = 2 THEN c3 = c2 + 1 'Enroque
IF a = 7 AND c1 - c2 = 2 THEN c3 = c2 - 2
i = t
i(i, 0) = 9 - t
FOR v = 0 TO 23: FOR w = 0 TO 23
PSET (x(c2) + w, v + y(c2)), i(i, pieza(z(a), v, w)): NEXT w, v
w = m
FOR v = 1 TO m - 1
LOCATE 2 + (v + t + 1) \ 2, 34 - 7 * ((v + t) MOD 2)
J$ = " "
IF v < w THEN
J$ = RIGHT$(" " + STR$(JJ(s, v)) + " ", 5)
IF JJ(s, v) = 0 THEN w = 0: J$ = "(1/2)"
IF JJ(s, v) < 0 THEN w = 0: J$ = R$(2 - (v + t) MOD 2)
END IF
PRINT J$
NEXT
a$ = "": WHILE a$ = "": a$ = RIGHT$(INKEY$, 1): WEND
a = a(p(c2))
i = t(p(c2))
ii = f(c2)
i(i, 0) = ii
FOR v = 0 TO 23: FOR w = 0 TO 23: IF a THEN ii = i(i, pieza(z(a), v, w))
PSET (x(c2) + w, v + y(c2)), ii: NEXT w, v
IF a$ = CHR$(27) GOTO Cursor
IF a$ <> CHR$(13) GOTO Eleccion 'INTRO confirma jugada
aa(0) = a(p(c1))
g(0) = 0 'Control al paso
IF aa(0) < 3 THEN
IF s(s, 0) THEN a(p(c1)) = s(s, 0) 'Promocion
g(0) = ABS(c1 - c2) \ 8 'Al paso posible
IF (c1 - c2) MOD 8 AND p(c2) = 0 THEN
c = c2(0)
p = p(c)
a(p) = 0
c(p) = 0
p(c) = 0
FOR v = 0 TO 23: FOR w = 0 TO 23
PSET (x(c) + w, v + y(c)), f(c): NEXT w, v
END IF
END IF
c1(0) = c1 'Casilla origen
c2(0) = c2 'Casilla destino
k(c1) = 1 'Casilla origen usada
k(c2) = 1 'Destino
DO
c(p(c1)) = c2
c(p(c2)) = 0
p(c2) = p(c1)
p(c1) = 0
FOR v = 0 TO 23: FOR w = 0 TO 23
PSET (x(c1) + w, v + y(c1)), f(c1): NEXT w, v
a = a(p(c2))
i = t(p(c2))
i(i, 0) = f(c2)
FOR v = 0 TO 23: FOR w = 0 TO 23
PSET (x(c2) + w, v + y(c2)), i(i, pieza(z(a), v, w)): NEXT w, v
c2 = (c1 + c2) \ 2
c1 = c3
LOOP WHILE a = 7 AND c3
SWAP t, tt
GOTO Inicio
Jaque:
FOR d = 0 TO 7 'Direcciones para busqueda de jaques
p = p(n(c, d, 0))
IF t(p) = tt AND a(p) = 3 THEN JQ = 1: EXIT FOR 'Jaque con caballo
FOR g = 1 TO h(6, c, d)
p = p(n(c, 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
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
DATA 0,1,0,2,1
DATA 0,1,4,6,1
DATA 1,0,0,7,1
DATA 2,1,0,6,2
DATA 3,1,1,7,2
DATA 4,1,0,7,1
DATA 5,1,0,7,1
DATA 00,00,00,00,00,00,05,00
DATA 00,00,07,00,00,00,00,00
DATA 00,00,00,00,00,00,00,00
DATA 00,00,00,00,00,00,00,00
DATA 00,00,00,00,00,-2,00,00
DATA 00,00,00,00,00,00,-2,00
DATA 00,06,00,00,00,03,-7,00
DATA 00,00,00,00,00,00,00,00
DATA 00,00,00,00,00,00,00,00
DATA 02,02,02,02,02,02,02,02
DATA 00,00,00,00,00,00,00,00
DATA -2,-2,-2,-2,-2,-2,-2,-2
DATA -1,-1,-1,-1,-1,-1,-1,-1
DATA 00,00,00,00,00,00,00,00
DATA 01,01,01,01,01,01,01,01
DATA 00,00,00,00,00,00,00,00
DATA 000000000000000000000000
DATA 000000000000000000000000
DATA 000000000000000000000000
DATA 000000000000000000000000
DATA 000000000022220000000000
DATA 000000000222222000000000
DATA 000000000222222000000000
DATA 000000000222222000000000
DATA 000000000022220000000000
DATA 000000000222222000000000
DATA 000000002222222200000000
DATA 000000002222222200000000
DATA 000000002222222200000000
DATA 000000000222222000000000
DATA 000000002222222200000000
DATA 000000022222222220000000
DATA 000000022222222220000000
DATA 000000222222222222000000
DATA 000000222222222222000000
DATA 000000222222222222000000
DATA 000000222222222222000000
DATA 000000000000000000000000
DATA 000000000000000000000000
DATA 000000000000000000000000
DATA 000000000000000000000000
DATA 000000000000000000000000
DATA 000000000020002000000000
DATA 000000000022022000000000
DATA 000000000022222200000000
DATA 000000000222222220000000
DATA 000000002222221222000000
DATA 000000022222222122200000
DATA 000000222211222212200000
DATA 000000222212222212200000
DATA 000002222222222212220000
DATA 000022222222222212220000
DATA 000222222222222212220000
DATA 002212222222212221222000
DATA 002122222222122221222000
DATA 000222222001222221222000
DATA 000002200022222221222000
DATA 000000000022222221222000
DATA 000000000222222221222000
DATA 000000000222222221222000
DATA 000000002222222221222000
DATA 000000002222222222222000
DATA 000000000000000000000000
DATA 000000000000000000000000
DATA 000000000000000000000000
DATA 000000000000000000000000
DATA 000222222222222200000000
DATA 000022222222222220000000
DATA 000002222111111222000000
DATA 000000221222222122200000
DATA 000000002222222212220000
DATA 000000122222222221222000
DATA 000001212222222222122000
DATA 000012221211222222122000
DATA 000122122122122222122000
DATA 001221222212122222122000
DATA 000122122122122222122000
DATA 000012221211222222122000
DATA 000001212222222222222000
DATA 000000122222222220022000
DATA 000000002222222200022000
DATA 000000000222222000002000
DATA 000000022222222220000000
DATA 000000222222222222200000
DATA 000002222222000222220000
DATA 000022222000000000000000
DATA 000000000000000000000000
DATA 000000000000000000000000
DATA 000000000000000000000000
DATA 000000000000000000000000
DATA 000000000000000000000000
DATA 000002220022220022200000
DATA 000002220022220022200000
DATA 000002220022220022200000
DATA 000002222222222222200000
DATA 000002222222222222200000
DATA 000002222222222222200000
DATA 000000021111111120000000
DATA 000000022222222220000000
DATA 000000022222222220000000
DATA 000000022222222220000000
DATA 000000022222222220000000
DATA 000000022222222220000000
DATA 000000022222222220000000
DATA 000000022222222220000000
DATA 000000211111111112000000
DATA 000002222222222222200000
DATA 000002222222222222200000
DATA 000022222222222222220000
DATA 000022222222222222220000
DATA 000000000000000000000000
DATA 000000000000000000000000
DATA 000000000000000000000000
DATA 000000002200002200000000
DATA 000000022220022220000000
DATA 000220022220022220022000
DATA 002222002200002200222200
DATA 002222000200002000222200
DATA 000220000220022000022000
DATA 000022000220022000220000
DATA 000002200220022002200000
DATA 000002220222222022200000
DATA 000002222222222222200000
DATA 000002222222222222200000
DATA 000002222222222222200000
DATA 000002111111111111200000
DATA 000022222222222222220000
DATA 000222222222222222222000
DATA 000022222222222222220000
DATA 000002111111111111200000
DATA 000002222222222222200000
DATA 000022222222222222220000
DATA 000022222222222222220000
DATA 000022222222222222220000
DATA 000000000000000000000000
DATA 000000000000000000000000
DATA 000000000000000000000000
DATA 000000000002200000000000
DATA 000000000002200000000000
DATA 000000000222222000000000
DATA 000222200222222002222000
DATA 002222220002200022222200
DATA 002211122002200221112200
DATA 002122212222222212221200
DATA 002122221222222122221200
DATA 002212222122221222212200
DATA 000221222212212222122000
DATA 000022122222222221220000
DATA 000002222222222222200000
DATA 000002111111111111200000
DATA 000022222222222222220000
DATA 000222222222222222222000
DATA 000022222222222222220000
DATA 000002111111111111200000
DATA 000002222222222222200000
DATA 000022222222222222220000
DATA 000022222222222222220000
DATA 000022222222222222220000
DATA 000000000000000000000000
DATA 000000000000000000000000