Sudoku
From Pickwiki
Back to BasicSource
This is a simple program to play a sudoku game.
I found a file SUDOKU17.TXT on the Internet which had over 30,000 games and assume you could use it. The program can save and restore a game as "GAME" in whatever file you keep the sudoku text file.
If there is an "H" in the command line, the display is larger.
PROGRAM SUDOKU * Public Domain program provided by Keith Robert Johnson OPEN 'YOUR.FILE' TO YOUR.FILE ELSE STOP 201,'YOUR.FILE' DIM GAME(3) EQU THAT TO GAME(1), BASE TO GAME(2), MINE TO GAME(3) MAT GAME = '' AUTO = @FALSE THAT = RND(35396)+1 READV THAT FROM YOUR.FILE, 'SUDOKU17.TXT', THAT ELSE THAT = ' 8 3 7 2 8 5 84 8 9 244 ' THAT := '192 1 6 52 1 1 2 3 4 7 ' END CONVERT '0' TO ' ' IN THAT Z = 0 FOR Y = 1 TO 9 FOR X = 1 TO 9 Z += 1 BIT = THAT[Z,1] IF BIT MATCHES '1N' THEN BASE<1,X,Y> = BIT NEXT X NEXT Y MINE = BASE START: * Display the grid CRT @(-1) CRT @(0,1): HUGE = INDEX(@SENTENCE,'H',1) IF HUGE THEN XSIZ = 19; YSIZ = 37; XREM = 6; YREM = 12 END ELSE XSIZ = 13; YSIZ = 19; XREM = 4; YREM = 6 END FOR X = 1 TO XSIZ CRT ' ': FOR Y = 1 TO YSIZ IF REM(X,XREM) EQ 1 THEN IF REM(Y,YREM) EQ 1 THEN CRT '+': ELSE CRT '-': END ELSE IF REM(Y,YREM) EQ 1 THEN CRT '|': ELSE CRT ' ': END NEXT Y CRT NEXT X CRT 'Use SEXD to move around, 1-9 to write or 0 to clear number' CRT ' C to check position, A to toggle autocheck, Q to quit' CRT ' K to keep game, G to get saved game' * Display the contents FOR Y = 1 TO 9 FOR X = 1 TO 9 Z += 1 BIT = MINE<1,X,Y> IF HUGE THEN CRT @(4*X,2*Y): ELSE CRT @(2*X+1,Y+INT((Y+2)/3)): IF BIT MATCHES '1N' THEN IF BASE<1,X,Y> MATCHES '1N' THEN CRT @(-58):BIT:@(-59): ELSE CRT BIT: END ELSE CRT '.': NEXT X NEXT Y * Play loop X = 1; Y = 1 LOOP IF HUGE THEN POSN = @(4*X,2*Y) ELSE POSN = @(2*X+1,Y+INT((Y+2)/3)) CRT POSN: THIS = UPCASE(KEYIN()) CRT @(0,23):@(-4): UNTIL THIS EQ 'Q' DO LOOP INPUT FULL,-1 WHILE FULL DO FULL = KEYIN() REPEAT CRT POSN: BEGIN CASE CASE THIS EQ 'A'; AUTO = NOT(AUTO) CASE THIS EQ 'S' AND X GT 1 ; X -= 1 CASE THIS EQ 'D' AND X LT 9 ; X += 1 CASE THIS EQ 'E' AND Y GT 1 ; Y -= 1 CASE THIS EQ 'X' AND Y LT 9 ; Y += 1 CASE THIS EQ 'C' ; GOSUB CHECK CASE THIS EQ 'K' ; MATWRITE GAME ON YOUR.FILE,'GAME' CASE THIS EQ 'G' READ TEST FROM YOUR.FILE,'GAME' THEN MATREAD GAME FROM YOUR.FILE,'GAME' THEN GO START END END CRT @(0,23):'NO GAME SAVED': CASE BASE<1,X,Y> MATCHES '1N' ; CRT CHAR(7): CASE THIS EQ '0' OR THIS EQ ' ' ; MINE<1,X,Y> = '' ; CRT '.': CASE THIS MATCHES '1N' ; MINE<1,X,Y> = THIS ; CRT THIS: CASE 1 ; CRT CHAR(7): END CASE IF AUTO THEN GOSUB CHECK REPEAT STOP CHECK: CRT @(0,23): GOOD = 'Everything good so far!' * Check Columns THIS = ' Column ' FOR AA = 1 TO 9 LINE = '' FOR BB = 1 TO 9 BIT = MINE<1,AA,BB> IF BIT NE '' THEN IF INDEX(LINE,BIT,1) THEN CRT THIS:AA: ; THIS = ',' ; BB = 99 ; GOOD = ' BAD' END ELSE LINE := BIT END NEXT BB NEXT AA * Check Rows THIS = ' Row ' FOR AA = 1 TO 9 LINE = '' FOR BB = 1 TO 9 BIT = MINE<1,BB,AA> IF BIT NE '' THEN IF INDEX(LINE,BIT,1) THEN CRT THIS:AA: ; THIS = ',' ; BB = 99 ; GOOD = ' BAD' END ELSE LINE := BIT END NEXT BB NEXT AA * Check Cells - couldn't figure out an algorithm THIS = ' Cell ' CELL = '1*11,12,13,21,22,23,31,32,33'; GOSUB DOCELL CELL = '2*41,42,43,51,52,53,61,62,63'; GOSUB DOCELL CELL = '3*71,72,73,81,82,83,91,92,93'; GOSUB DOCELL CELL = '4*14,15,16,24,25,26,34,35,36'; GOSUB DOCELL CELL = '5*44,45,46,54,55,56,64,65,66'; GOSUB DOCELL CELL = '6*74,75,76,84,85,86,94,95,96'; GOSUB DOCELL CELL = '7*17,18,19,27,28,29,37,38,39'; GOSUB DOCELL CELL = '8*47,48,49,57,58,59,67,68,69'; GOSUB DOCELL CELL = '9*77,78,79,87,88,89,97,98,99'; GOSUB DOCELL CRT GOOD: RETURN DOCELL: ID = CELL[1,1] CELL = CELL[3,99] CONVERT ',' TO @AM IN CELL LINE = '' FOR AA = 1 TO 9 BIT = MINE<1,CELL<AA>[1,1],CELL<AA>[2,1]> IF BIT NE '' THEN IF INDEX(LINE,BIT,1) THEN CRT THIS:ID: ; THIS = ',' ; AA = 99 ; GOOD = ' BAD' END ELSE LINE := BIT END NEXT AA RETURN