|
Sudoku
by Ricardo Lopes
|
|
You can download the code as a TAP file from the archive
( SUDOKU version 1.0 )
( A game for the Jupiter Ace computer )
( copyright (c) 2007 by Ricardo F. Lopes )
( under the GPL (General Public License) v.2 )
( ==================== )
( Graphic Characters )
( ==================== )
CREATE GRAPH 248 ALLOT ( Font buffer )
GRAPH 248 BLOAD sdkfont ( Load font file to buffer )
( Install font: ASCII 1 to 31 )
: GR 248 0 DO GRAPH I + C@ 11272 I + C! LOOP ;
( ================= )
( Draw Game Board )
( ================= )
( type strings in GRAPHIC mode )
: L0 CR ." O > > O > > O > > O" ; ( cell lines )
: L1 CR ." 6=<=<=5=<=<=5=<=<=8" ; ( thin line separator )
: L2 CR ." 1N9N9N0N9N9N0N9N9N2" ; ( fat line separator )
: FRAME ( draw board frame )
CLS
." JN:N:N3N:N:N3N:N:NK" ( top border )
L0 L1 L0 L1 L0 L2 ( lines 1 2 3 )
L0 L1 L0 L1 L0 L2 ( lines 4 5 6 )
L0 L1 L0 L1 L0 CR ( lines 7 8 9 )
." LN;N;N4N;N;N4N;N;N?" ; ( bottom border )
: SCREEN
FRAME
0 20 AT ." _SUDOKU_1.0_"
2 20 AT ." Page: 0"
4 21 AT ." I"
5 20 AT ." JKL Move"
7 20 AT ." P N Pg sel"
13 21 AT ." C Clear"
15 21 AT ." E Edit On"
17 21 AT ." Q Quit"
21 0 AT
." c 2007 by Ricardo F. Lopes "
." GNU General Public License v.2" ;
( =================== )
( READ THE KEYBOARD )
( =================== )
16 BASE C!
CREATE >UPPER ( c -- C : convert a character to uppercase )
DF C, ( RST 18h ; E = char to convert )
7B C, ( LD A,E ; A = char to convert )
CD C, 07 C, 08 C, ( CALL 0807h ; to-upper ROM routine )
5F C, ( LD E,A ; E = converted char )
D7 C, ( RST 10h ; Push char to Data Stack )
FD C, E9 C, ( JP [IY] ; end )
>UPPER DUP 2- ! ( make TOUPPER an executable word )
DECIMAL
: KEY ( -- c : wait for a keypress )
BEGIN INKEY 0= UNTIL
BEGIN INKEY ?DUP UNTIL ;
( =============== )
( SCREEN CURSOR )
( =============== )
: CURSOR ( i -- adr : Get screen cursor address )
9 /MOD ( col lin )
32 * + 2 * 9249 + ;
: ON ( adr -- ) DUP C@ 128 OR SWAP C! ; ( Invert video )
: OFF ( adr -- ) DUP C@ 127 AND SWAP C! ; ( Normal video )
( =================== )
( PUZZLE COLLECTION )
( =================== )
20 CONSTANT #PG ( Number of puzzles )
CREATE PGS #PG 81 * ALLOT ( Sudoku collection )
0 VARIABLE PG ( Current page )
: PG> ( pg -- adr ) 81 * PGS + ; ( Get page address )
: IDX> ( i -- adr ) PG @ PG> + ; ( Get cell address )
: GET ( i -- c ) IDX> C@ ; ( Get cell content )
: SET ( c i -- : Set cell content )
OVER OVER IDX> C! ( set cell content )
CURSOR C! ; ( update screen )
: LOADPG ( pg -- : Load puzzle to screen )
0 MAX #PG 1- MIN ( Limit page range )
DUP PG ! ( Set as current page )
DUP 2 26 AT . ( Show page number )
PG> ( Get page address )
81 0 ( Copy puzzle to screen )
DO
DUP C@ ( Get value )
I CURSOR C! ( Place it into the screen )
1+ ( Point to next value )
LOOP
DROP ;
( Change current page )
: PG+ ( n -- ) PG @ + LOADPG ;
( ====================== )
( CHECK ALLOWED VALUES )
( ====================== )
CREATE HINTS 10 ALLOT ( List of allowed values )
: HINT@ ( c -- f ) HINTS + C@ ;
: HINT! ( f c -- ) HINTS + C! ;
: HINT0 ( Initialize list allowing all values )
10 1
DO
I I HINT!
LOOP
32 0 HINT! ; ( value=0 is always allowed )
: RMV ( c -- c : Remove c from the list of allowed values)
0 OVER GET 15 AND ( Mask ASCII 0 out )
?DUP ( Not zero? )
IF
HINT!
ELSE
DROP
THEN ;
: LSCN ( lin -- : Scan line )
9 * ( index )
9 0
DO
RMV 1+
LOOP
DROP ;
: CSCN ( col -- : Scan column )
9 0
DO
RMV 9 +
LOOP
DROP ;
( Lookup table for square index )
CREATE BC 0 C, 0 C, 0 C, 3 C, 3 C, 3 C, 6 C, 6 C, 6 C,
CREATE BL 0 C, 0 C, 0 C, 27 C, 27 C, 27 C, 54 C, 54 C, 54 C,
: SSCN ( col lin -- : Scan square )
BL + C@
SWAP BC + C@ + ( index )
3 0 ( 3 lines )
DO
3 0 ( 3 columns )
DO
RMV 1+
LOOP
6 + ( next line )
LOOP
DROP ;
: SCAN ( i -- : Scan line, column and square, removing founded values from list )
9 /MOD ( col lin )
OVER CCHK ( Check column )
DUP LCHK ( Check line )
BCHK ; ( Check square )
: .HINT ( i -- : Show allowed values at cell i )
HINT0 SCAN
20 1 AT
10 1
DO
I HINT@ ?DUP
IF
.
ELSE
2 SPACES
THEN
LOOP ;
( ============= )
( PUZZLE EDIT )
( ============= )
( ASCII 0 to 9 = locked cells: can be changed only in edit mode )
( ASCII 48 to 57 = unlocked cells: can be changed at will )
ASCII 0 VARIABLE NED ( True when not in Edit Mode )
: XED ( Toogle Edit Mode On/Off )
15 29 AT
NED @
IF
." Off"
19 1 AT ." ____EDIT_MODE____"
0
ELSE
." On "
19 1 AT 17 SPACES
ASCII 0
THEN
NED ! ;
: BZZ 300 50 BEEP ; ( Not-Ok tone )
: BIP 30 DUP BEEP ; ( Ok tone )
: WRITE ( i c -- i : Change value, checking if allowed )
DUP HINT@ ( Is an allowed value?)
IF
NED @ ( Is not editing?)
IF
OVER GET
DUP 0> SWAP ( Is cell not empty?)
ASCII 0 < AND ( Is cell locked? )
IF ( Locked cell: Discard value)
DROP BZZ
ELSE ( Unlocked cell: Ok to change)
DUP IF ASCII 0 + THEN ( if not clearing, set as user input )
OVER SET BIP
THEN
ELSE ( Edit mode: Ok to change)
OVER SET BIP
THEN
ELSE ( Not an allowed value: Discard it )
DROP BZZ
THEN ;
: CLR ( Clear all inputs )
81 0
DO
I 0 WRITE DROP
LOOP ;
( =========== )
( Game Play )
( =========== )
( Changing the current index position )
-9 CONSTANT UP
-1 CONSTANT LF
1 CONSTANT RG
9 CONSTANT DN
: GO ( i dir -- i ) + 0 MAX 80 MIN ;
: PLAY ( key i -- key i : Interpret input and take action)
OVER ASCII I = IF UP GO THEN
OVER ASCII J = IF LF GO THEN
OVER ASCII K = IF DN GO THEN
OVER ASCII L = IF RG GO THEN
OVER ASCII N = IF RG PG+ THEN
OVER ASCII P = IF LF PG+ THEN
OVER ASCII C = IF CLR THEN
OVER ASCII E = IF XED THEN
OVER ASCII 0 -
DUP -1 > OVER 10 < AND
IF WRITE ELSE DROP THEN ;
: SUDOKU ( Main routine, start the game with this word )
INVIS FAST
GR SCREEN ( Draw screen )
ASCII 0 NED ! ( Not in edit mode )
0 LOADPG ( Load first puzzle page )
40 ( Set initial cursor index )
BEGIN
DUP .HINT ( Scan for allowed values )
DUP CURSOR ON
KEY >UPPER SWAP ( Get user input )
DUP CURSOR OFF
PLAY
SWAP ASCII Q = ( Quit? )
UNTIL
DROP VIS SLOW ;
|
|