DEFINT A-Z 'Declara enteras las variables
SCREEN 1 'Pantalla grafica
DIM a(80), b(81) 'Casillas y fijos
DIM y1(80), y2(80), y3(80) 'Agrupando casillas
DIM x1(8, 9), x2(8, 9), x3(8, 9) 'Control de ocupacion
DIM X(80), Y(80), c$(9) 'Posicion en pantalla y caracter
CLS 'Limpiar pantalla
LINE (89, 25)-(237, 173), 3, B 'Cuadricula
LINE (89, 25)-(236, 172), 3, B
FOR v = 0 TO 2 'Inicio agrupamiento
FOR w = 0 TO 2
FOR x = 0 TO 2
FOR y = 0 TO 2
'READ a(n): REM Activar para cargar sudoku
y1(n) = 3 * v + w 'Fila de casilla (0,8)
y2(n) = 3 * x + y 'Columna de casilla (0,8)
y3(n) = 3 * v + x 'Zona de casilla (0,8)
X(n) = 13 + 2 * (n MOD 9)
Y(n) = 5 + 2 * (n \ 9)
IF n < 10 THEN c$(n) = CHR$(48 + n)
LINE (8 * X(n) - 13, 8 * Y(n) - 13)-(8 * X(n) + 3, 8 * Y(n) + 3), 3, B
IF w + y = 0 THEN LINE (8 * X(n) - 14, 8 * Y(n) - 14)-(8 * X(n) + 35, 8 * Y(n) + 35), 3, B
n = n + 1 ' Siguiente casilla
NEXT y, x, w, v 'Fin agrupamiento
c$(0) = " "
n = 0 'Casilla inicial
WHILE a$ <> CHR$(13)
LOCATE Y(n), X(n) 'Valor en pantalla
PRINT c$(a(n))
PAINT (8 * X(n) - 10, 8 * Y(n) - 10), 2, 3 'Cursor
IF a OR a$ = " " OR a$ = "0" THEN
a$ = "M" 'Si el ultimo valor fue valido avanzar una casilla
ELSE GOSUB Teclado
END IF
PAINT (8 * X(n) - 10, 8 * Y(n) - 10), 0, 3
a$ = RIGHT$(a$, 1) 'Caracter derecho, las teclas de direccion devuelven dos caracteres)
a = VAL(a$) 'Valor de tecla pulsada
IF a$ = "M" AND n < 80 THEN n = n + 1 'Flecha derecha
IF a$ = "K" AND n > 0 THEN n = n - 1 ' Flecha izquierda
IF a$ = "P" AND n < 72 THEN n = n + 9 'Flecha abajo
IF a$ = "H" AND n > 8 THEN n = n - 9 ' Flecha arriba
IF a OR a$ = " " OR a$ = "0" THEN a(n) = a 'Asignar valor pulsado
WEND
FOR n = 0 TO 80 'Inicio control de casillas ocupadas
a = a(n) 'Obtener valor de casilla
IF a THEN
IF x1(y1(n), a) + x2(y2(n), a) + x3(y3(n), a) THEN 'Valor no valido
a(n) = 0
LOCATE Y(n), X(n)
PRINT " " 'Borrado
ELSE b(n) = 1 'Establecer casilla ocupada
x1(y1(n), a) = 1 'Establecer valor en uso para fila
x2(y2(n), a) = 1
x3(y3(n), a) = 1
PAINT (8 * X(n) - 10, 8 * Y(n) - 10), 2, 3
END IF
END IF
NEXT 'Fin control de ocupacion
n = 0 'Inicio rutina de resolucion
Inicio:
IF b(n) THEN n = n + 1: GOTO Inicio 'El valor es fijo
IF n < 81 THEN
a = a(n) 'Valor de casilla (0,9)
x1(y1(n), a) = 0 'Liberar valor de casilla en fila
x2(y2(n), a) = 0
x3(y3(n), a) = 0
Siguiente:
IF a < 9 THEN
a = a + 1 'Siguiente valor en casilla
IF x1(y1(n), a) GOTO Siguiente 'Valor en uso para fila
IF x2(y2(n), a) GOTO Siguiente
IF x3(y3(n), a) GOTO Siguiente
x1(y1(n), a) = 1 'Establecer valor en uso para fila
x2(y2(n), a) = 1
x3(y3(n), a) = 1
a(n) = a 'Asignar nuevo valor a casilla
LOCATE Y(n), X(n) 'Valor en pantalla
PRINT c$(a)
n = n + 1 'Casilla siguiente
GOTO Inicio
END IF
a(n) = 0 'Asignar "0" por rebase
LOCATE Y(n), X(n) 'Borrar
PRINT " "
Anterior:
n = n - 1 'Casilla anterior
IF n < 0 THEN GOSUB Teclado: RUN 'No hay mas soluciones reiniciar
IF b(n) GOTO Anterior 'Es fijo
GOTO Inicio
END IF
e = e + 1 'Solucion en pantalla
LOCATE 2, 18
PRINT "**"; e; "**";
LOCATE 24, 15
PRINT " Pulse INTRO ";
GOSUB Teclado
GOTO Anterior 'Si no se pulsa ESCAPE, busca mas soluciones
Teclado:
IF INKEY$ <> "" GOTO Teclado 'Limpia pulsaciones
a$ = ""
WHILE a$ = ""
a$ = INKEY$
WEND
IF a$ = CHR$(27) THEN SYSTEM
RETURN
'Sudoku dificil
DATA 5,0,2,0,0,0,0,0,0
DATA 0,0,0,0,6,0,9,0,0
DATA 0,0,0,0,0,0,0,0,0
DATA 0,4,1,0,0,7,0,0,0
DATA 0,0,0,5,0,0,0,6,0
DATA 0,0,5,0,0,2,0,0,0
DATA 0,9,7,0,8,5,0,0,0
DATA 0,0,0,0,0,0,0,3,5
DATA 0,5,4,0,0,0,0,9,6
Pantalla completa= "ALT+Intro".