; Super Sudoku 81 for the 16K ZX81 ; (c) 2006,2007 Simon Holdsworth ; http://www.zx81stuff.org.uk/ ; ; TODO: add some more 6x6 boards of various difficulties. ; ; Possible Future new functions: ; Any additional functionality will require additional compression ; of the instructions - probably dictionary based, and also possibly of ; the supplied boards. ; Add support for 8x8 with X, 6x6 with X. ; Additional logic: FindOptionInsideClosedSet; ; Additional logic: FindYWing ; Allow redefinition of cursor keys. Possibly just QAOP/[shift]5678. ; For hint, first check whether any non-static value is incorrectly placed. ; ; Known limitations/bugs: ; "undo" moves cursor when all non-static moves already undone. ; I expect there are ROM routines that could be used for some of this. ; ; Based on my .P file skeleton. ; Skip down to Line1Text for the interesting bit. #define DEFB .BYTE #define DEFW .WORD #define DEFM .TEXT #define ORG .ORG #define EQU .EQU ; These macros allow checking at assembly time that particular blocks of memory ; do not cross 256-byte boundaries. This is to allow code to only update the ; low byte of a table pointer and know that the high byte never needs updating ; Each such block must either start with a Start256 macro, or be preceded by ; an Align256 or Check256 macro (each of which implicitly does a Start256) MACRO_BlockStart EQU 0 #define Start256 .NOLIST #defcont \MACRO_BlockStart: .SET $ #defcont \.LIST #define Check256(block) .NOLIST #defcont \#IF (($ & 0FF00H) != (MACRO_BlockStart & 0FF00H)) #defcont \.ECHO "ERROR: block crosses 256-byte boundary\n" #defcont \!!! #defcont \#ENDIF #defcont \Start256 #defcont \.LIST ; Align the following block on a 256 byte boundary. #define Align256Msg(block) .NOLIST #defcont \.ECHO "Skipping " #defcont \.ECHO ((($ + 0FFH) & 0FF00H) - $) #defcont \.ECHO " bytes for block\n" #defcont \.LIST ;#define Align256Msg(block) #define Align256(block) .NOLIST #defcont \Align256Msg(block) #defcont \.BLOCK (($ + 0FFH) & 0FF00H) - $ #defcont \Start256 #defcont \.LIST ; ZX81 ROM routines KSCAN EQU $02BB FINDCHR EQU $07BD COPY EQU $0869 FAST EQU $0F23 SLOW EQU $0F2B ; =========================================================== ; Start of the Program ; =========================================================== ; Origin of a ZX81 file is always 16393 ORG 16393 ; System variables. VERSN: DEFB 0 E_PPC: DEFW 2 D_FILE: DEFW Display DF_CC: DEFW Display+1 ; First character of display VARS: DEFW Variables DEST: DEFW 0 E_LINE: DEFW BasicEnd CH_ADD: DEFW BasicEnd+4 ; Simulate SAVE "X" X_PTR: DEFW 0 STKBOT: DEFW BasicEnd+5 STKEND: DEFW BasicEnd+5 ; Empty stack BREG: DEFB 0 MEM: DEFW MEMBOT UNUSED1: DEFB 0 DF_SZ: DEFB 2 S_TOP: DEFW $0002 ; Top program line number LAST_K: DEFW $FDBF DEBOUN: DEFB 15 MARGIN: DEFB 55 NXTLIN: DEFW Line2 ; Next line address OLDPPC: DEFW 0 FLAGX: DEFB 0 STRLEN: DEFW 0 T_ADDR: DEFW $0C8D SEED: DEFW 0 FRAMES: DEFW $F5A3 COORDS: DEFW 0 PR_CC: DEFB $BC S_POSN: DEFW $1821 CDFLAG: DEFB $40 PRBUFF: DEFB 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,$76 ; 32 Spaces + Newline MEMBOT: DEFB 0,0,0,0,0,0,0,0,0,0,$84,$20,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 ; 30 zeros UNUNSED2: DEFW 0 ; End of system variables Program: Line1: DEFB $00,$01 ; Line 1 DEFW Line1End-Line1Text ; Line 1 length Line1Text: DEFB $EA ; REM ; =========================================================== ; Insert your program here.... ; =========================================================== ;------------------------------------------------------------ ; ; Initial program entry point, and GUI routines start here. ; ; Routines that handle the game rules are further down. ; ;------------------------------------------------------------ Start: LD B,13 ; Flash the bottom line LD HL,(D_FILE) LD DE,1+(22*33)+9 ; Line 22, column 9 ADD HL,DE CALL WaitForKeyFlash ; Assume a splash screen present after loading JP OptionsMenu ; Drop through to option selection. ;------------------------------------------------------------ ; GUI Variables ; ; Convention used for labels: ; ; Any label starting with a capital letter is a callable routine. ; Labels starting with '_' are local to modules ; Labels starting with 'v' or '_v' are variables/working arrays. ; Labels starting with 's' are static data tables. ;------------------------------------------------------------ vShowOptions: DEFB 0 ; Indicates whether showing actual or pencilled options vBoardType: DEFB 0 ; The type of board, using the values below vMessageVisible:DEFB 0 ; Indicates whether a message has been displayed vUpdateDisplay: DEFB 0 ; Indicates whether to update the cursor/options display vDisplayNumbers:DEFB 0 vRandomSeed: DEFW 0 ; Random seed value vBoardColRowOffset: ; Allows loading of the offsets in one go, B=row, C=col vBoardColOffset:DEFB 0 ; Screen offset of column 0 vBoardRowOffset:DEFB 0 ; Screen offset of row 0 ;vKeyUp: DEFB $36 ;'Q' ; The character value of the UP key ;vKeyDown: DEFB $26 ;'A' ; The character value of the DOWN key ;vKeyLeft: DEFB $34 ;'O' ; The character value of the LEFT key ;vKeyRight: DEFB $35 ;'P' ; The character value of the RIGHT key NINE_BY_NINE EQU 1 ; The value of the board type for a 9x9 board EIGHT_BY_EIGHT EQU 2 ; The value of the board type for an 8x8 board SIX_BY_SIX EQU 3 ; The value of the board type for a 6x6 board BOARD_COL_ROW_OFFSET_9x9 EQU 4 * 256 + 2 ; Screen offset of row 0/column 0 for the 9x9 board BOARD_COL_ROW_OFFSET_6x6 EQU 7 * 256 + 5 ; Screen offset of row 0/column 0 for the 6x6 board ;------------------------------------------------------------ ; Keyboard table for setup 9x9 game. ; ; This is here so that the tables are contiguous and don't ; sit between pieces of code, forcing all jumps to be absolute. ; ; I could have done a table that was dense using a key table ; such as: ; '1','2','3','4','5','6','7','8','9','A','C','E','H','O'... ; found the key pressed in that table and used the resulting ; index into an address table, however given that around ; half of the keys are used, that would produce no net gain. ;------------------------------------------------------------ SetupGameKeyTable: DEFW SetupGamePlaceNumber ; $1D '1' DEFW SetupGamePlaceNumber ; $1E '2' DEFW SetupGamePlaceNumber ; $1F '3' DEFW SetupGamePlaceNumber ; $20 '4' DEFW SetupGamePlaceNumber ; $21 '5' DEFW SetupGamePlaceNumber ; $22 '6' DEFW SetupGamePlaceNumber ; $23 '7' DEFW SetupGamePlaceNumber ; $24 '8' DEFW SetupGamePlaceNumber ; $25 '9' DEFW SetupGameDown ; $26 'A' DEFW KeyboardHandlerNoAction ; $27 'B' DEFW SetupGameClearCell ; $28 'C' DEFW KeyboardHandlerNoAction ; $29 'D' DEFW SetupGameExit ; $2A 'E' DEFW KeyboardHandlerNoAction ; $2B 'F' DEFW SetupGameGenerate ; $2C 'G' DEFW KeyboardHandlerNoAction ; $2D 'H' DEFW SetupGameIsUnique ; $2E 'I' DEFW KeyboardHandlerNoAction ; $2F 'J' DEFW KeyboardHandlerNoAction ; $30 'K' DEFW SetupGameLoadBoard ; $31 'L' DEFW KeyboardHandlerNoAction ; $32 'M' DEFW SetupGameNewBoard ; $33 'N' DEFW SetupGameLeft ; $34 'O' DEFW SetupGameRight ; $35 'P' DEFW SetupGameUp ; $36 'Q' DEFW KeyboardHandlerNoAction ; $37 'R' DEFW SetupGameStart ; $38 'S' DEFW KeyboardHandlerNoAction ; $39 'T' DEFW SetupGameUndo ; $3A 'U' DEFW KeyboardHandlerNoAction ; $3B 'V' DEFW KeyboardHandlerNoAction ; $3C 'W' DEFW KeyboardHandlerNoAction ; $3D 'X' DEFW KeyboardHandlerNoAction ; $3E 'Y' DEFW SetupGamePrint ; $3F 'Z' ;------------------------------------------------------------ ; Keyboard table for play 9x9 game. ;------------------------------------------------------------ PlayGameKeyTable: DEFW PlayGamePlaceNumber ; $1D '1' DEFW PlayGamePlaceNumber ; $1E '2' DEFW PlayGamePlaceNumber ; $1F '3' DEFW PlayGamePlaceNumber ; $20 '4' DEFW PlayGamePlaceNumber ; $21 '5' DEFW PlayGamePlaceNumber ; $22 '6' DEFW PlayGamePlaceNumber ; $23 '7' DEFW PlayGamePlaceNumber ; $24 '8' DEFW PlayGamePlaceNumber ; $25 '9' DEFW PlayGameDown ; $26 'A' DEFW KeyboardHandlerNoAction ; $27 'B' DEFW PlayGameClearCell ; $28 'C' DEFW PlayGameDifficulty ; $29 'D' DEFW PlayGameExit ; $2A 'E' DEFW KeyboardHandlerNoAction ; $2B 'F' DEFW KeyboardHandlerNoAction ; $2C 'G' DEFW PlayGameHint ; $2D 'H' DEFW PlayGameIsUnique ; $2E 'I' DEFW KeyboardHandlerNoAction ; $2F 'J' DEFW KeyboardHandlerNoAction ; $30 'K' DEFW PlayGameSolveAll ; $31 'L' DEFW KeyboardHandlerNoAction ; $32 'M' DEFW PlayGameSolveOne ; $33 'N' DEFW PlayGameLeft ; $34 'O' DEFW PlayGameRight ; $35 'P' DEFW PlayGameUp ; $36 'Q' DEFW KeyboardHandlerNoAction ; $37 'R' DEFW PlayGameShowOptionsKey ; $38 'S' DEFW PlayGamePencilOption ; $39 'T' DEFW PlayGameUndo ; $3A 'U' DEFW KeyboardHandlerNoAction ; $3B 'V' DEFW KeyboardHandlerNoAction ; $3C 'W' DEFW KeyboardHandlerNoAction ; $3D 'X' DEFW KeyboardHandlerNoAction ; $3E 'Y' DEFW PlayGamePrint ; $3F 'Z' ;------------------------------------------------------------ ; Generic keyboard handling routine. ; ; HL contains the address of the key table, which must provide ; the addresses for routines for keys '1' to 'Z' (i.e. 35 values.) ;------------------------------------------------------------ KeyboardHandler: .MODULE KH PUSH HL ; Save the key table address XOR A ; Clear the exit flag LD (vKeyboardHandlerExitFlag),A _loop CALL GetKeyPress ; A = key value - need to hold on to this until JP (HL) SUB $1D ; Adjust '1'...'Z' to be in the range 0 ... 34 JR C,_loop ; Check in range CP 35 JR NC,_loop ; Check in range LD E,A INC A ; Adjust to range 1..35 for '1'..'Z' LD D,0 POP HL ; Restore key table address PUSH HL ; And save again ADD HL,DE ADD HL,DE ; HL = table address + key value * 2 LD E,(HL) ; NOTE: JP (HL) doesn't jump to the location in the memory INC HL ; address pointed to by HL, it jumps to the memory address LD H,(HL) ; pointed to by HL. LD L,E ; So this code does what JP (HL) OUGHT to do. CALL _callHL ; Note: need to hold on to A to here from GetKeyPress. LD A,(vKeyboardHandlerExitFlag) OR A ; Exit non zero indicates return from KeyboardHandler JR Z,_loop XOR A ; Reset the exit flag LD (vKeyboardHandlerExitFlag),A POP HL ; Clear up stack KeyboardHandlerNoAction: RET ; Re-use this RET instruction for null routines. _callHL JP (HL) ; Allow RET from the called routine to return to the ; caller of _callHL vKeyboardHandlerExitFlag: DEFB 0 ;------------------------------------------------------------ ; Handle the options menu items. ;------------------------------------------------------------ OptionsMenu: .MODULE OM LD HL,sOptionsScreenData ; Display the options screen CALL CopyScreen LD A,NINE_BY_NINE ; Default to 9x9 board LD (vBoardType),A _updateDisplay CALL DisplayBoardType ; Display the board type indicator ; TODO: Use the KeyboardHandler to handle the Options menu items. ; I actually don't think its worth it for this one as ; A) there aren't many entries ; B) the entries aren't shared with other menus. _nextKey CALL GetKeyPress ; Get the next key press CP $36 ; 'Q' Quit option selected JR Z,_quit CP $38 ; 'S' Start option selected JR Z,_start CP $2E ; 'I' Instructions selected JR Z,_instructions CP $25 ; '9' 9 x 9 puzzle selected JR Z,_9x9Selected ;CP $24 ; '8' 8 x 8 puzzle selected ;JR Z,_8x8Selected CP $22 ; '6' 6 x 6 puzzle selected JR Z,_6x6Selected ; Other options go here ; Not a valid key JR _nextKey _quit RET ; Just return to BASIC _9x9Selected LD A,NINE_BY_NINE ; Set board type to 9x9 LD (vBoardType),A JR _updateDisplay ; Update the options display _6x6Selected LD A,SIX_BY_SIX ; Set board type to 6x6 LD (vBoardType),A JR _updateDisplay ; Update the options display _start LD A,(vBoardType) CP SIX_BY_SIX JR NZ,_start9x9 CALL Setup6x6GameMenu ; Set up a 6x6 game JR OptionsMenu ; When finished, go back to the options menu _start9x9 CALL Setup9x9GameMenu ; Set up a 9x9 game JR OptionsMenu ; When finished, go back to the options menu _instructions CALL Instructions ; Display instructions JR OptionsMenu ;------------------------------------------------------------ ; Display currently selected board type. ;------------------------------------------------------------ DisplayBoardType: .MODULE DBT LD A,(vBoardType) ; Get the board type LD HL,(D_FILE) ; Locate the position on screen of the indicator LD DE,1+(7*33)+15 ; Line 7, column 15 ADD HL,DE LD B,NINE_BY_NINE ; Display indicator state for 9x9 board CALL _underline ; Board sizes other than 9x9 not currently supported LD DE,4*33 ; Line 11, Column 17 ADD HL,DE LD B,SIX_BY_SIX ; Drop through... _underline CP B ; If the board type is selected LD C,3 ; then use this graphics character JR Z,_underline2 LD C,0 ; Otherwise use a blank _underline2 LD (HL),C ; The indicator is three characters long INC HL ; (of the same character) LD (HL),C INC HL LD (HL),C RET ;------------------------------------------------------------ ; Handle the setup 9x9 and general setup game menu items. ;------------------------------------------------------------ Setup9x9GameMenu: LD HL,BOARD_COL_ROW_OFFSET_9x9 ; Set up cell display offsets. LD (vBoardColRowOffset),HL LD HL,sSetup9x9ScreenData ; Display the 9x9 game screen SetupGameMenu: CALL CopyScreen CALL InitializeBoard ; Initialize the game board LD BC,0 ; Select the cell at 0,0 LD (vSavedRowColumn),BC ; LD A,PENCILLED_MASK ; Switch on option display by default LD (vShowOptions),A XOR A ; Clear showing hint flag LD (vMessageVisible),A LD (vImpossible),A ; Clear impossible move flag CALL EnableAllDisplayUpdates ; Enable all display updates (will select saved row/column) LD HL,SetupGameKeyTable ; Use the KeyboardHandler to handle the Setup menu items JP KeyboardHandler ; RET merged with CALL. ;------------------------------------------------------------ ; Handle the setup 6x6 game menu items. ;------------------------------------------------------------ Setup6x6GameMenu: LD HL,BOARD_COL_ROW_OFFSET_6x6 ; Set up cell display offsets. LD (vBoardColRowOffset),HL LD HL,sSetup6x6ScreenData ; Display the 6x6 game screen JR SetupGameMenu ;------------------------------------------------------------ ; Key handler routines for setting up a 9 x 9 game. ;------------------------------------------------------------ SetupGameLoadBoard: ; Load one of the supplied boards CALL DisableDisplayUpdate ; Disable display updates CALL LoadBoard ; Load the board with supplied values JP EnableDisplayUpdate ; Re-enable display update ; This table is used for fast multiplication by board size up to boardSize*boardSize*boardSize ; It needs to be on a 256-byte boundary. ; It's here in the program as (currently) this is already close to such a boundary. Align256(sMultBoardSizeSq9x9) sMultBoardSizeSq9x9: DEFW 0, 9, 18, 27, 36, 45, 54, 63, 72 DEFW 81, 90, 99,108,117,126,135,144,153 DEFW 162,171,180,189,198,207,216,225,234 DEFW 243,252,261,270,279,288,297,306,315 DEFW 324,333,342,351,360,369,378,387,396 DEFW 405,414,423,432,441,450,459,468,477 DEFW 486,495,504,513,522,531,540,549,558 DEFW 567,576,585,594,603,612,621,630,639 DEFW 648,657,666,675,684,693,702,711,720 Check256(sMultBoardSizeSq9x9) SetupGamePrint: ; Print the contents of the current screen CALL InvertRowColumn ; Switch off current selection indication CALL COPY ; Copy the screen (first 22 lines) JP InvertRowColumn ; Switch on current selection indication ; RET merged with CALL ;------------------------------------------------------------ ; Handle the play game menu items. ;------------------------------------------------------------ PlayGameMenu: LD HL,sRunPartialScreenData1 ; Copy partial screen data, first area LD DE,1+(15*33)+22 ; Line 15, column 22 LD BC,$060A ; 6 rows, 10 columns CALL CopyPartialScreen LD HL,sRunPartialScreenData2 ; Copy partial screen data, second area LD DE,1 ; Line 0, column 0 LD BC,$0320 ; 3 rows, 32 columns CALL CopyPartialScreen LD A,PENCILLED_FLAG ; Display pencilled options by default LD (vShowOptions),A CALL ClearMessage ; Clear any message CALL DisplayMovesLeft ; Ensure moves left is displayed XOR A LD (vSetupMode),A ; Switch out of setup mode LD HL,PlayGameKeyTable ; Use the KeyboardHandler to handle the Play9x9 menu items JP KeyboardHandler ; RET merged with CALL ;------------------------------------------------------------ ; Key handler routines for setting up a 9 x 9 game continued... ;------------------------------------------------------------ SetupGameGenerate: ; Generate a new board CALL DisableAllDisplayUpdates ; Disable all display updates LD HL,sGeneratingMessage ; Display the generating board message CALL DisplayMessage CALL GenerateBoard ; Generate the board CALL RefreshBoardDisplay ; Ensure that the board is displayed CALL Difficulty CALL DisplayDifficulty ; Display difficulty of the board JP EnableAllDisplayUpdates ; Re-enable all display updates SetupGameStart: ; Start playing the game CALL PlayGameMenu ; Display and run the Play 9x9 game menu ; Intentionally drop through to SetupGameExit SetupGameExit: ; Handle exiting from this menu LD A,1 ; Indicate exit from current KeyboardHandler LD (vKeyboardHandlerExitFlag),A RET ; This table is used for fast division. It needs to be on a 256-byte boundary. Align256(sDivideBoardSize9x9) sDivideBoardSize9x9: DEFB 0,0,0,0,0,0,0,0,0 ; 0 - 8 DEFB 1,1,1,1,1,1,1,1,1 ; 9 - 17 DEFB 2,2,2,2,2,2,2,2,2 ; 18 - 26 DEFB 3,3,3,3,3,3,3,3,3 ; 27 - 35 DEFB 4,4,4,4,4,4,4,4,4 ; 36 - 44 DEFB 5,5,5,5,5,5,5,5,5 ; 45 - 53 DEFB 6,6,6,6,6,6,6,6,6 ; 54 - 62 DEFB 7,7,7,7,7,7,7,7,7 ; 63 - 71 DEFB 8,8,8,8,8,8,8,8,8 ; 72 - 80 Check256(sDivideBoardSize9x9) SetupGameUndo: ; Undo the last number placed CALL InvertRowColumn ; Invert the currently selected row/column CALL Undo ; Undo the last number placed CALL InvertRowColumn ; Re-invert the newly selected row/column JP DisplayOptions ; Update the options display ; RET merged with CALL SetupGamePlaceNumber: ; Place a number in a cell LD D,A ; A holds the number to place DEC A LD HL,vBoardSize ; Check it is in range, i.e. < board size CP (HL) RET NC CALL PlaceAtSelected ; Try to place the number JR NZ,SetupGameInvalidMove ; Z indicates success LD A,(vImpossible) OR A ; Check if impossible = 0 RET Z ; If not, then number placed successfully LD HL,sImpossibleMessage ; Display the message that indicates that CALL DisplayMessage ; the placement would make the board impossible to solve XOR A LD (vImpossible),A ; Clear the impossible flag JP Undo ; Undo the placement of the number ; RET merged with CALL SetupGameInvalidMove: ; Handle an invalid move by displaying a message LD HL,sInvalidPlacementMessage JP DisplayMessage ; RET merged with CALL SetupGameNewBoard: ; Start a new board CALL DisableDisplayUpdate ; Disable display updates SetupGameNewBoard_undo: LD A,(vMoves) ; Undo moves while moves > 0 OR A ; Check if moves = 0 JP Z,EnableDisplayUpdate ; Stop when moves = 0, Re-enable display updates CALL Undo JR SetupGameNewBoard_undo ; Keep undoing SetupGameClearCell: ; Clear the currently selected cell LD A,1 ; Indicate that undo history should be updated JP ClearSelected ; Updates current display/options ; RET merged with CALL SetupGameIsUnique: ; Check whether there is a unique solution CALL DisableAllDisplayUpdates ; Disable display updates while checking for uniqueness LD HL,sLookingForUniqueMessage ; Display the "checking uniqueness" message CALL DisplayMessage CALL IsUnique ; Check if the board has a unique solution PUSH AF ; Save flag values CALL EnableAllDisplayUpdates ; Re-enable all display updates POP AF ; Restore flag values LD HL,sUniqueMessage ; Display the appropriate message JP Z,DisplayMessage ; Z incidates a unique solution LD HL,sNotUniqueMessage ; Display the non-unique message JP DisplayMessage SetupGameUp: ; Move the cursor up LD HL,vCurrentRow JR DecreaseCoordinate ; Decrease current row ; RET merged with CALL SetupGameDown: ; Move the cursor down LD HL,vCurrentRow JR IncreaseCoordinate ; Increase current row ; RET merged with CALL SetupGameRight: ; Move the cursor right LD HL,vCurrentColumn JR IncreaseCoordinate ; Increase current column ; RET merged with CALL SetupGameLeft: ; Move the cursor left LD HL,vCurrentColumn ; Intentionally drop through to DecreaseCoordinate ;------------------------------------------------------------ ; Decrease the coordinate indicated by HL. ;------------------------------------------------------------ DecreaseCoordinate: LD A,(HL) ; Get the current coordinate value OR A RET Z ; If already zero, do nothing PUSH HL CALL InvertRowColumn ; Remove the current cursor indication POP HL DEC (HL) ; Decrement the coordinate value JR UpdateCurrent ; Update cursor and options display ;------------------------------------------------------------ ; Increase the coordinate indicated by HL. ;------------------------------------------------------------ IncreaseCoordinate: LD B,(HL) ; Get the current coordinate value LD A,(vBoardSize) DEC A CP B RET Z ; If already vBoardSize - 1, do nothing PUSH HL CALL InvertRowColumn ; Remove the current cursor indication POP HL INC (HL) ; Increment the coordinate value ; Intentionally drop through to UpdateCurrent #IF $ != UpdateCurrent !!!IncreaseCoordinate/UpdateCurrent #ENDIF ;------------------------------------------------------------ ; Update the current selection and options. ;------------------------------------------------------------ UpdateCurrent: LD BC,(vCurrentRowColumn) ; B = col, C = row CALL SelectCurrentRowColumn ; Select the current row and column CALL InvertRowColumn ; Invert the newly selected row/column CALL ClearMessage ; Clear any message that might be visible JP DisplayOptions ; Update the options display as well ;------------------------------------------------------------ ; Key handler routines for playing a 9 x 9 game. ;------------------------------------------------------------ ; These routines are the same as for the setup phase. PlayGameExit EQU SetupGameExit PlayGamePrint EQU SetupGamePrint PlayGameUndo EQU SetupGameUndo PlayGameClearCell EQU SetupGameClearCell PlayGameUp EQU SetupGameUp PlayGameDown EQU SetupGameDown PlayGameRight EQU SetupGameRight PlayGameLeft EQU SetupGameLeft PlayGameIsUnique EQU SetupGameIsUnique PlayGameSolveOne: ; Find and make the next possible move CALL DisableDisplayUpdate ; Disable display updates while finding the next move CALL SolveNext ; Find and make the next move CALL DisplayExplanation ; Display the hint and re-enable display update JR PlayGameCheckComplete ; Check whether the board is now complete ; RET merged with call PlayGameHint: ; Provide a hint for the next possible move CALL DisableDisplayUpdate ; Disable display updates while looking for a hint CALL GetHint ; Get the hint JP DisplayExplanation ; Display the hint and re-enable display update ; RET merged with call ; This table is used for fast remainder. It needs to be on a 256-byte boundary. ; And 256 bytes after sDivideBoardSize9x9 Align256(sModBoardSize9x9) sModBoardSize9x9: DEFB 0,1,2,3,4,5,6,7,8 ; 0 - 8 DEFB 0,1,2,3,4,5,6,7,8 ; 9 - 17 DEFB 0,1,2,3,4,5,6,7,8 ; 18 - 26 DEFB 0,1,2,3,4,5,6,7,8 ; 27 - 35 DEFB 0,1,2,3,4,5,6,7,8 ; 36 - 44 DEFB 0,1,2,3,4,5,6,7,8 ; 45 - 53 DEFB 0,1,2,3,4,5,6,7,8 ; 54 - 62 DEFB 0,1,2,3,4,5,6,7,8 ; 63 - 71 DEFB 0,1,2,3,4,5,6,7,8 ; 72 - 80 Check256(sModBoardSize9x9) ; Enforce the fact that we rely on sModBoardSize9x9 being 256 bytes beyond sDivideBoardSize9x9 #IF sModBoardSize9x9 - sDivideBoardSize9x9 != 256 !!! #ENDIF PlayGamePlaceNumber: ; Place a number in a cell CALL SetupGamePlaceNumber ; Do the same as for setup for placing the number PlayGameCheckComplete: ; Check whether the board is now complete LD A,(vMovesLeft) OR A ; Check if moves left = 0 RET NZ ; If not, carry on PlayGameCompleted: ; Display the game completed message LD HL,sCompletionMessage CALL DisplayMessage CALL FlashMessage ; Flash the message line until key pressed LD A,1 LD (vKeyboardHandlerExitFlag),A ; Exit back to the setup menu RET PlayGamePencilOption: ; Pencil in an option LD HL,sPencilOptionMessage CALL DisplayMessage ; Prompt for the option to pencil in CALL GetKeyPress ; Get the key pressed PUSH AF CALL ClearMessage ; Clear the prompt message POP AF SUB $1D ; Adjust '1'..'boardsize' to 0..boardsize-1 RET C ; Ignore if outside the required range LD HL,vBoardSize CP (HL) ; Check that it is < boardsize RET NC INC A ; Adjust number selected to 1.. boardsize CALL PencilOption ; Pencil in the option JP DisplayOptions ; Update options display for the current cell ; RET merged with call PlayGameSolveAll: ; Solve the board CALL DisableDisplayUpdate ; Disable display updates while solving the entire board CALL SolveAll ; Solve the entire board LD A,(vMovesLeft) OR A ; Check if any moves left JP Z,PlayGameCompleted ; If none, then the board is complete ;JR DisplayExplanation ; Otherwise it couldn't be solved, so display the explanation of the last move #IF $!= DisplayExplanation !!!PlayGameSolveAll/DisplayExplanation #ENDIF ;------------------------------------------------------------ ; Display the explanation of the next possible move. ; Placed here to save one jump from PlayGameSolveAll ;------------------------------------------------------------ DisplayExplanation: CALL EnableDisplayUpdate ; Enable display updates LD HL,vMoveExplanation ; Display the hint string ; Intentionally drop through to DisplayMessage #IF $!= DisplayMessage !!!DisplayExplanation/DisplayMessage #ENDIF ;------------------------------------------------------------ ; Display a message on line 1. ; Address of the message in HL. ; Assumes the message is 32 characters. ;------------------------------------------------------------ DisplayMessage: PUSH HL ; Save message address CALL GetMessageScreenAddress ; Get the screen address EX DE,HL ; Screen address now in DE POP HL ; Restore message address LD B,32 Call Decompress ; Copy the message LD A,1 ; Remember message visible LD (vMessageVisible),A RET ;------------------------------------------------------------ ; Back to key handler routines for the PlayGame menu. ;------------------------------------------------------------ PlayGameDifficulty: ; Display the board difficulty CALL DisableAllDisplayUpdates ; Disable all display updates while determining difficulty LD HL,sDifficultyCheckMessage ; Display a message indicating checking difficulty CALL DisplayMessage CALL Difficulty ; Work out the board difficulty CALL DisplayDifficulty ; Display it JP EnableAllDisplayUpdates ; Re-enable all display updates PlayGameShowOptionsKey: .MODULE PGSOK LD A,(vShowOptions) ; Switch between displaying pencilled and actual options XOR $FF ; Toggle all bits in the options flag LD (vShowOptions),A LD DE,sShowOptionsPencilMessage ; Determine which message to display CP PENCILLED_FLAG JR Z,_displayMessage LD DE,sShowOptionsActualMessage _displayMessage LD HL,(D_FILE) ; Get the display address in HL LD BC,1+(2*33) ; Row 2, column 0 ADD HL,BC EX DE,HL ; Now display address in DE and message in HL LD BC,6 ; Six characters LDIR ; Display the text JP DisplayOptions ; Update the options display ; RET merged with CALL ;------------------------------------------------------------ ; Update the current cell display, including options display. ;------------------------------------------------------------ DisplayCurrentCell: .MODULE DCC LD HL,(vCurrentRowColumn) ; Get the currently selected row and column LD A,(vBoardRowOffset) ; Work out the screen address of the cell ADD A,L ADD A,L ; A = row*2 + board row offset LD B,A LD A,(vBoardColOffset) ADD A,H ADD A,H ; A = col*2 + board column offset LD C,A ; B = row*2+row offset, C=col*2+col offset CALL GetScreenAddress ; HL = screen address LD DE,(vCurrentBoardAddress) ; Get the current value on the board. LD A,(DE) ; Get the cell content AND $0F ; Mask out the high nibble of the cell content (used to mark fixed values) OR A ; Check for 0 - goes to space, which is 0 anyway JR Z,_displayChar ; Display a space for an empty cell ADD A,$1C ; Map from 1-9 to '1'-'9' _displayChar LD (HL),A ; Display the cell value RET ; This table is used for fast multiplication by board size up to boardSize*boardSize*boardSize ; It needs to be on a 256-byte boundary. ; It's here in the program as (currently) this is already close to such a boundary. Align256(sMultBoardSizeSq6x6) sMultBoardSizeSq6x6: DEFW 0, 6, 12, 18, 24, 30 DEFW 36, 42, 48, 54, 60, 66 DEFW 72, 78, 84, 90, 96,102 DEFW 108,114,120,126,132,138 DEFW 144,150,156,162,168,174 DEFW 180,186,192,198,204,210 Check256(sMultBoardSizeSq6x6) ;------------------------------------------------------------ ; Update the current cell display, including options display. ;------------------------------------------------------------ UpdateCurrentCellDisplay: .MODULE UCCD LD A,(vDisplayNumbers) ; Check whether we are displaying number updates OR A RET Z CALL DisplayCurrentCell ; Display the cell value ; Deliberately drop through to DisplayMovesLeft #IF $ != DisplayMovesLeft !!!UpdateCurrentCellDisplay/DisplayMovesLeft #ENDIF ;------------------------------------------------------------ ; Display the number of moves left. ;------------------------------------------------------------ SCREEN_OFFSET_MOVES_LEFT EQU 1+(0*33)+30 ; Line 0, column 30 DisplayMovesLeft: .MODULE DML LD A,(vUpdateDisplay) ; Update the moves left display OR A ; Check if display update is 0 RET Z ; Do nothing if display update is 0 LD A,(vMovesLeft) ; Get the number of moves left LD DE,SCREEN_OFFSET_MOVES_LEFT CALL DisplayNumber ; Intentionally drop through to DisplayOptions #IF $ != DisplayOptions !!!DisplayMovesLeft/DisplayOptions #ENDIF ;------------------------------------------------------------ ; Display the valid options for the cell. ;------------------------------------------------------------ PENCILLED_MASK EQU %10111111 PENCILLED_FLAG EQU %01000000 SCREEN_OFFSET_OPTIONS EQU 1+(2*33)+16 ; Line 2, column 16 DisplayOptions: .MODULE DO LD A,(vUpdateDisplay) OR A ; Check if display update is 0 RET Z ; Do nothing if display update is 0 LD BC,SCREEN_OFFSET_OPTIONS ; Get the screen address of the options display LD HL,(D_FILE) ADD HL,BC LD DE,(vCurrentBoardAddress) ; Check whether current cell is occupied. LD A,(DE) ; Get the current cell contents OR A ; Check if cell contents = 0 LD A,(vBoardSize) ; Get the board size, needed in either case LD B,A ; JR Z,_unoccupied ; If cell empty display the options for an unoccupied cell LD A,$16 ; '-' _blankLoop LD (HL),A ; Fill in the options with '-'s INC HL DJNZ _blankLoop RET _unoccupied PUSH HL ; Save the screen address LD A,1 ; Get the address of option 1 CALL GetOptionAddress ; HL = option address POP DE ; DE = screen address LD C,$1D ; The character for the first option, '1' _optionLoop LD A,(vShowOptions) ; Determine whether to show actual or pencilled options AND (HL) ; Apply the required mask to the option value CP 128 ; Now check if the option has been masked JR C,_optionNotMasked ; Never the case if showing pencilled options LD A,$08 ; Get the character for a masked option, '#' JR _showOption ; Show the option as masked _optionNotMasked OR A ; Check if the option value (ignoring pencilled flag) = 0 LD A,C ; If available, use the current option digit character JR Z,_showOption _notOption LD A,$16 ; Use the character for an unavailable option, '-' _showOption LD (DE),A ; Display the option character at the current screen location INC DE ; Move on to the next screen location INC HL ; Move on to the address of the next option INC C ; Move on to the next option digit character DJNZ _optionLoop ; Keep going for all options RET ;------------------------------------------------------------ ; Refresh the full board display ;------------------------------------------------------------ RefreshBoardDisplay: .MODULE RBD LD A,(vBoardSizeSquared) LD B,A LD E,0 _refreshLoop PUSH DE PUSH BC CALL SelectCurrentBoardAddress CALL DisplayCurrentCell POP BC POP DE INC E DJNZ _refreshLoop RET ;------------------------------------------------------------ ; Display a number value at the given screen offset ;------------------------------------------------------------ DisplayNumber: LD HL,(D_FILE) ; Work out the screen address for the moves left value ADD HL,DE LD B,$1C ; B holds the tens digit LD C,10 ; C holds the base for the displayed number _loop CP C ; Check if less than ten left JR C,_under10 ; If so, display current tens digit and then units digit SUB C ; Subtract 10, INC B ; Increment the tens digit, JR _loop ; and keep going _under10 ADD A,$1C ; Adjust units digit to '0' - '9' LD (HL),B ; Display the tens digit INC HL LD (HL),A ; Display the units digit RET ;------------------------------------------------------------ ; Display difficulty using the value in B ;------------------------------------------------------------ SCREEN_OFFSET_DIFF EQU 1+(1*33)+18 ; Line 1, column 18 DisplayDifficulty: .MODULE DD LD HL,sDifficultyMessage ; Display the difficulty message CALL DisplayMessage ;LD HL,sDifficultyMessageSimple ; DisplayMessage should leave HL here LD DE,sDifficultySubMsgLen ; Work out the address of the sub text LD A,B OR A JR Z,_copySubMsg ; If diffuculty is 0, skip _mult ADD HL,DE ; Add in difficulty * sub text length DJNZ _mult _copySubMsg PUSH DE ; Copy the sub text into the message EX DE,HL ; DE now holds the sub text address LD BC,SCREEN_OFFSET_DIFF ; Get the screen address of the difficulty display LD HL,(D_FILE) ADD HL,BC ; HL holds the screen address EX DE,HL ; Now DE screen, HL sub text POP BC ; And BC length LDIR RET ;------------------------------------------------------------ ; Clear any message that is currently displayed. ;------------------------------------------------------------ ClearMessage: LD A,(vMessageVisible) OR A ; Check if message visible = 0 RET Z ; Do nothing if not visible CALL GetMessageScreenAddress ; Get the screen address for the message LD BC,32 XOR A CALL FillArray ; Fill the line with zeros LD (vMessageVisible),A ; Remember no message visible now RET ; This table is used for fast division. It needs to be on a 256-byte boundary. Align256(sDivideBoardSize6x6) sDivideBoardSize6x6: DEFB 0,0,0,0,0,0 ; 0 - 5 DEFB 1,1,1,1,1,1 ; 6 - 11 DEFB 2,2,2,2,2,2 ; 12 - 17 DEFB 3,3,3,3,3,3 ; 18 - 23 DEFB 4,4,4,4,4,4 ; 24 - 29 DEFB 5,5,5,5,5,5 ; 30 - 35 Check256(sDivideBoardSize6x6) ;------------------------------------------------------------ ; Copy the entire screen from the location pointed to by HL ;------------------------------------------------------------ CopyScreen: .MODULE CS ; LD DE,(D_FILE) ; INC DE ; Get address of the first character on the screen ; LD BC,33*24-1 ; 24 rows of 33 columns, excluding the last newline ; LDIR ; Copy the data ; RET LD B,24 ; Process 24 lines _loop PUSH BC PUSH HL LD DE,(D_FILE) ; Copy the screen down one line INC DE LD HL,33 ADD HL,DE LD BC,33*23 LDIR POP HL ; Copy the next line to the bottom of the screen LD B,32 ; Decompress 32 characters CALL Decompress POP BC DJNZ _loop ; Process all lines RET ;_copyLine: LD BC,32 ; Uncompressed version ; LDIR ; 7 bytes ; INC HL ; RET ; Decompress routine ; ; Compressed representation: ; ; 00xxxxxx - character literal ; ; 010nnnnn C - run length of following character nnnnn + 1 * C (1-32) ; 011nnnnn - run length of spaces ($00) nnnnn + 1 * ' '(1-32) ; ; 10xxxxxx - character literal (inverse) ; ; 11nnnnnn - dictionary entry nnnnnn, trailing space D(nnnnnn) ' ' (0-61) ; 11111110 E - dictionary entry E, trailing space D(E) ' ' (0-255) ; 11111111 E - dictionary entry E, no trailing space D(E) (0-255) ; ; This routine is 100 bytes, so need to save at least 93 bytes on compressed display to ; break even. ; In fact, we save something like 4758 bytes using this routine (!) Decompress: .MODULE DECOMP _copyNext: LD A,(HL) BIT 6,A ; Check for a special code, indicated by bit 6 set JR NZ,_special LD (DE),A INC DE _copyLoop: INC HL DJNZ _copyNext ; Keep going until line complete RET _special BIT 7,A ; Check for dictionary entry with bit 7 JR NZ,_dictionary BIT 5,A ; Check for a run of non-zeros, indicated by bit 5 unset JR NZ,_runOfZeros AND $1F LD C,A ; Get the length of the run - 1 INC HL LD A,(HL) ; Get the run character JR _runStart _runOfZeros AND $1F LD C,A ; Get the length of the run - 1 XOR A ; Run of zeros _runStart INC C ; Get the length of the run _runLoop LD (DE),A ; Copy the character INC DE DEC B ; Decrement characters left for this line DEC C ; Decrement characters left for this run JR NZ,_runLoop ; Continue for run length INC B ; Adjust for DJNZ in copy loop JR _copyLoop _dictionary LD C,1 ; Indicate trailing space CP $FE JR Z,_dictionaryNext ; $FE indicates next byte is entry, trailing space CP $FF JR Z,_dictionaryNextNoTS ; $FF indicates next byte is entry, no trailing space AND $3F ; Get the entry _expandDictionary PUSH HL ; Save compressed data location PUSH BC ; Save characters left, trailing space LD HL,sDictionary ; Get the address of the start of the dictionary LD B,0 OR A JR Z,_foundEntry ; Found the dictionary entry ; Replaced this with faster version at the cost of one extra byte per dictionary entry ;_findEndLoop LD B,(HL) ; Get the next character in the entry ; INC HL ; BIT 6,B ; Check bit 6 for the end of the entry ; JR Z,_findEndLoop ; If not set, keep looking ; DEC A ; One less entry to go ; JR NZ,_findEndLoop ; Continue until A is zero _findEndLoop LD C,(HL) ; Get the next entry length ADD HL,BC ; Skip it DEC A ; One less entry to go JR NZ,_findEndLoop ; Continue until A is zero ; At this point we can make use of the fact that (HL) contains the length ; of the entry to be copied + 1, and after loading that, HL, DE, and BC are set up for LDIR. ; Here's the alternative version - 22 bytes. _foundEntry LD C,(HL) ; Get distance to next entry DEC C ; Actual length is 1 less PUSH BC ; Save entry length in C INC HL LDIR POP HL ; HL no longer needed, length in L POP BC ; Restore characters left, trailing space LD A,B SUB L INC A ; Account for decrement in DJNZ LD B,A DEC C ; Check if a space is needed (C=1) JR NZ,_noTrailingSpace ; Z here indicates a space is needed XOR A LD (DE),A ; Store the space INC DE DEC B ; One less character to decompress _noTrailingSpace POP HL ; Restore compressed data location JR _copyLoop ; Here's the original version that relies on the end of entry marker - 26 bytes ; ;_foundEntry POP BC ; Restore characters left, trailing space ;_expandLoop LD A,(HL) ; Get the next character in the entry to expand ; BIT 6,A ; Check if its the last character ; JR NZ,_expandLast ; LD (DE),A ; Store the character as is ; INC DE ; DEC B ; One less character to decompress ; INC HL ; Move on to the next character ; JR _expandLoop ;_expandLast AND $BF ; Mask out the end of entry marker ; LD (DE),A ; Store the character ; INC DE ; Note no decrement of B as that will be done in _copyLoop ; DEC C ; Check if a space is needed (C=1) ; JR NZ,_noTrailingSpace ; Z here indicates a space is needed ; XOR A ; LD (DE),A ; Store the space ; INC DE ; DEC B ; One less character to decompress ;_noTrailingSpace ; POP HL ; Restore compressed data location ; JR _copyLoop _dictionaryNextNoTS DEC C ; Indicate no trailing space _dictionaryNext INC HL LD A,(HL) ; Get the entry number JR _expandDictionary ; Expand the entry ;------------------------------------------------------------ ; Copy part of the screen from the location pointed to by HL. ; DE points to the screen location. ; BC contains the number of rows (B) and columns (C). ;------------------------------------------------------------ CopyPartialScreen: .MODULE CPS PUSH HL ; Remember HL LD HL,(D_FILE) ; Get screen address in DE ADD HL,DE EX DE,HL POP HL _loop PUSH BC ; Save number of rows and columns LD B,C CALL Decompress POP BC ; Restore number of rows and columns LD A,33 ; Increase DE by 33-C SUB C ADD A,E LD E,A JR NC,_next ; Check if addition affects high byte INC D ; Increment it if there is carry _next DJNZ _loop ; Do the next row RET ;------------------------------------------------------------ ; Get the screen address and length for displaying a message ;------------------------------------------------------------ SCREEN_OFFSET_MESSAGE EQU 1+(1*33) ; Line 1, column 0 GetMessageScreenAddress: LD HL,(D_FILE) ; Get the address of the display file LD DE,SCREEN_OFFSET_MESSAGE ADD HL,DE ; Work out the address of the message on the screen RET ;------------------------------------------------------------ ; Get the current key press in A ; Returns 1 if no key pressed ;------------------------------------------------------------ GetKey: CALL KSCAN ; Scan keyboard LD B,H LD C,L LD D,C INC D RET Z ; Z set indicates no key CALL FINDCHR ; Translate to a character value LD A,(HL) ; Get the character value OR A ; Ensure Z cleared if A non-zero RET ; Means space is not considered a key... ;------------------------------------------------------------ ; Invert a row of characters at address HL for B characters ;------------------------------------------------------------ InvertHoriz: .MODULE IH LD C,128 ; Bit pattern used to invert a character _loop LD A,(HL) ; Get the character from screen XOR C ; Invert it LD (HL),A ; Put the inverted character back on the screen INC HL ; Next character in the row DJNZ _loop ; Keep going as far as required RET ;------------------------------------------------------------ ; Wait for any key press and release. ;------------------------------------------------------------ GetKeyPress: LD HL,(vRandomSeed) INC HL LD (vRandomSeed),HL CALL GetKey ; Get the currently pressed key JR Z,GetKeyPress ; Z set if no key pressed ; Intentionally drop through to WaitForNoKey ;------------------------------------------------------------ ; Wait for key release. ;------------------------------------------------------------ WaitForNoKey: .MODULE WFK PUSH AF ; Save the key value _loop CALL GetKey ; Check if any key still pressed JR NZ,_loop ; Z set if no key pressed POP AF ; Restore the key value RET ;------------------------------------------------------------ ; Flash the message on line 1 until a key is pressed. ;------------------------------------------------------------ FlashMessage: LD B,32 ; Flash the message line until key pressed LD HL,(D_FILE) ; Work out the address of the message on screen LD DE,SCREEN_OFFSET_MESSAGE ADD HL,DE JR WaitForKeyFlash ; This table is used for fast remainder. It needs to be on a 256-byte boundary. Align256(sModBoardSize6x6) sModBoardSize6x6: DEFB 0,1,2,3,4,5 ; 0 - 5 DEFB 0,1,2,3,4,5 ; 6 - 11 DEFB 0,1,2,3,4,5 ; 12 - 17 DEFB 0,1,2,3,4,5 ; 18 - 23 DEFB 0,1,2,3,4,5 ; 24 - 29 DEFB 0,1,2,3,4,5 ; 30 - 35 Check256(sModBoardSize9x9) ; Enforce the fact that we rely on sModBoardSize6x6 being 256 bytes beyond sDivideBoardSize6x6 #IF sModBoardSize6x6 - sDivideBoardSize6x6 != 256 !!! #ENDIF ;------------------------------------------------------------ ; Wait for any key press, flashing the line at HL, length B ; Not very pretty..... ;------------------------------------------------------------ WaitForKeyFlash: LD A,(HL) ; Check for a character at the given location OR A RET Z ; If no character, return having done nothing PUSH HL ; Save screen address PUSH BC ; Save length of message CALL InvertHoriz ; Invert B characters HALT ; Wait for screen update POP BC ; Restore length of message POP HL ; Restore screen address PUSH HL ; Save screen address PUSH BC ; Save length of message CALL InvertHoriz ; Re-invert HALT ; Wait for screen update CALL GetKey ; Check to see if a key has been pressed POP BC ; Restore length of message POP HL ; Restore screen address JR Z,WaitForKeyFlash ; No key pressed - keep flashing JR WaitForNoKey ; Wait until the key is released ;------------------------------------------------------------ ; Invert the currently selected row and column. ;------------------------------------------------------------ InvertRowColumn: LD A,(vUpdateDisplay) OR A ; Check if display updates = 0 RET Z ; Do nothing if display updates is zero LD A,(vCurrentRow) ; Work out the screen address for the start of the row LD BC,(vBoardColRowOffset) ; b = row offset, c = col offset ADD A,A ADD A,B ; A = r*2+row offset LD B,A ; row = r*2+row offset, col = col offset CALL GetScreenAddress ; B = row, C = col LD A,(vBoardSize) ADD A,A DEC A LD B,A ; boardsize * 2 - 1 characters CALL InvertHoriz ; Invert the row LD A,(vCurrentColumn) ; Work out the screen address for the start of the column LD BC,(vBoardColRowOffset) ; b = row offset, c = col offset ADD A,A ADD A,C ; A = c*2+col offset LD C,A ; col = column c*2+col offset, row = row offset CALL GetScreenAddress ; B = row, C = col LD A,(vBoardSize) ADD A,A DEC A LD B,A ; boardsize * 2 - 1 characters ; Intentionally drop through to InvertVert ;------------------------------------------------------------ ; Invert a row of characters at address HL for B characters ;------------------------------------------------------------ InvertVert: .MODULE IV LD DE,33 ; Number of characters per line LD C,128 ; Bit pattern used to invert a character _loop LD A,(HL) ; Get the character from the screen XOR C ; Invert the character LD (HL),A ; Put the inverted character back on the screen ADD HL,DE ; Next character in the column DJNZ _loop ; Do all required rows RET ;------------------------------------------------------------ ; Disable all display updates, including number placement ;------------------------------------------------------------ DisableAllDisplayUpdates: XOR A LD (vDisplayNumbers),A ; Intentionally drop through to DisableDisplayUpdate ;------------------------------------------------------------ ; Disable display updates. ;------------------------------------------------------------ DisableDisplayUpdate: CALL InvertRowColumn ; Uninvert the current row/column XOR A LD (vUpdateDisplay),A ; Remember display update is disabled LD HL,(vCurrentRowColumn) ; Save the current row/column LD (vSavedRowColumn),HL RET ;------------------------------------------------------------ ; Enable all display updates, including number placement ;------------------------------------------------------------ EnableAllDisplayUpdates: LD A,1 LD (vDisplayNumbers),A JR EnableDisplayUpdate ;------------------------------------------------------------ ; Enable display updates. ;------------------------------------------------------------ EnableDisplayUpdate: LD A,1 ; Remember display update is enabled LD (vUpdateDisplay),A CALL DisplayMovesLeft ; Ensure moves left and options displayed LD BC,(vSavedRowColumn) ; Re-select the row/column that was selected Call SelectCurrentRowColumn ; when display updates were disabled JR InvertRowColumn ; Re-invert the current row/column ; RET merged with CALL ;------------------------------------------------------------ ; Get screen address. B=row, C=column ;------------------------------------------------------------ GetScreenAddress: .MODULE GSA LD HL,(D_FILE) ; Get the address of the display file INC HL ; Skip first byte LD A,B OR A ; Check if line number = 0 JR Z,_doneLines ; Skip first line LD DE,33 ; Number of characters per line _addLine ADD HL,DE DJNZ _addLine ; Add 33 per line _doneLines ADD HL,BC ; Add in the column (B = 0 by now) RET ;------------------------------------------------------------ ; ; End of UI routines... ; ;------------------------------------------------------------ ;------------------------------------------------------------ ; ; Start hand compilation of Java code to Z80 ASM... ; Lines with C have been hand-compiled ; ; As a general rule, methods are called with parameters in ; registers. A and HL are avoided for carrying parameters ; as they are generally used for calculations, however ; A is quite often used as the return value as that is likely ; to then be used immediately. ; For consistency, the following are the usual uses of registers: ; A working, return from method call ; B column ; C row ; D ; E array index, board address ; H working ; L working ; ; Methods trash register values; its up to the callers to ; protect values that they depend on. ; Methods may store parameter values at fixed addresses; this ; doesn't support recursive behaviour. ; ;------------------------------------------------------------ ;------------------------------------------------------------ ; SelectCurrentRowColumn ; ; Select the cell identified by the given row and column. ; ; These values are used until a different cell is selected. ; ; Registers on input: Registers on output: ; A A boardAddress ; B column B column (unchanged) ; C row C row (unchanged) ; D D unchanged ; E E trashed ; H H trashed ; L L trashed ;------------------------------------------------------------ SelectCurrentRowColumn: ;CALL TestValidateCoords ; TEST only: validate coordinates LD (vCurrentRowColumn),BC LD HL,(vMultBoardSize) ; Work out the board address of the row/column LD L,C ; vMultBoardSize is on a 256-byte boundary LD A,(HL) ADD A,B ; A = row * vBoardSize + col LD (vCurrentBoardAddress),A RET ;------------------------------------------------------------ ; SelectCurrentBoardAddress ; ; Select the cell identified by the board address ; ; Registers on input: Registers on output: ; A A trashed ; B B column ; C C row ; D D unchanged ; E board address E board address ; H H trashed ; L L trashed ;------------------------------------------------------------ SelectCurrentBoardAddress: ;CALL TestValidateBA ; TEST only: validate board address ; Inlined: CALL GetRowColumnNumber ; Get row/column from board address LD HL,(vDivideBoardSize) ; Divide the address by the board size LD L,E ; vDivideBoardSize is on a 256-byte boundary LD C,(HL) ; C = getRowNumber(boardAddress) INC H ; vModBoardSize must be 256 greater than vDivideBoardSize LD B,(HL) ; B = getColumnNumber(boardAddress) ; Intentionally drop through to SelectCurrentRowColumnAddress ;------------------------------------------------------------ ; SelectCurrentRowColumnAddress ; ; Select the cell identified by the row and column and board address ; ; These values are used until a different cell is selected. ; ; Registers on input: Registers on output: ; A A board address ; B column B column (unchanged) ; C row C row (unchanged) ; D D unchanged ; E board address E board address (unchanged) ; H H unchanged ; L L unchanged ;------------------------------------------------------------ SelectCurrentRowColumnAddress: ;CALL TestValidateCoords ; TEST only: validate coordinates LD (vCurrentRowColumn),BC ; Save row and column LD A,E LD (vCurrentBoardAddress),A ; Save current board address RET ;------------------------------------------------------------ ; GetRowColumnNumber ; ; Optimised version of separate getRowNumber/getColumnNumber ; ; Registers on input: Registers on output: ; A A unchanged ; B B column ; C C row ; D D unchanged ; E board address E board address (unchanged) ; H H trashed ; L L trashed ;------------------------------------------------------------ GetRowColumnNumber: LD HL,(vDivideBoardSize) ; Divide the address by the board size LD L,E ; vDivideBoardSize is on a 256-byte boundary LD C,(HL) ; C = getRowNumber(boardAddress) INC H ; vModBoardSize must be 256 greater than vDivideBoardSize LD B,(HL) ; B = getColumnNumber(boardAddress) RET ;------------------------------------------------------------ ; GetBlockNumber ; ; Returns the block number for the given board address. ; ; Registers on input: Registers on output: ; A A block number ; B B unchanged ; C C unchanged ; D D unchanged ; E board address E board address (unchanged) ; H H trashed ; L L trashed ;------------------------------------------------------------ GetBlockNumber: ;LD H,sRemoveMod3DataHigh ; Set A to be ((int)row/3, assuming 0 <= row <= 8 ;LD L,C ; sRemoveMod3Data is on a 256-byte boundary ;LD A,(HL) ; A is now ((int)row/3)*3 ;INC H ; sDiv3Data is 256 bytes beyond sRemoveMod3Data ;LD L,B ; sDiv3Data is on a 256-byte boundary ;ADD A,(HL) ; Now add (int)column/3 LD HL,(vBlockNumbers) LD L,E ; vBlockNumbers is on a 256-byte boundary LD A,(HL) RET ;------------------------------------------------------------ ; GetBlockAndCellNumber ; ; Returns the block and cell number for a given row and column ; ; Registers on input: Registers on output: ; A A trashed ; B column B column (unchanged) ; C row C row (unchanged) ; D D cell number ; E E block number ; H H trashed ; L L trashed ;------------------------------------------------------------ GetBlockAndCellNumber: LD HL,(vMultBoardSize) ; Work out the board address of the row/column LD L,C ; vMultBoardSize is on a 256-byte boundary LD A,(HL) ADD A,B ; A = row * vBoardSize + col LD HL,(vBlockNumbers) LD L,A ; vBlockNumbers is on a 256-byte boundary LD E,(HL) ; E = block number for this cell LD HL,(vCellNumbers) LD L,A ; vCellNumbers is on a 256-byte boundary LD D,(HL) ; D = cell number within the block for this cell RET ;------------------------------------------------------------ ; RemoveOption, RemoveOption2 ; ; Remove the given option from the currently selected cell. ; ; The second entry point requires the board address in E. ; ; Registers on input: Registers on output: ; A A trashed ; B B trashed ; C C trashed ; D option D trashed ; E [board address] E trashed ; H H trashed ; L L trashed ;------------------------------------------------------------ RemoveOption: LD A,(vCurrentBoardAddress) ; Get the current board address LD E,A RemoveOption2: LD B,D ; The option to be removed LD C,128 ; Modify the option value by 128 to indicate manually removed JP UpdateOption ; Update the option value and its effects ; RET merged with CALL ; Multiples of the board size. ; Must be on a 256-byte boundary. Align256(sMultBoardSize9x9) sMultBoardSize9x9: DEFB 0,9,18,27,36,45,54,63,72 ; can't reuse mult sq as that's words Check256(sMultBoardSize9x9) ;------------------------------------------------------------ ; GetOptionAddress, GetOptionAddress0 ; ; Get the address of the given option. ; ; Registers on input: Registers on output: ; A option number A trashed ; B B unchanged ; C C unchanged ; D D unchanged ; E boardAddress E boardAddress (unchanged) ; H H } optionAddress ; L L } ;------------------------------------------------------------ GetOptionAddress: .MODULE GOA DEC A ; This is used when the option is 1-based GetOptionAddress0: ; This is used when the option is zero-based LD HL,(vMultBoardSizeSq) ; Multiply the board address by board size LD L,E ; vMultBoardSizeSq is on a 256-byte boundary SLA L ; Entries are 2 bytes each ADD A,(HL) ; A = low byte of option address + option number INC HL ; Move on to the high byte LD H,(HL) ; Get the high byte of multiplied value JR NC,_notCrossing ; Check if add resulted in carry (INC and LD don't affect C flag) INC H ; Add carry to the high byte of the multiplied value _notCrossing LD L,A ; Get the low byte of the multiplied value LD A,vOptionsHigh ; Add in the address of the options table ADD A,H LD H,A ; Now we've got the address of the option value RET ;------------------------------------------------------------ ; GetOptionAddressBase ; ; Get the base address for options for the given address. ; ; Registers on input: Registers on output: ; A A trashed ; B B unchanged ; C C unchanged ; D D unchanged ; E boardAddress E boardAddress (unchanged) ; H H } optionAddress ; L L } ;------------------------------------------------------------ GetOptionAddressBase: ; This is used when the option is zero-based LD HL,(vMultBoardSizeSq) ; Multiply the board address by board size LD L,E ; vMultBoardSizeSq is on a 256-byte boundary SLA L ; Entries are 2 bytes each LD A,(HL) ; A = low byte of option address + option number INC HL ; Move on to the high byte LD H,(HL) ; Get the high byte of multiplied value LD L,A ; Get the low byte of the multiplied value LD A,vOptionsHigh ; Add in the address of the options table ADD A,H LD H,A ; Now we've got the address of the option value RET ;------------------------------------------------------------ ; InitializeBoard ; ; Registers on input: Registers on output: ; A A trashed ; B B trashed ; C C trashed ; D D trashed ; E E trashed ; H H trashed ; L L trashed ;------------------------------------------------------------ InitializeBoard: .MODULE IB LD A,(vBoardType) CP SIX_BY_SIX JR Z,_6x6 LD A,9 ; Only 6x6 and 9x9 supported at the moment. LD (vBoardSize),A ; Store the board size LD HL,sLookupTables9x9 ; Set up all the lookup tables to use the 9x9 versions. LD DE,vLookupTables LD BC,vLookupTablesLength LDIR LD HL,9*9 LD A,L LD (vBoardSizeSquared),A ; Remember the board size squared value LD A,9*(9-1)/2 ; The sum of option values 0 to 8 LD (vBoardSizeValueSum),A ; Store this for later use LD A,sNumBoards9x9 ; Remember the number of pre-set boards LD (vNumBoards),A JR ResetBoard _6x6: LD A,6 LD (vBoardSize),A ; Store the board size LD HL,sLookupTables6x6 ; Set up all the lookup tables to use the 6x6 versions. LD DE,vLookupTables LD BC,vLookupTablesLength LDIR LD HL,6*6 LD A,L LD (vBoardSizeSquared),A ; Remember the board size squared value LD A,6*(6-1)/2 ; The sum of option values 0 to 6 LD (vBoardSizeValueSum),A ; Store this for later use LD A,sNumBoards6x6 ; Remember the number of pre-set boards LD (vNumBoards),A JR ResetBoard ResetBoard: LD A,(vBoardSizeSquared) ; General initialization for any size board LD (vMovesLeft),A ; Moves left is number of cells on the board XOR A LD (vMoves),A ; Number of moves is 0 INC A LD (vSetupMode),A ; Start in setup mode LD HL,vComputationData ; Fill all data arrays with zeros to begin with LD BC,vComputationDataLength XOR A CALL FillArray LD HL,vOptions ; Indicate that no options available by pencil marks LD BC,vOptionsLen LD A,PENCILLED_FLAG CALL FillArray LD A,(vBoardSizeSquared) ; Get the size of the array LD C,A LD B,0 LD A,(vBoardSize) ; Fill vRowOptionCounts with vBoardSize LD HL,vRowOptionCounts CALL FillArray LD HL,vColumnOptionCounts ; Fill vColumnOptionCounts with vBoardSize CALL FillArray LD HL,vBlockOptionCounts ; Fill vBlockOptionCounts with vBoardSize CALL FillArray LD HL,vCellOptionCounts ; Fill vCellOptionCounts with vBoardSize CALL FillArray LD A,(vBoardSizeValueSum) ; Fill vRowOnlyOptionColumns with vBoardSizeValueSum LD HL,vRowOnlyOptionColumns CALL FillArray LD HL,vColumnOnlyOptionRows ; Fill vColumnOnlyOptionRows with vBoardSizeValueSum CALL FillArray LD HL,vBlockOnlyOptionCells ; Fill vBlockOnlyOptionCells with vBoardSizeValueSum ; Intentionally drop through to FillArray #IF $ != FillArray !!! #ENDIF ;------------------------------------------------------------ ; FillArray ; ; Fill an area of memory with the given value. ; ; Registers on input: Registers on output: ; A value A value (unchanged) ; B } size B } size (unchanged) ; C } C } ; D D trashed ; E E trashed ; H } address H trashed ; L } L trashed ;------------------------------------------------------------ FillArray: PUSH BC ; Store the number of elements LD (HL),A ; Store first value in source DEC BC ; Done one LD D,H ; Destination is next value LD E,L INC DE LDIR ; Copy source to destination POP BC ; Restore the number of elements RET ;------------------------------------------------------------ ; GetHint ; ; Get a hint for the next move to make. ; ; Registers on input: Registers on output: ; A A trashed ; B B trashed ; C C trashed ; D D trashed ; E E trashed ; H H trashed ; L L trashed ;------------------------------------------------------------ GetHint: CALL FindNextMove ; Find the next possible move RET Z ; Return if no move LD (vSavedRowColumn),BC ; Ensure the cell gets selected RET ;------------------------------------------------------------ ; SolveNext ; ; Solve one cell. ; ; Registers on input: Registers on output: ; A A trashed ; B B trashed ; C C trashed ; D D trashed ; E E trashed ; H H trashed ; L L trashed ;------------------------------------------------------------ SolveNext: .MODULE SN CALL FindNextMove ; Find the next possible move RET Z ; No move possible CP FIND_MOVE_PLACE ; Next call doesn't affect flags LD (vSavedRowColumn),BC ; Ensure the cell gets selected JR Z,SelectRCAAndPlace ; Select the identified row/column/address and place the number LD A,D ; Intentionally drop through to PencilOption #IF $ != PencilOption !!!SolveNext/PencilOption #ENDIF ;------------------------------------------------------------ ; PencilOption ; ; Pencil in the given option as available in the selected cell. ; ; Registers on input: Registers on output: ; A option A trashed ; B B trashed ; C C trashed ; D D trashed ; E E trashed ; H H trashed ; L L trashed ; ;------------------------------------------------------------ PencilOption: LD DE,(vCurrentBoardAddress) ; Get the current board address CALL GetOptionAddress LD A,(HL) ; Get the current option value XOR PENCILLED_FLAG ; Flip pencilled flag for the option LD (HL),A ; Update the option value RET ; This table maps from board address to the block number of which that cell is a member. ; Needs to be on a 256-byte boundary. Align256(sBlockNumbers9x9) sBlockNumbers9x9: DEFB 0,0,0,1,1,1,2,2,2 ; 0 - 8 DEFB 0,0,0,1,1,1,2,2,2 ; 9 - 17 DEFB 0,0,0,1,1,1,2,2,2 ; 18 - 26 DEFB 3,3,3,4,4,4,5,5,5 ; 27 - 35 DEFB 3,3,3,4,4,4,5,5,5 ; 36 - 44 DEFB 3,3,3,4,4,4,5,5,5 ; 45 - 53 DEFB 6,6,6,7,7,7,8,8,8 ; 54 - 62 DEFB 6,6,6,7,7,7,8,8,8 ; 63 - 71 DEFB 6,6,6,7,7,7,8,8,8 ; 72 - 80 Check256(sBlockNumbers9x9) ;------------------------------------------------------------ ; SelectAndPlace, SelectRCAAndPlace ; ; Select the current cell and place the given value there. ; NZ on return indicates that the placement failed. ; ; PlaceAtSelected, PlaceAtSelected2 ; ; Place the given value in the currently selected cell. ; NZ on return indicates that the placement failed. ; ; PlaceAtSelected2 can be called if E already contains ; the current board address. ; ; Registers on input: Registers on output: ; A A trashed ; B B trashed ; C C trashed ; D number D trashed ; E [board address] E trashed ; H H trashed ; L L trashed ;------------------------------------------------------------ PlaceAtSelected: .MODULE PAS LD A,(vCurrentBoardAddress) LD E,A ; E = current board address JR PlaceAtSelected2 SelectAndPlace: CALL SelectCurrentBoardAddress JR PlaceAtSelected2 SelectRCAAndPlace: CALL SelectCurrentRowColumnAddress JR PlaceAtSelected2 PlaceAtSelected2: LD A,D ; A = number to be placed CALL GetOptionAddress ; Check if the option is available in this cell LD A,(HL) ; A = vOptions[optionAddress] AND PENCILLED_MASK ; Check if option value (ignoring pencilled bit) = 0 RET NZ ; NZ indicates failure LD B,vBoardContentsHigh ; If there is already a number in this cell, clear it. LD C,E LD A,(BC) ; Get the cell contents OR A ; Check if cell contents = 0 JR Z,_storeMove ; If empty, cell does not need to be cleared PUSH DE ; Save number, board address PUSH BC ; Save cell address LD A,1 ; A indicates history needs to be updated CALL ClearSelected ; Clear the currently selected cell POP BC ; Resource cell address POP DE ; Restore number, board address RET NZ ; Failed to clear the cell _storeMove LD A,(vMoves) ; Get the address of the current move in the history LD H,vHistoryHigh LD L,A ; History is on a 256-byte boundary LD (HL),E ; Store the board address of the move LD A,(vSetupMode) OR A ; Check if setup mode = 0 LD A,D ; A = number JR Z,_notSetupMode OR $F0 ; A = number | 0xf0 _notSetupMode LD (BC),A ; Store the number on the board LD HL,vMoves INC (HL) ; Increment the number of moves INC HL ; vMovesLeft is immediately after vMoves in memory DEC (HL) ; Decrement the number of moves left LD B,D LD C,1 ; B = number, c = 1 (indicates number placed) CALL UpdateOptions ; Update the valid options having placed the number CALL UpdateCurrentCellDisplay ; Update the current cell display XOR A ; Ensure Z flag set to indicate success RET ;------------------------------------------------------------ ; IsUnique ; ; Check if there is a unique solution. ; On return Z flag set indicates unique solution. ; ; Registers on input: Registers on output: ; A A trashed ; B B trashed ; C C trashed ; D D trashed ; E E trashed ; H H trashed ; L L trashed ;------------------------------------------------------------ IsUnique: .MODULE IU LD A,1 LD (vCheckUnique),A ; Indicate uniqueness checking CALL FindBruteForce ; Do a brute force search LD HL,vCheckUnique LD A,(HL) LD (HL),0 ; Reset the check unique flag CP 2 ; If unique, check unique returns 2 RET ; Z indicates success ;------------------------------------------------------------ ; Difficulty ; ; Work out the difficulty of the current board. ; Returns a value 0 .. 5 ; ; Registers on input: Registers on output: ; A A trashed ; B B The difficulty ; C C trashed ; D D trashed ; E E trashed ; H H trashed ; L L trashed ;------------------------------------------------------------ Difficulty: .MODULE D XOR A LD (vDifficulty),A ; Reset difficulty level LD HL,vBoardContents ; Make a copy of the current board contents LD DE,vBoardCopy LD BC,9*9 LDIR CALL SolveAll ; Solve the entire board, working out the difficulty CALL ResetBoard ; Reset the board LD HL,vBoardCopy CALL LoadBoard2 ; Load back in the current board LD A,(vDifficulty) ; Get the difficulty determined LD C,16 ; Difficulty 5 indicated by bit 4 set LD B,5 _findDiff CP C ; See if current difficulty bit set RET NC ; If so, return the value CCF ; Look at next bit RR C DEC B ; And one less difficulty JR NZ,_findDiff ; Keep going if greater than zero RET ;------------------------------------------------------------ ; SolveAll ; ; Solve all cells in the puzzle. ; ; Registers on input: Registers on output: ; A A indicates whether solved or not ; B B trashed ; C C trashed ; D D trashed ; E E trashed ; H H trashed ; L L trashed ; ;------------------------------------------------------------ SolveAll: .MODULE SA LD A,1 LD (vSolvingAll),A ; Indicate that a solution is being sought _nextMove LD A,(vMovesLeft) OR A ; Check if moves left = 0 JR Z,_solveDone ; No moves left, so done LD (vNoExplanation),A ; Indicate no move explanation required CALL FindNextMove ; Try to find a move to make JR Z,_solveDone ; No move found LD A,(vMovesLeft) ; Check again whether fully solved OR A ; Check if moves left = 0 JR Z,_solveDone ; In which case no need to place number CALL SelectRCAAndPlace ; Select the row/column/address and place the value JR Z,_nextMove ; Z indicates success _solveDone XOR A ; Clear the solving all flag LD (vSolvingAll),A LD (vNoExplanation),A RET ; This table maps from board address to the cell number within a block. ; Needs to be on a 256-byte boundary. Align256(sCellNumbers9x9) sCellNumbers9x9: DEFB 0,1,2,0,1,2,0,1,2 ; 0 - 8 DEFB 3,4,5,3,4,5,3,4,5 ; 9 - 17 DEFB 6,7,8,6,7,8,6,7,8 ; 18 - 26 DEFB 0,1,2,0,1,2,0,1,2 ; 27 - 35 DEFB 3,4,5,3,4,5,3,4,5 ; 36 - 44 DEFB 6,7,8,6,7,8,6,7,8 ; 45 - 53 DEFB 0,1,2,0,1,2,0,1,2 ; 54 - 62 DEFB 3,4,5,3,4,5,3,4,5 ; 63 - 71 DEFB 6,7,8,6,7,8,6,7,8 ; 72 - 80 Check256(sCellNumbers9x9) ;------------------------------------------------------------ ; Undo ; ; Undo the last move made. ; On return, the Z flag is set if a move could be undone, i.e. Z => true ; ; TODO: enable undo of option removal and cell clearing ; ; Registers on input: Registers on output: ; A A trashed ; B B trashed ; C C trashed ; D D trashed ; E E trashed ; H H trashed ; L L trashed ;------------------------------------------------------------ Undo: .MODULE U LD A,(vMoves) OR A ; Check if any moves made JR NZ,_movesNonZero ; Return if no moves made INC A ; Ensure Z not set RET ; Z indicates undo failed _movesNonZero DEC A ; Undo the previous move LD H,vHistoryHigh LD L,A ; History is on a 256-byte boundary LD E,(HL) ; Get the board address of the last move CALL SelectCurrentBoardAddress ; Select the board address as current XOR A ; Indicate history update not required ; Intentionally drop through to ClearSelected #IF $ != ClearSelected !!!Undo/ClearSelected #ENDIF ;------------------------------------------------------------ ; ClearSelected ; ; Clear the contents of the currently selected cell. ; On return, the Z flag is set if the cell could be cleared, i.e. Z => true ; ; Registers on input: Registers on output: ; A checkHistory A trashed ; B B trashed ; C C trashed ; D D trashed ; E E trashed ; H H trashed ; L L trashed ;------------------------------------------------------------ ClearSelected: .MODULE CS PUSH AF ; Store checkHistory value for later use LD HL,(vCurrentBoardAddress) ; Get the current board address LD B,(HL) ; Get the content of the current cell LD A,$F0 ; Check if the top nibble is set AND B ; A = number & 0xf0 JR Z,_okToClear ; If not set, then OK to clear the cell LD A,(vSetupMode) ; Check if in setup mode CP 1 ; 1 indicates setup mode, so can clear cell JR NZ,_doneNothing ; If not setup mode, return _okToClear LD A,$0F AND B ; Mask off the high nibble JR NZ,_occupied ; If number non-zero, then cell is occupied _doneNothing POP HL ; Discard checkHistory value INC A ; If number is 0, there is nothing to do RET ; Return NZ to indicate nothing was done. _occupied LD (HL),0 ; Clear the contents of the cell LD B,A ; B is the option number LD C,$FF ; Option modifier = -1 CALL UpdateOptions ; Remove the effect of this number on the options POP AF ; See whether to check history for this cell OR A ; Check if checkHistory = 0 JR Z,_historyDone ; If so, no need to modify history LD A,(vMoves) LD B,A DEC B ; If vMoves = 1, don't bother JR Z,_historyDone LD A,(vCurrentBoardAddress) ; Get the current board address LD HL,vHistory ; Start with the address of the first history value _historyLoop LD E,(HL) ; Get the history value CP E ; Compare with the current board address JR Z,_foundHistory ; If they match, then we need to remove this history element INC HL ; Move on to the next element in the hisory DJNZ _historyLoop ; Keep going until all moves made have been compared JR _historyDone ; The current board address was not found in the history _foundHistory LD D,H ; Copy values over the top of the entry in the history LD E,L INC HL LD C,B LD B,0 LDIR _historyDone LD HL,vMoves DEC (HL) ; Decrement the number of moves INC HL INC (HL) ; Increment the number of moves left CALL UpdateCurrentCellDisplay ; Update the current cell display XOR A ; Set Z flag to indicate success RET ;------------------------------------------------------------ ; LoadBoard ; ; Loads a supplied board. ; ; The second entry point requires the address of board data ; in HL. ; ; Registers on input: Registers on output: ; A A trashed ; B B trashed ; C C trashed ; D D trashed ; E E trashed ; H } [Board data] H trashed ; L } L trashed ;------------------------------------------------------------ LoadBoard: .MODULE LB CALL Undo ; Undo sets Z flag if successful JR Z,LoadBoard ; Keep going until all moves undone _undoDone LD A,(vNumBoards) LD C,A ; C = num boards LD DE,(vBoardSizeSquared) ; Get the size of single board's data LD HL,(vBoardData) ; Get the address of the first board LD A,(vCurrentBoard) OR A ; Check if current loaded board = 0 JR Z,_found ; If so, then we've got the address CP C ; Check if over the number of boards LD B,A ; Iterate for the number of boards JR NZ,_findLoop ; Find the board address in memory XOR A ; Go back to the first board JR _found ; And already got the address _findLoop ADD HL,DE ; Move on by the size of data for a single board DJNZ _findLoop _found INC A ; Increment the board number CP C ; Check if we need to wrap round to zero JR NZ,_updateBoardNo ; If not, start loading the board XOR A ; Wrap the board number round to zero _updateBoardNo LD (vCurrentBoard),A ; Store the next board number LD B,E ; Get the number of cells in a board _startLoading LD E,0 ; Start with board address 0 _loop PUSH DE ; Save current board address PUSH BC ; Save number of cells to place LD A,(HL) ; Get the cell value to place OR A ; Check if cell value to place = 0 JR Z,_next ; If so, skip placing the value AND $0F ; Just use the low nibble LD D,A PUSH HL CALL SelectAndPlace ; Select cell and place the number there POP HL ; Restore the address of board data _next POP BC ; Restore the number of cells to place POP DE ; Restore the current board address INC E ; Move on to the next cell INC HL ; Move on to the next board data address DJNZ _loop ; Keep going for all cells on the board RET LoadBoard2: LD A,(vBoardSizeSquared) ; Get the size of a single board's data LD B,A JR _startLoading ; Load up the board. ;------------------------------------------------------------ ; GenerateBoard ; ; Generates a new board. ; ; Registers on input: Registers on output: ; A A trashed ; B B trashed ; C C trashed ; D D trashed ; E E trashed ; H H trashed ; L L trashed ;------------------------------------------------------------ SCREEN_OFFSET_CELLS_LEFT EQU 1+(33*1)+30 GenerateBoard: .MODULE GB LD A,(vSetupMode) ; Only works in setup mode OR A RET Z CALL FAST _clearBoard CALL Undo ; Undo all moves made so far JR Z,_clearBoard ; LD A,(vBoardSizeSquared) ; LD DE,SCREEN_OFFSET_CELLS_LEFT ; CALL DisplayNumber ; Display the number of cells left LD HL,vGenerateRandomCells ; This will hold a random sequence of columns LD A,(vBoardSize) CALL RandomFill ; Generate the random column sequence ; Try to randomly fill the puzzle by iterating through the ; rows, placing each number. ; i.e. try placing 1 in each row in turn, then move on to 2; keep ; going until all numbers placed in all rows. Step back if a ; number can't be placed and try a different position. XOR A LD (_vRow),A ; Initialize row (0-based) LD (_vNumber),A ; Initialize number (0-based) LD HL,vGenerateStack+1 ; HL points to the stack of available columns LD (_vStackPointer),HL ; Save the stack pointer LD (HL),$FF ; Stack always starts with 0xFF _fillNext LD HL,(_vStackPointer) DEC HL ; Mark the previous stack value SET 7,(HL) ; as being the last one for the previous row. LD HL,(vBARowStarts) ; Get the start offset for the current row LD A,(_vRow) ADD A,L ; vBARowStarts doesn't cross a 256-byte boundary LD L,A LD C,(HL) ; Get the start offset LD A,(vBoardSize) ; Process all columns in the row LD B,A LD HL,vGenerateRandomCells ; This table holds the randomized column numbers _cellLoop LD A,(HL) ; Get the next randomised column number ; Don't actually need to add in row cell offsets as RowCellOffsets(A) always = A ; LD DE,(vBARowCellOffsets) ; Get the column offset ; ADD A,E ; vBARowCellOffsets doesn't cross a 256-byte boundary ; LD E,A ; LD A,(DE) ; Get the cell offset ADD A,C ; Add the start offset LD E,A ; Check if the cell is available LD D,vBoardContentsHigh ; vBoardContents is on a 256-byte boundary LD A,(DE) ; Get the contents of the cell OR A JR NZ,_nextCell ; Cell is not available, so skip LD A,(_vNumber) ; Get the number being placed PUSH HL ; Save the randomised column number address CALL GetOptionAddress0 ; Get the option address for the number LD A,(HL) AND PENCILLED_MASK ; Check if the option is available JR NZ,_nextCell2 ; Option is not available in this cell, so skip LD HL,(_vStackPointer) ; Put the board address of the cell on the stack LD (HL),E INC HL LD (_vStackPointer),HL ; Increment the stack pointer _nextCell2 POP HL ; Restore the randomized column number address _nextCell INC HL ; Move on to the next randomized column number address DJNZ _cellLoop ; Process all columns LD HL,(_vStackPointer) ; Check if any values have been added to the stack DEC HL ; If the top value has bit 7 set, then we've not BIT 7,(HL) ; added any values JR Z,_placeValue ; We've found at least one available cell, so place the current number _undoLastMove PUSH HL ; Save the stack pointer address - 1 CALL Undo ; Undo the last move LD HL,_vRow LD A,(HL) ; Decrement the row number OR A JR Z,_decreaseNumber ; If already zero, then decrement the number DEC (HL) ; Just decrement the row JR _undoNext ; See whether more moves need to be undone _decreaseNumber LD A,(vBoardSize) ; Set the row number to board size - 1 DEC A LD (HL),A LD HL,_vNumber ; Decrement the number DEC (HL) _undoNext POP HL ; Restore the stack pointer address - 1 LD A,(HL) ; Get the top value on the stack CP $FF JR NZ,_placeValue ; If it's not $FF, then stop undoing LD (_vStackPointer),HL ; Otherwise remove the value from the stack and keep DEC HL ; undoing, as there are no available values for the JR _undoLastMove ; previous row/number _placeValue LD A,(HL) ; Pop the top value off the stack DEC HL ; Check the previous value on the stack BIT 7,(HL) ; If that indicates more values (bit 7 not set) JR Z,_doneStack ; then just update the stack pointer INC HL ; Otherwise push $FF onto the stack to indicate LD (HL),$FF ; no more values available _doneStack INC HL ; Update the stack pointer LD (_vStackPointer),HL AND $7F ; Ignore the high bit LD E,A LD A,(_vNumber) INC A LD D,A CALL SelectAndPlace ; Select the cell and place the number there LD A,(_vRow) ; Increment the row number INC A LD HL,vBoardSize CP (HL) ; Check if it is equal to board size JR NZ,_fillLoop ; If not, keep going PUSH HL ; Save address of board size LD HL,_vNumber ; Increment the number INC (HL) POP HL ; Restore address of board size XOR A ; Set row to zero _fillLoop LD (_vRow),A LD A,(_vNumber) ; See if all numbers have been tried CP (HL) JP NZ,_fillNext ; If not, then try the next row ; So now we have a completely filled in, random solution. ; remove pairs of opposite values so long as there is a unique ; solution. LD HL,vGenerateRandomPairs ; Generate random cell numbers LD A,(vBoardSizeSquared) ; Do half of the board, as the other RR A ; half are 180 degree rotated PUSH AF ; Save half the board size CALL RandomFill ; Fill in a random sequence POP AF ; Restore half the board size LD B,A ; That's how many pairs to try LD HL,vGenerateRandomPairs _pairLoop LD A,(HL) ; Get the first cell of the pair PUSH BC ; Save the loop counter PUSH HL ; Save the cell pair array address ; PUSH AF ; Save the current cell offset ; LD A,B ; LD DE,SCREEN_OFFSET_CELLS_LEFT ; CALL DisplayNumber ; Display the number of cells left ; POP AF ; Restore the current cell offset LD HL,_vFirstCell ; Save the first cell offset, CALL _saveValueAndClear ; value, and then clear the cell LD A,(_vFirstCell) ; Work out the other cell offset LD C,A LD A,(vBoardSizeSquared) ; Other cell is DEC A ; board cells - 1 - first cell SUB C LD HL,_vSecondCell ; Save the second cell offset, CALL _saveValueAndClear ; value, and then clear the cell CALL IsUnique ; Check for a unique solution JR Z,_nextPair ; If so, carry on LD HL,_vFirstCell ; Otherwise replace the first value CALL _replaceValue LD HL,_vSecondCell ; And the second value CALL _replaceValue _nextPair POP HL ; Restore the cell pair array address POP BC ; Restore the loop counter INC HL ; Move on to the next value DJNZ _pairLoop ; Process all values LD A,(vBoardSizeSquared) ; Check if there are an odd number of cells BIT 0,A JR Z,_done ; If not, then nothing more to do. RR A ; Try to remove the middle cell value LD HL,_vFirstCell ; Save the offset, value, and CALL _saveValueAndClear ; clear the cell CALL IsUnique ; Check if there is still a unique solution JR Z,_done ; If so, then just return LD HL,_vFirstCell ; Otherwise replace the value and return CALL _replaceValue _done JP SLOW ; RET merged with CALL _replaceValue: LD E,(HL) ; Get the board address INC HL LD D,(HL) ; Get the value to replace JP SelectAndPlace ; Select the board address and place the value _saveValueAndClear: LD (HL),A ; Save the cell offset LD D,vBoardContentsHigh LD E,A ; Get the value in the cell LD A,(DE) AND $0F ; Ignore high nibble INC HL LD (HL),A ; Save the cell value CALL SelectCurrentBoardAddress ; Select the cell LD A,1 JP ClearSelected ; Clear the cell, updating history _vRow DEFB 0 _vNumber DEFB 0 _vStackPointer DEFW 0 _vFirstCell EQU _vRow _vFirstValue EQU _vNumber _vSecondCell EQU _vStackPointer _vSecondValue EQU _vStackPointer+1 ;------------------------------------------------------------ ; RandomFill ; ; Fill the given array with the required number of different ; values. ; ; Registers on input: Registers on output: ; A The number of values A trashed ; B B trashed ; C C trashed ; D D trashed ; E E trashed ; H } The address H trashed ; L } L trashed ;------------------------------------------------------------ RandomFill: .MODULE RF LD (_vArray),HL ; Save the array address LD B,A ; Fill the array with the values in order LD C,A ; Remember the number of values XOR A ; Start with zero _fill LD (HL),A ; Store the current value INC HL ; Move on to the next value and array entry INC A DJNZ _fill ; Keep going until the array is full LD B,C ; Now shuffle the array RL B ; Do it array size * 2 times _swap CALL GetRandom ; Get the first random value LD D,0 LD E,A LD HL,(_vArray) ADD HL,DE ; Work out the array address PUSH HL ; Save the first array address CALL GetRandom ; Get the second random value LD E,A LD HL,(_vArray) ADD HL,DE ; Work out the array address POP DE ; Restore the first array address PUSH BC ; Save the loop counter and array size LD B,(HL) ; Swap the two array values LD A,(DE) LD (HL),A LD A,B LD (DE),A POP BC ; Restore the loop counter and array size DJNZ _swap ; Keep going until all done RET _vArray DEFW 0 ;------------------------------------------------------------ ; GetRandom ; ; Get a random value in the given range, 0 .. max - 1. ; ; Registers on input: Registers on output: ; A A The random value ; B B unchanged ; C The range C The range (unchanged) ; D D unchanged ; E E unchanged ; H H trashed ; L L trashed ;------------------------------------------------------------ GetRandom: .MODULE GR LD HL,(vRandomSeed) ; Get the current seed value LD A,H ; Ensure the seed represents an address 0-8K AND $0f LD H,A LD A,(HL) ; Get the memory value INC HL LD (vRandomSeed),HL _subtract CP C ; Check if the value is in range RET C ; Return it if it is SUB C ; Subtract the range value JR _subtract ; And keep going ;============================================================ ; ; The next section of code deals with updating the current ; option computations based on the placement or removal ; of a number in the currently selected row/column. ; These are used to check validity of moves, and also used ; by the move finding routines further down. ; ;============================================================ ;------------------------------------------------------------ ; UpdateOptions ; ; Update options based on the number placed in the current cell. ; Note: we don't actually remove the options from the cell when a number is ; placed, as we need to be able to restore their effect when the cell is cleared. ; The options effects are temporarily masked while the cell is occupied. ; ; Registers on input: Registers on output: ; A A trashed ; B number B trashed ; C mod C trashed ; D D trashed ; E E trashed ; H H trashed ; L L trashed ;------------------------------------------------------------ UpdateOptions: .MODULE UO LD (vUpdateOptionsGroupMod),BC ; Set parameters for the following calls CALL UpdateOptionsRow ; Update options in the current row CALL UpdateOptionsColumn ; Update options in the current column CALL UpdateOptionsBlock ; Update options in the current block LD BC,(vUpdateOptionsGroupMod) ; Get the parameters for the call LD A,$FF ; Work out the count modifier = -mod, as that will be used repeatedly CP C JR NZ,_doneNegMod LD A,1 _doneNegMod LD C,A ; C = -mod LD A,(vCurrentBoardAddress) ; Update the effect of all options from the cell LD E,A CALL GetOptionAddressBase ; Get the address for the first option for the cell LD A,(vBoardSize) LD B,A ; Number of options to check LD D,1 ; Go through each option in turn, starting at 1 _optionLoop LD A,(HL) ; Get the value for this option AND PENCILLED_MASK ; Check if option value (ignoring pencilled bit) = 0 JR NZ,_nextOption ; If the option is not available, move on to the next option PUSH BC ; Save number of options left to process, count modifier PUSH HL ; Save address of the current option PUSH DE ; Save option number, current board address LD B,D ; Get the option number INC A ; Indicate that the current cell is the updated one CALL UpdateOptionCounts ; Update option counts due to masking of this option POP DE ; Restore option number, current board address POP HL ; Restore address of the current option POP BC ; Restore number of options left to process, count modifier _nextOption INC D ; Increment the option number INC HL ; Move on to the address of the next option value DJNZ _optionLoop ; Process all options RET ;------------------------------------------------------------ ; UpdateOptionsRow ; ; Update options for the currently selected row. ; ; Registers on input: Registers on output: ; A A trashed ; B B trashed ; C C trashed ; D D trashed ; E E trashed ; H H trashed ; L L trashed ;------------------------------------------------------------ UpdateOptionsRow: LD A,(vCurrentRow) ; Get the address of the current row start offset LD HL,(vBARowStarts) ADD A,L LD L,A ; vBARowStarts never crosses a 256-byte boundary LD C,(HL) ; Get the start offset of the current row LD HL,(vBARowCellOffsets) ; Get the address of the row offsets JR UpdateOptionsGroup ; Update the options for the row ; RET merged with CALL ;------------------------------------------------------------ ; UpdateOptionsColumn ; ; Update options for the currently selected column. ; ; Registers on input: Registers on output: ; A A trashed ; B number B trashed ; C mod C trashed ; D D trashed ; E E trashed ; H H trashed ; L L trashed ;------------------------------------------------------------ UpdateOptionsColumn: LD A,(vCurrentColumn) ; Get the address of the current column start offset LD HL,(vBAColumnStarts) ADD A,L LD L,A ; vBAColumnStarts never crosses a 256-byte boundary LD C,(HL) ; Get the start offset of the current column LD HL,(vBAColumnCellOffsets) ; Get the address of the column offsets JR UpdateOptionsGroup ; RET merged with CALL ;------------------------------------------------------------ ; UpdateOptionsBlock ; ; Update options for the currently selected block. ; ; Registers on input: Registers on output: ; A A trashed ; B number B trashed ; C mod C trashed ; D D trashed ; E E trashed ; H H trashed ; L L trashed ;------------------------------------------------------------ UpdateOptionsBlock: ; LD BC,(vCurrentRowColumn) LD A,(vCurrentBoardAddress) CALL GetBlockNumber ; Get the current block number LD HL,(vBABlockStarts) ; Get the address of the current block start offset ADD A,L LD L,A ; vBABlockStarts never crosses a 256-byte boundary LD C,(HL) ; Get the start offset of the current block LD HL,(vBABlockCellOffsets) ; Get the address of the block offsets ; Intentionally drop through to UpdateOptionsGroup #IF $ != UpdateOptionsGroup !!!UpdateOptionsBlock/UpdateOptionsGroup #ENDIF ;------------------------------------------------------------ ; UpdateOptionsGroup ; ; Update options for the identified group ; When called, vUpdateOptionsGroupMod,Number must hold mod, number ; ; Registers on input: Registers on output: ; A A trashed ; B B trashed ; C start C trashed ; D D trashed ; E E trashed ; H } offsets H trashed ; L } L trashed ; ;------------------------------------------------------------ UpdateOptionsGroup: .MODULE UOG LD A,(vCurrentBoardAddress) ; Always skip the current cell LD D,A ; Save skip for later use LD A,(vBoardSize) ; Process board size number of elements LD B,A _cellLoop LD A,C ; Work out the offset of the group entry ADD A,(HL) CP D ; Check whether the entry is to be skipped JR Z,_nextCell ; If so, move on to the next cell PUSH HL ; Store the address of the current group entry offset PUSH BC ; Store the loop counter, group start offset PUSH DE ; Store the loop index, skip LD E,A ; E holds the board address of the current group entry LD BC,(vUpdateOptionsGroupMod) ; Get the number being placed and option modifier value CALL UpdateOption ; Update the option POP DE ; Restore loop index, skip POP BC ; Restore loop counter, group start offset POP HL ; Restore the address of the current group entry offset _nextCell INC HL ; Move on to the next group entry offset DJNZ _cellLoop ; Process all entries in the group RET ; Parameters set by calling routines: vUpdateOptionsGroupMod: DEFB 0 vUpdateOptionsGroupNumber: DEFB 0 ; Multiples of the board size. ; This must be on a 256-byte boundary Align256(sMultBoardSize6x6) sMultBoardSize6x6: DEFB 0,6,12,18,24,30 ; Can't reuse mult sq as that's words Check256(sMultBoardSize6x6) ;------------------------------------------------------------ ; UpdateOption ; ; Update the option value and counts. ; ; Registers on input: Registers on output: ; A A trashed ; B number B trashed ; C mod C trashed ; D D trashed ; E boardAddress E trashed ; H H trashed ; L L trashed ;------------------------------------------------------------ UpdateOption: LD A,B CALL GetOptionAddress ; Get the option address for the option LD A,(HL) ; Get the current option value PUSH DE ; Store board address LD E,A ; Save the old value of the option ADD A,C ; Add in the modifier LD D,A ; Save the new value of the option LD (HL),D ; Update the option value LD C,0 ; Work out whether the option count has changed LD A,E AND PENCILLED_MASK ; Check if old value of option (ignoring pencilled flag) = 0 JR NZ,_notIncreasingFrom0 ; If non-zero then the option value is not increasing from zero LD A,D ; Old value was zero, so check whether increasing from zero AND PENCILLED_MASK ; Check if new value of option (ignoring pencilled flag) = 0 JR Z,_decreasingTo0 ; If zero, then the option value is decreasing to zero DEC C ; The option is increasing from zero to non-zero, so count needs to be decremented POP DE ; Restore board address JR UpdateOptionCounts_updated ; Update option counts by -1 _notIncreasingFrom0 LD A,D ; We already know here that the old value is non-zero AND PENCILLED_MASK ; Check if new value is zero _decreasingTo0 POP DE ; Restore board address RET NZ ; If new value is non-zero, then count is not changing, so return INC C ; count needs to be incremented JR UpdateOptionCounts_updated ; Update the option counts by 1 ; RET merged with CALL ;------------------------------------------------------------ ; UpdateOptionCounts ; ; Update options counts for row, column and corresponding block. ; ; Registers on input: Registers on output: ; A updatedCell A trashed ; B number B trashed ; C mod C trashed ; D D trashed ; E boardAddress E trashed ; H H trashed ; L L trashed ;------------------------------------------------------------ UpdateOptionCounts: .MODULE UOC OR A ; Check if updated cell JR NZ,_continue ; Continue if the cell has been updated UpdateOptionCounts_updated: LD D,vBoardContentsHigh ; Optimised as vBoardContents on a 256-byte boundary LD A,(DE) ; Get the cell content OR A ; Check if the cell content = 0 RET NZ ; If the cell is occupied, and not the updated cell, return _continue LD (_mod),BC ; Save count modifier and option number CALL GetRowColumnNumber ; Work out the row and column number of the cell LD (_row),BC ; Save the row and column number LD E,C ; E = row LD BC,(_mod) ; Restore the count modifier and option number LD A,B LD HL,vRowOptionCounts ; Update the row option counts CALL UpdateOptionCounts2 ; On return, DE = row option count offset LD HL,vRowOnlyOptionColumns ; Update the row only option columns value LD A,(_column) ; For the cell's column LD B,A CALL UpdateOnlyOption ; Update the only option value LD E,B ; E = column LD BC,(_mod) ; Restore the count modifier and option number LD HL,vColumnOptionCounts ; Update the column option counts CALL UpdateOptionCounts2 ; On return, DE = column option count offset LD HL,vColumnOnlyOptionRows ; Update the column only option rows value LD A,(_row) ; For the cell's row LD B,A CALL UpdateOnlyOption ; Update the only option value LD BC,(_mod) ; Restore the count modifier and option number LD DE,(_row) ; Restore the row and column for the cell LD A,D INC A ; A = column+1 LD B,A LD HL,vCellOptionCounts ; Update the cell option counts CALL UpdateOptionCounts2 OR A ; Check whether the number of options = 0 JR NZ,_updateBlock ; If non-zero, update block option counts LD D,vBoardContentsHigh LD A,(DE) ; Get the cell content OR A ; Check if the cell content = 0 JR NZ,_updateBlock ; If the cell is occupied, that's OK INC A ; However, if the cell is unoccupied with no options, LD (vImpossible),A ; set the impossible flag to indicate can't be solved. _updateBlock LD BC,(_row) ; Restore row and column for the cell CALL GetBlockAndCellNumber ; Get the block and cell number within the block PUSH DE ; Save cell number, block number LD BC,(_mod) ; Restore the count modifier and option number LD HL,vBlockOptionCounts ; Update the block option counts CALL UpdateOptionCounts2 ; On return, DE = block option count address POP HL ; Restore cell number, block number LD B,H LD HL,vBlockOnlyOptionCells ; Update the block only option cells value JR UpdateOnlyOption ; RET merged with CALL ; Local storage for parameters: _mod DEFB 0 _number DEFB 0 _row DEFB 0 _column DEFB 0 ;------------------------------------------------------------ ; UpdateOptionCounts2 ; ; Update the option counts for the offset and option ; ; On return DE contains the option offset. ; ; Registers on input: Registers on output: ; A A newValue ; B option B option (unchanged) ; C mod C mod (unchanged) ; D D } ; E offset E } count offset ; H } counts H trashed ; L } L trashed ;------------------------------------------------------------ UpdateOptionCounts2: LD A,(vMultBoardSize+1) ; vMultBoardSize is on a 256-byte boundary LD D,A ; Multiply the offset by board size LD A,(DE) ; Get the multiplied value ADD A,B DEC A ; A = offset * board size + option - 1 LD D,0 LD E,A ; DE = option count offset (returned) ADD HL,DE ; Locate the specific option count LD A,(HL) ; Get the count value ADD A,C ; Add in the modifier LD (HL),A ; Update the count value RET ;------------------------------------------------------------ ; UpdateOnlyOption ; ; Update the onlyOption value for the given value and modifier. ; ; Registers on input: Registers on output: ; A A newValue ; B value B value (unchanged) ; C mod C mod (unchanged) ; D } count offset D } count offset (unchanged) ; E } E } ; H } onlyOptions H trashed ; L } L trashed ;------------------------------------------------------------ UpdateOnlyOption: .MODULE UOO ADD HL,DE ; Work out the address of the only option value LD A,(HL) ; Get the current only option value BIT 7,C ; Check modifier bit 7 - Z indicates positive JR Z,_addValue ; If positive, add the value SUB B ; Subtract the given value LD (HL),A ; Update the only option value RET _addValue ADD A,B ; Add the given value LD (HL),A ; Update the only option value RET ;============================================================ ; ; The next section of code deals with finding the next possible ; move from the current position. This is done based on the ; option values computed as values are placed in the routines ; above. ; ;============================================================ ;------------------------------------------------------------ ; FindNextMove ; ; Find the next possible move. Use logic if possible. ; ; If there is no move, Z flag is set on return. ; ; Note: this should never return an action value of ; FIND_MOVE_ACTUAL. That is returned by the sub methods ; and either taken or translated into FIND_MOVE_PENCIL. ; ; Registers on input: Registers on output: ; A A indicates whether option (1) or value (2) or no move (0 and Z set) ; B B column (if move available) ; C C row (if move available) ; D D number (if move available) ; E E board address (if move available) ; H H trashed ; L L trashed ;------------------------------------------------------------ FIND_MOVE_PENCIL EQU 1 ; The move is to remove a pencilled option FIND_MOVE_PLACE EQU 2 ; The move is to place a number FIND_MOVE_ACTUAL EQU 3 ; The move is to remove an actual option FindNextMove: .MODULE FNM CALL FindNumberToPlace ; Find numbers that can be placed immediately RET NZ ; Return immediately if placing a number CALL FindPencilledToRemove ; Now check for any pencilled options that are not actually available RET NZ ; Return immediately if removing a pencilled option CALL FindBlockSingleRow ; All pencilled options are available CALL Z,FindBlockSingleColumn ; so try to find an option that can be removed CALL Z,FindRowSingleBlock CALL Z,FindColumnSingleBlock CALL Z,FindClosedSetRow ; Try to find options that can be eliminated due to CALL Z,FindClosedSetColumn ; the presence of closed groups (twins, triplets, etc) CALL Z,FindClosedSetBlock CALL Z,FindXWingColumn ; Try to find X-wings CALL Z,FindXWingRow JR NZ,_foundOption ; Found an option to remove CALL FindBruteForce ; All else failed, use brute force RET NZ ; Found a move by brute force _noMove LD HL,sNoMoveAvailableMessage ; Set up the "no move available" message CALL CopyMoveExplanation XOR A ; Ensure Z flag set and A = 0 RET _foundOption LD A,(vSolvingAll) ; If solving all, don't worry about OR A ; reconciling pencilled options JR NZ,_notPencilled LD A,D ; A is option to place CALL GetOptionAddress ; Get the option address LD A,(HL) ; Get the option value AND PENCILLED_FLAG ; Check whether pencilled JR NZ,_notPencilled ; If not, then remove the option and find another move LD A,FIND_MOVE_PENCIL ; Indicate remove pencilled option OR A ; NZ indicates move found RET ; This table maps from board address to the block number of which that cell is a member. ; This must be on a 256-byte boundary. Align256(sBlockNumbers6x6) sBlockNumbers6x6: DEFB 0,0,0,1,1,1 ; 0 - 5 DEFB 0,0,0,1,1,1 ; 6 - 11 DEFB 2,2,2,3,3,3 ; 12 - 17 DEFB 2,2,2,3,3,3 ; 18 - 23 DEFB 4,4,4,5,5,5 ; 24 - 29 DEFB 4,4,4,5,5,5 ; 30 - 35 Check256(sBlockNumbers6x6) _notPencilled CALL RemoveOption2 ; Silently remove the option JR FindNextMove ; Try to find another move ;------------------------------------------------------------ ; CopyMoveExplanation ; ; Copy the identified move explanation into the buffer. ; ; Registers on input: Registers on output: ; A A unchanged ; B B 0 ; C C 0 ; D D trashed ; E E trashed ; H H trashed ; L L trashed ;------------------------------------------------------------ CopyMoveExplanation: LD DE,vMoveExplanation LD B,32 JP Decompress ;------------------------------------------------------------ ; PrintCoordsInMessage, PrintCoordsInMessage2 ; ; Prints the coordinates in the message, assuming they go at ; the fourth and sixth characters. ; ; The second entry point is used when the row/column are already ; known. ; ; Registers on input: Registers on output: ; A A trashed ; B B column ; C C row ; D D unchanged ; E board address E unchanged ; H H unchanged ; L L unchanged ;------------------------------------------------------------ PrintCoordsInMessage: Call GetRowColumnNumber ; Get the row and column for the board address PrintCoordsInMessage2: LD A,B ADD A,$1D ; Adjust 0 .. 8 to '1' .. '9' LD (vMoveExplanation+3),A LD A,C ADD A,$1D ; Adjust 0 .. 8 to '1' .. '9' LD (vMoveExplanation+5),A RET ;------------------------------------------------------------ ; FindNumberToPlace ; ; Find the next possible move, limited to placeable numbers. ; ; If there is no move, Z flag is set on return. ; ; Registers on input: Registers on output: ; A A indicates whether option (1) or value (2) or no move (0 and Z set) ; B B column (if move available) ; C C row (if move available) ; D D number (if move available) ; E E board address (if move available) ; H H trashed ; L L trashed ;------------------------------------------------------------ FindNumberToPlace: CALL FindSingleOption ; Try to find a single option in a cell. CALL Z,FindOnlyOptionRow ; Try to find the only available option in a row, CALL Z,FindOnlyOptionColumn ; column JP Z,FindOnlyOptionBlock ; or block RET ;------------------------------------------------------------ ; FindBruteForce ; ; Find the next possible move using brute force. ; Note: if there is no move, Z flag is set on return. ; ; Registers on input: Registers on output: ; A A indicates whether option (1) or value (2) or no move (0 and Z set) ; B B column (if move available) ; C C row (if move available) ; D D number (if move available) ; E E board address (if move available) ; H H trashed ; L L trashed ;------------------------------------------------------------ FindBruteForce: .MODULE FBF LD A,(vMovesLeft) ; Remember the number of moves left when called LD (_vFbfStartingMovesLeft),A LD A,(vBoardSizeSquared) LD B,A ; Maximum is the number of cells on the board LD A,1 LD (vNoExplanation),A ; Indicate that no move explanations are required LD HL,vBoardContents ; Look at the address of the first cell on the board LD DE,vBruteForceEmptyCells ; And the address of the first empty cell offset LD C,0 ; Initialize cell index to 0 _getEmptyCells LD A,(HL) ; Get the cell content OR A ; Check if the cell content = 0 JR NZ,_nextEmptyCell ; If non-zero, then move on to the next cell LD A,C ; Store the cell index in the list of empty cells LD (DE),A INC DE ; Move on to the address of the next empty cell offset _nextEmptyCell INC C ; Increment the cell index INC HL ; Move on to the address of the next cell on the board DJNZ _getEmptyCells ; Process all cells on the board LD BC,1 ; C = index in the empty cell list; B = last number tried LD HL,vBruteForceEmptyCells ; Get the address of the first empty cell offset _tryMoveLoop LD A,(vMovesLeft) OR A ; Check if moves left = 0 JP Z,_success ; If so, then we've found a move that results in a valid solution PUSH HL ; Save the address of the current empty cell offset _tryPlacing PUSH BC ; Save the last number tried and the index in the empty cell list CALL FindNumberToPlace ; Start by trying to place a number by logic JR Z,_triedPlacing ; No more numbers can be immediately placed by logic CALL SelectRCAAndPlace ; Select the identified row/column/address and place the number POP BC ; Restore the address of the current empty cell offset LD B,0 ; Start trying from first number having successfully made a move LD A,(vMovesLeft) ; Check if no moves left now OR A ; JR NZ,_tryImp ; Keep going if moves left, by checking for an impossible board POP HL ; Restore the address of the current empty cell offset INC C ; Move on to the next index in the empty cell list INC HL ; Move on to the address of the next empty cell offset ; Note that the above must be done when looking for more than one solution JP _success ; Handle a successful solution _tryImp LD A,(vImpossible) ; Check for impossible to solve OR A ; Check if impossible = 0 JR Z,_tryPlacing ; Keep going if OK. XOR A ; Placing this series of logical moves has resulted in an unsolvable LD (vImpossible),A ; position, so need to undo back to the forced move and try another POP HL ; Restore the address of the current empty cell offset JR _stepBackOver ; Step back to the previous brute force move _triedPlacing POP BC ; Restore last number tried and the index in the empty cell list POP HL ; Restore the address of the current empty cell offset _skipFilled LD E,(HL) ; Get the cell offset of the empty cell LD D,vBoardContentsHigh ; Work out the address of the cell LD A,(DE) ; Get the cell content OR A ; Check if cell content = 0 (may have been filled in the meantime) JR Z,_tryNext ; If the cell is empty, then try to make a move INC HL ; Otherwise, move on to the next empty cell INC C ; Increment the current index in the empty cell list JR _skipFilled ; Look for the next empty cell _tryNext PUSH HL ; Save the address of the current empty cell offset INC B ; Try the next number in the cell LD A,B CALL GetOptionAddress ; Get the option address of the cell LD A,(vBoardSize) INC A ; A = vBoardSize + 1 LD D,A ; Save in D temporarily _tryValuesLoop CP B ; Check if the number is now out of range JR Z,_stepBack ; Ran out of values to try LD A,(HL) ; Get the option value AND PENCILLED_MASK ; Check if option value (ignoring pencilled bit) = 0 JR Z,_doneSearch ; Found a valid option, so try placing this number LD A,D ; A = vBoardSize + 1 INC B ; Increment the number to be placed INC HL ; Move on to the address of the next option value JR _tryValuesLoop ; Try the next number _doneSearch POP HL ; Restore the address of the current empty cell offset SET 7,(HL) ; Mark the address as a brute force attempt PUSH HL ; Save the address of the current empty cell offset PUSH BC ; Save the last number tried and the index in the empty cell list LD D,B ; Number to be placed CALL SelectAndPlace ; Select the cell and place the number JR NZ,_impossible ; Failed to place the number, puzzle is impossible to solve LD A,(vImpossible) ; Check for impossible to solve (option count in an empty cell now zero) OR A ; Check if impossible = 0 JR Z,_tryNextNumber ; If not impossible, try logic to place more numbers _impossible CALL Undo ; Undo the move just attempted POP BC ; Restore last number tried and the index in the empty cell list POP HL ; Restore the address of the current empty cell offset RES 7,(HL) ; Reset the brute force attempt flag XOR A ; Reset the impossible move flag LD (vImpossible),A JR _tryMoveLoop ; Try the next number _tryNextNumber POP BC ; Restore last number tried and the index in the empty cell list POP HL ; Restore the address of the current empty cell offset INC C ; Move on to the next empty cell list entry INC HL ; Move on to the address of the next empty cell offset LD B,0 ; Last number tried is 0 JR _tryMoveLoop ; Try the next move _stepBack POP HL ; Restore the address of the current empty cell offset _stepBackOver DEC C ; Move back to the previous empty cell list entry JR NZ,_stepBackOK ; If zero, then no move can be found CALL _undoAllMoves ; Undo all moves made during brute force search XOR A ; Ensure Z flag set to indicate no move LD (vNoExplanation),A ; Clear the "no explanation needed" flag RET _stepBackOK DEC HL ; Move back to the address of the previous empty cell offset BIT 7,(HL) ; Check whether that cell was used for a brute force attempt JR Z,_stepBackOver ; If not, then keep stepping back _stepBackMove RES 7,(HL) ; Reset the brute force attempt flag LD E,(HL) ; Get the board address of the empty cell LD D,vBoardContentsHigh ; vBoardContents is on a 256-byte boundary LD A,(DE) ; Get the cell content AND $0F ; Mask out the fixed value marker LD B,A ; Last number tried is the value from the cell PUSH HL ; Save the address of the current empty cell offset PUSH BC ; Save the last number tried and the index in the empty cell list _undoPlaceLoop PUSH DE ; Save the cell address CALL Undo ; Undo the last move POP DE ; Restore the cell address LD A,(DE) ; Get the cell content OR A ; Check if cell content = 0 JR NZ,_undoPlaceLoop ; Keep undoing moves until the cell is empty POP BC ; Restore the last number tried and the index in the empty cell list POP HL ; Restore the address of the current empty cell offset JP _tryMoveLoop ; Try another move _success LD A,(vSolvingAll) OR A ; Check if solving all = 0 JR NZ,_return ; If solving all, skip the undos - leave the board solved LD A,(vCheckUnique) OR A ; Check if check for unique solution = 0 JR Z,_finish ; If checking uniqueness, don't stop now INC A LD (vCheckUnique),A ; Increment the count of solutions found CP 3 JR NZ,_stepBackOver ; If less than 2 solutions found, try another _finish LD A,(vBruteForceEmptyCells) ; Get the board address of the first move tried AND $7F ; Ignore the brute force marker LD E,A LD D,vBoardContentsHigh ; vBoardContents is on a 256-byte boundary LD A,(DE) ; Get the value placed in the first empty cell AND $0F ; Ignore the fixed value marker (although should always be zero) LD D,A ; D = value to be placed PUSH DE ; Save value to be placed and board address CALL _undoAllMoves ; Undo all moves made during brute force search LD HL,sBruteForceMoveMessage ; Copy the base brute force message CALL CopyMoveExplanation POP DE ; Restore value to be placed and board address CALL PrintCoordsInMessage ; Fill in the coordinates LD A,D ADD A,$1C ; Fill in the number to be placed in the message LD (vMoveExplanation+26),A _return XOR A LD (vNoExplanation),A ; Clear the "no explanation needed" flag LD HL,vDifficulty SET 4,(HL) ; Set difficulty bit 5 LD A,FIND_MOVE_PLACE ; Indicate number to place OR A ; NZ indicates move found RET _undoAllMoves LD A,(vMovesLeft) ; Get the current moves left LD HL,_vFbfStartingMovesLeft ; Check if its the same as the original moves left CP (HL) RET Z ; If so, then we are done CALL Undo ; Otherwise undo the last move JR _undoAllMoves ; And keep going ; Local variables _vFbfStartingMovesLeft DEFB 0 ;------------------------------------------------------------ ; FindPencilledToRemove ; ; Find an option that has been pencilled in, but that is ; actually known to not be available. ; ; Registers on input: Registers on output: ; A A indicates whether option (1) or value (2) or no move (0 and Z set) ; B B column (if move available) ; C C row (if move available) ; D D number (if move available) ; E E board address (if move available) ; H H trashed ; L L trashed ;------------------------------------------------------------ FindPencilledToRemove: .MODULE FPTR LD A,(vSolvingAll) ; If solving all, don't worry about CP 1 ; reconciling pencilled options RET Z ; Z indicates failure LD HL,vOptions ; Get the address of the first option for the first cell LD C,0 ; Go through each row LD A,(vBoardSize) LD E,A ; Get hold of board size _rowLoop LD B,0 ; Go through each column _columnLoop LD D,0 ; Go through each option _optionLoop LD A,(HL) ; Get the option value AND PENCILLED_FLAG ; Is the option pencilled in (indicated by Z flag) JR NZ,_nextOption ; No, so go on to the next option LD A,(HL) ; Get the option value AND PENCILLED_MASK ; Is the option actually available (indicated by Z flag) JR NZ,_removePencil ; No, so the pencil mark is incorrect _nextOption LD A,E ; Check if row/column/option values finished INC D ; Move on to the next option number INC HL ; Move on to the address of the next option value CP D ; Check whether all options have been examined JR NZ,_optionLoop ; If not, check the next option INC B ; Move on to the next column CP B ; Check whether all columns have been examined JR NZ,_columnLoop ; If not, check the next column INC C ; Move on to the next row CP C ; Check whether all rows have been examined JR NZ,_rowLoop ; If not, check the next row XOR A ; Indicate no move found RET _removePencil INC D ; D holds option number 1..9 LD A,(vNoExplanation) ; Check if move explanation required OR A JR NZ,_return ; If not, just return the values (already done B, C, D) PUSH BC ; Save the row and column PUSH DE ; Save the option number LD HL,sFindWrongPencilMessage CALL CopyMoveExplanation ; Copy in the intersection message POP DE ; Restore the option number POP BC ; Restore the row and column CALL PrintCoordsInMessage2 ; Fill in the coordinates LD A,D ADD A,$1C ; Fill in the option to be removed LD (vMoveExplanation+15),A _return LD HL,(vMultBoardSize) ; Work out the board address of the row/column LD L,C ; vMultBoardSize is on a 256-byte boundary LD A,(HL) ADD A,B ; A = row * vBoardSize + col LD E,A LD A,FIND_MOVE_PENCIL ; Indicate remove pencilled option OR A ; Indicate move found RET ;------------------------------------------------------------ ; FindSingleOption ; ; Find the first cell that has a single possible option. ; Note: if there is no move, Z flag is set on return. ; ; Registers on input: Registers on output: ; A A indicates whether option (1) or value (2) or no move (0 and Z set) ; B B column (if move available) ; C C row (if move available) ; D D number (if move available) ; E E board address (if move available) ; H H trashed ; L L trashed ;------------------------------------------------------------ FindSingleOption: .MODULE FSO LD BC,(vBoardSizeSquared) ; Iterate over all cells on the board LD HL,vCellOptionCounts ; Get the address of the first cell option count LD A,1 ; Search for an option count of 1 CPIR ; Perform the search JR Z,_foundSingle ; Z indicates that the search succeeded, HL = address+1 XOR A ; No cell with one option found RET ; Indicate failure with Z set _foundSingle LD E,L ; Work out the cell offset; vCellOptionCounts is on a 256-byte boundary DEC E ; HL gets an extra INC in the CPIR, so subtract one more here CALL GetOptionAddressBase ; Get the address of first option (0-based) LD A,(vBoardSize) LD B,A LD D,0 ; Start looking at option 0 _optionLoop LD A,(HL) ; Look at the option value AND PENCILLED_MASK ; Check if option value (ignoring pencilled flag) = 0 JR Z,_foundMove ; If so, the option is available so we've found the move INC HL ; Move on to the next option value INC D ; Move on to the next option DJNZ _optionLoop ; Process all options XOR A ; No option found. Note: should never get here RET ; Indicate failure with Z set _foundMove INC D ; Make the number 1-based CALL GetRowColumnNumber ; Get the row and column number of the move LD A,(vNoExplanation) ; Check if move explanation required OR A JR NZ,_return ; If not, just return the values PUSH BC ; Save the row/column PUSH DE ; Save the number to place, board address LD HL,sSingleOptionMessage ; Copy the single option message CALL CopyMoveExplanation POP DE ; Restore the number to place POP BC ; Restore the row/column LD A,D ; D = number (already) ADD A,$1C ; Fill in the number to be placed LD (vMoveExplanation+29),A CALL PrintCoordsInMessage2 ; Fill in the coordinates _return LD A,FIND_MOVE_PLACE ; Indicate that the move is to place a number OR A ; Ensure Z not set RET ; This table maps from board address to the cell number within a block. ; This must be on a 256-byte boundary. Align256(sCellNumbers6x6) sCellNumbers6x6: DEFB 0,1,2,0,1,2 ; 0 - 5 DEFB 3,4,5,3,4,5 ; 6 - 11 DEFB 0,1,2,0,1,2 ; 12 - 17 DEFB 3,4,5,3,4,5 ; 18 - 23 DEFB 0,1,2,0,1,2 ; 24 - 29 DEFB 3,4,5,3,4,5 ; 30 - 35 Check256(sCellNumbers6x6) ;------------------------------------------------------------ ; FindOnlyOptionRow ; ; Look for an option count of 1 for each option in each row. ; Note: if there is no move, Z flag is set on return. ; ; Registers on input: Registers on output: ; A A indicates whether option (1) or value (2) or no move (0 and Z set) ; B B column (if move available) ; C C row (if move available) ; D D number (if move available) ; E E board address (if move available) ; H H trashed ; L L trashed ;------------------------------------------------------------ FindOnlyOptionRow: LD HL,(vBARowStarts) PUSH HL ; Save starts LD HL,(vBARowCellOffsets) PUSH HL ; Save offsets LD HL,vRowOnlyOptionColumns PUSH HL ; Save only options LD BC,sOnlyOptionRowMessage LD HL,vRowOptionCounts JR FindOnlyOption ; RET merged with CALL ;------------------------------------------------------------ ; FindOnlyOptionColumn ; ; Look for an option count of 1 for each option in each column. ; Note: if there is no move, Z flag is set on return. ; ; Registers on input: Registers on output: ; A A indicates whether option (1) or value (2) or no move (0 and Z set) ; B B column (if move available) ; C C row (if move available) ; D D number (if move available) ; E E board address (if move available) ; H H trashed ; L L trashed ;------------------------------------------------------------ FindOnlyOptionColumn: LD HL,(vBAColumnStarts) PUSH HL ; Save starts LD HL,(vBAColumnCellOffsets) PUSH HL ; Save offsets LD HL,vColumnOnlyOptionRows PUSH HL ; Save only options LD BC,sOnlyOptionColumnMessage LD HL,vColumnOptionCounts JR FindOnlyOption ; RET merged with CALL ;------------------------------------------------------------ ; FindOnlyOptionBlock ; ; Look for an option count of 1 for each option in each block. ; Note: if there is no move, Z flag is set on return. ; ; Registers on input: Registers on output: ; A A indicates whether option (1) or value (2) or no move (0 and Z set) ; B B column (if move available) ; C C row (if move available) ; D D number (if move available) ; E E board address (if move available) ; H H trashed ; L L trashed ;------------------------------------------------------------ FindOnlyOptionBlock: LD HL,(vBABlockStarts) PUSH HL ; Save starts LD HL,(vBABlockCellOffsets) PUSH HL ; Save offsets LD HL,vBlockOnlyOptionCells PUSH HL ; Save only options LD BC,sOnlyOptionBlockMessage LD HL,vBlockOptionCounts ; Intentionally drop through to FindOnlyOption ;------------------------------------------------------------ ; FindOnlyOption ; ; Look for an option count of 1 for each option in each group. ; Note: if there is no move, Z flag is set on return. ; ; Registers on input: Registers on output: ; A A indicates whether option (1) or value (2) or no move (0 and Z set) ; B B column (if move available) ; C C row (if move available) ; D } message D number (if move available) ; E } E board address (if move available) ; H } counts H trashed ; L } L trashed ;------------------------------------------------------------ FindOnlyOption: .MODULE FOO LD (_vMessage),BC ; Save the message ; Original code used nested loops, maintaining count, option number and group number ; LD A,(vBoardSize) ; LD E,A ; E = vBoardSize ; XOR A ; LD C,A ; Start with first count address ; LD B,A ; Go through all the groups ;_startLoop LD D,0 ; Go through all options ;_optionLoop LD A,(HL) ; Get the count value ; DEC A ; Check for a count of 1, i.e. only one option available ; JR Z,_foundMove ; If not 1, then move on to the next option ; INC HL ; Move on to the next count entry ; INC C ; Increment count number ; INC D ; Increment option ; LD A,E ; Get the board size ; CP D ; Process all options ; JR NZ,_optionLoop ; INC B ; Move on to the next group ; CP B ; Process all groups ; JR NZ,_startLoop ; POP HL ; Discard only options ; POP HL ; Discard offsets ; POP HL ; Discard starts ; XOR A ; Return Z flag to indicate no move found ; RET ; Quicker to use CPIR, and then work back from HL - startHL to work out count number, group number. LD D,H LD E,L LD BC,(vBoardSizeSquared) LD A,1 CPIR JR Z,_foundSingle POP HL POP HL POP HL XOR A RET _foundSingle SBC HL,DE ; Map address of the found option back DEC L ; to count number LD C,L ; C is the count number LD HL,(vDivideBoardSize) ; Divide the count number by the board size LD L,C ; vDivideBoardSize is on a 256-byte boundary LD B,(HL) ; Group number is count number / board size INC H ; vModBoardSize must be 256 greater than vDivideBoardSize LD D,(HL) ; Option number is count number mod board size _foundMove POP HL ; Get the address of the only options table LD A,C ADD A,L ; vFooOnlyOption doesn't cross a 256-byte boundary LD L,A ; Work out the address of the entry for this group LD A,(HL) ; Get the only option cell number POP HL ; Get the address of the offsets ADD A,L ; vFooOffsets doesn't cross a 256-byte boundary LD L,A ; Work out the offset value for the only option cell number LD C,(HL) ; Get the offset value POP HL ; Get the address of the starts LD A,B ; Work out the start offset of the group ADD A,L LD L,A LD A,(HL) ; Get the start offset ADD A,C ; Work out the board address LD E,A INC D ; D = option value (1-based) CALL GetRowColumnNumber ; Get the row and column number of the move LD A,(vNoExplanation) ; Check if move explanation required OR A JR NZ,_return ; If not, just return the values PUSH BC ; Save row/column PUSH DE ; Save option value (1-based) and board address LD HL,sOnlyOptionMessage ; Copy the only option message CALL CopyMoveExplanation LD HL,(_vMessage) ; Get the address of the extra text LD DE,vMoveExplanation+24 LD BC,sOnlyOptionSubMsgLen ; Assume six characters LDIR ; Copy in the additional text POP DE ; Restore option value and board address POP BC ; Restore the row/column LD A,D ; A = option value (1-based) ADD A,$1C ; Map 1..9 to '1'..'9' LD (vMoveExplanation+19),A ; Fill in the option in the message CALL PrintCoordsInMessage2 ; Fill in the coordinates (maps board address to row, column) _return LD HL,vDifficulty SET 0,(HL) ; Set difficulty bit 0 LD A,FIND_MOVE_PLACE ; A = 2 indicates place value OR A ; NZ indicates move found RET _vMessage DEFW 0 ;------------------------------------------------------------ ; FindBlockSingleRow ; ; Find: a) An option only appears within a block in a single row. ; ; Registers on input: Registers on output: ; A A indicates whether option (1) or value (2) or no move (0 and Z set) ; B B column (if move available) ; C C row (if move available) ; D D number (if move available) ; E E board address (if move available) ; H } vFooCounts H trashed ; L } L trashed ;------------------------------------------------------------ FindBlockSingleRow: .MODULE FBSR LD HL,sFindBlockSingleRowParams LD DE,sFindBlockSingleRowMsg LD BC,vBlockOptionCounts JR FindOnlyIntersection ;------------------------------------------------------------ ; FindBlockSingleColumn ; ; Find: b) An option only appears within a block in a single column. ; ; Registers on input: Registers on output: ; A A indicates whether option (1) or value (2) or no move (0 and Z set) ; B B column (if move available) ; C C row (if move available) ; D D number (if move available) ; E E board address (if move available) ; H } vFooCounts H trashed ; L } L trashed ;------------------------------------------------------------ FindBlockSingleColumn: .MODULE FBSC LD HL,sFindBlockSingleColumnParams LD DE,sFindBlockSingleColumnMsg LD BC,vBlockOptionCounts JR FindOnlyIntersection ;------------------------------------------------------------ ; FindRowSingleBlock ; ; Find: c) An option only appears within a row in a single block. ; ; Registers on input: Registers on output: ; A A indicates whether option (1) or value (2) or no move (0 and Z set) ; B B column (if move available) ; C C row (if move available) ; D D number (if move available) ; E E board address (if move available) ; H } vFooCounts H trashed ; L } L trashed ;------------------------------------------------------------ FindRowSingleBlock: .MODULE FRSB LD HL,sFindRowSingleBlockParams LD DE,sFindRowSingleBlockMsg LD BC,vRowOptionCounts JR FindOnlyIntersection ;------------------------------------------------------------ ; FindColumnSingleBlock ; ; Find: d) An option only appears within a column in a single block. ; ; Registers on input: Registers on output: ; A A indicates whether option (1) or value (2) or no move (0 and Z set) ; B B column (if move available) ; C C row (if move available) ; D D number (if move available) ; E E board address (if move available) ; H } vFooCounts H trashed ; L } L trashed ;------------------------------------------------------------ FindColumnSingleBlock: .MODULE FCSB LD HL,sFindColumnSingleBlockParams LD DE,sFindColumnSingleBlockMsg LD BC,vColumnOptionCounts JR FindOnlyIntersection ;------------------------------------------------------------ ; FindOnlyIntersection ; ; Find an option that can be removed when unique to an intersection. ; ; Registers on input: Registers on output: ; A A indicates whether option (1) or value (2) or no move (0 and Z set) ; B } address of counts B column (if move available) ; C } C row (if move available) ; D } address of message D number (if move available) ; E } E board address (if move available) ; H } address of parameters H trashed ; L } L trashed ;------------------------------------------------------------ FindOnlyIntersection: .MODULE FOI LD (_vMessage),DE ; Save message address LD (_vCounts),BC ; Save counts address LD DE,_vParams ; Copy parameter data LD B,_vNumParams ; Note: the parameters are all pointers to actual parameter values _copyParamsLoop LD C,(HL) ; Get the address of the parameter INC HL LD A,(HL) INC HL PUSH HL ; Save the address of the next parameter LD L,C LD H,A ; HL holds address of parameter LDI LDI ; Copy two bytes (HL) to (DE) POP HL ; Restore the address of the next parameter DJNZ _copyParamsLoop ; Copy all parameters LD C,B ; Start count address at 0 LD D,B ; Start group number at 0 _groupLoop LD HL,(_vStarts) ; Get the address of the group starts LD A,D ADD A,L LD L,A ; starts doesn't cross a 256-byte boundary LD E,(HL) ; Get the start offset for the group LD B,0 ; Start options from 0 _optionLoop LD HL,(_vCounts) ; Get the address of the counts table LD A,L ADD A,C LD L,A ; _counts doesn't cross a 256-byte boundary LD A,(HL) ; Get the count value CP 2 ; If the count is less than 2 JR C,_nextOption CP 4 ; Or greater than three JR C,_intersection ; Then move on to the next option _nextOption INC B ; Move on to the next option INC C ; And the next count entry LD A,(vBoardSize) CP B JR NZ,_optionLoop ; Keep going until all options processed INC D ; Move on to the next group CP D ; A already holds vBoardSize JR NZ,_groupLoop ; Keep going until all groups processed XOR A ; Indicate no move found RET _intersection LD (_vCountAddress),BC ; Save the option number and the count entry PUSH DE ; Save the group number and group start offset LD C,99 ; 99 indicates that the option is not in a single intersection LD B,0 ; Go through each intersection group LD D,B ; The start of the intersection group _intersectionLoop LD E,0 ; Go through each intersection group member _memberLoop LD A,D ADD A,E ; Work out the offset of the group member LD HL,(_vIntersect) ADD A,L LD L,A ; intersect doesn't cross a 256-byte boundary LD A,(HL) ; Get the offset of the intersection offset LD HL,(_vOffsets) ADD A,L LD L,A ; offsets doesn't cross a 256-byte boundary LD A,(HL) ; Work out the intersection offset POP HL ; Restore the group number and group start offset PUSH HL ; Save the group number and group start offset ADD A,L ; Work out the board address LD H,vBoardContentsHigh LD L,A ; vBoardContents is on a 256-byte boundary PUSH DE ; Save intersection group start, intersection group member LD E,A ; LD A,(HL) ; Get the cell content OR A ; Check if cell content = 0 JR NZ,_memberFull ; The cell is full _intersectEmpty LD A,(_vOption) ; Get the option number CALL GetOptionAddress0 ; Work out the option address LD A,(HL) ; Get the option value POP DE ; Restore intersection group start, intersection group member AND PENCILLED_MASK ; Check if option value (ignoring pencilled flag) = 0 JR NZ,_nextMember ; Option not available LD A,99 ; Check if an option has already been found CP C JR NZ,_noMove2 ; Break right out to next option LD C,B ; Remember the intersection group in which the option was found LD A,(_vIntersectSize) ; Get the intersection size JR _nextIntersection ; Break out to next intersection _memberFull POP DE ; Restore intersection group start, intersection group member _nextMember INC E ; Move on to the next member LD A,(_vIntersectSize) ; Check if full intersection examined CP E JR NZ,_memberLoop ; Keep going if more members in the intersection _nextIntersection ADD A,D ; Add the intersection size to the intersection group start LD D,A INC B ; Move on to the next intersection group LD A,(vBoardSize) CP D ; Check if the whole group has been processed JR NZ,_intersectionLoop ; Keep going if more intersection groups _findMove LD A,C CP 99 ; Check if any unique intersection found POP DE ; Restore intersection group start, intersection group member JR Z,_noMove ; No move found LD A,(_vNumIntersects) LD B,A ; B = intersectSize XOR A ; A = 0 _findMoveMult ADD A,D DJNZ _findMoveMult ; Multiple the intersection group start by number of intersects ADD A,C ; Add in the intersection number LD HL,(_vReverseMap) ; Map that back to an intersecting group number ADD A,L LD L,A ; reverseMap doesn't cross a 256-byte boundary LD A,(HL) ; Get the intersecting group LD HL,(_vIntersectStarts) ADD A,L LD L,A ; intersectStarts doesn't cross a 256-byte boundary LD C,(HL) ; Get the start of the intersecting group PUSH DE ; Save intersection group start, intersection group member LD A,(vBoardSize) LD B,A ; B = vBoardSize LD HL,(_vIntersectOffsets) ; Get the address of the offset of the first cell in the intersecting group _findMoveCellLoop LD A,(HL) ; Get the offset ADD A,C ; Work out the address of the cell in the intersecting group LD (_vIntersectAddr),A ; Save the intersecting cell address LD D,vBoardContentsHigh ; Work out the board address LD E,A LD A,(DE) ; Get the cell content OR A ; Check if cell content = 0 JR NZ,_findMoveNextCell ; If occupied, move on to the next cell LD A,(_vOption) ; Get the option number PUSH HL ; Save the address of the offset of the cell in the intersecting group CALL GetOptionAddress0 ; Get the option address LD A,(HL) ; Get the option value AND PENCILLED_MASK ; Check if the option value (ignoring pencilled flag) = 0 POP HL ; Restore the address of the offset of the cell in the intersecting group JR NZ,_findMoveNextCell ; Option not available for this cell POP DE ; Restore intersection group start, intersection group member PUSH DE ; Save intersection group start, intersection group member PUSH BC ; Save start offset for intersecting group PUSH HL ; Save the address of the offset of the cell in the intersecting group LD A,(vBoardSize) LD B,A ; B holds vBoardSize LD A,(_vIntersectAddr) ; Restore the intersecting cell address LD D,A LD HL,(_vOffsets) ; Get the address of the first offset _skipIntersectLoop LD A,(HL) ; Get the offset value ADD A,E ; Work out the cell offset CP D ; Check if the cell is in the intersection JR Z,_findMoveNextCell2 ; Cell is in the intersection, move on to next cell INC HL ; Move on to the next offset DJNZ _skipIntersectLoop ; Check next member of the group JR _findMoveOK ; The cell is not in the intersection _findMoveNextCell2 POP HL ; Restore the address of the offset of the cell in the intersecting group POP BC ; Restore the start offset for the intersecting group _findMoveNextCell INC HL ; Move on to the next cell in the intersecting group DJNZ _findMoveCellLoop ; Process all cells in the intersecting group _noMove2 POP DE ; Restore the intersection group start, intersection group member _noMove LD BC,(_vCountAddress) ; Restore the option number and the count entry JP _nextOption ; Move on to the next option _findMoveOK POP HL ; Discard the address of the offset of the cell in the intersecting group POP HL ; Discard the start offset for the intersecting group POP HL ; Discard the intersection group start, intersection group member CALL GetRowColumnNumber ; Get the row and column number of the move LD A,(_vIntersectAddr) ; Get the board address of the cell LD E,A ; E = intersection address LD A,(_vOption) ; Get the option value to remove INC A LD D,A ; D = option value (1-based) LD A,(vNoExplanation) ; Check if move explanation required OR A JR NZ,_return ; If not, just return the values PUSH BC ; Save row/column PUSH DE ; Save option value (1-based) and board address LD HL,sFindIntersectionMessage CALL CopyMoveExplanation ; Copy in the intersection message LD HL,(_vMessage) LD DE,vMoveExplanation+32-sFindIntersectionSubMsgLen LD BC,sFindIntersectionSubMsgLen; Assume six characters LDIR ; Copy in the additional text POP DE ; Restore option value (1-based) and board address POP BC ; Restore row/column CALL PrintCoordsInMessage2 ; Fill in the coordinates LD A,D ADD A,$1C ; Fill in the option to be removed LD (vMoveExplanation+15),A _return LD HL,vDifficulty SET 1,(HL) ; Set difficulty bit 1 LD A,FIND_MOVE_ACTUAL ; Indicate remove actual option OR A ; Indicate move found RET ; Local storage for parameters: _vCountAddress DEFB 0 _vOption DEFB 0 _vIntersectAddr DEFB 0 _vMessage DEFW 0 _vCounts DEFW 0 ; Parameters passed into this module. _vParams _vStarts DEFW 0 _vOffsets DEFW 0 _vIntersect DEFW 0 _vReverseMap DEFW 0 _vIntersectStarts DEFW 0 _vIntersectOffsets DEFW 0 _vIntersectSize DEFB 0 ; These two have to be contiguous as they are _vNumIntersects DEFB 0 ; treated as a single parameter _vNumParams EQU ($ - _vParams)/2 ;------------------------------------------------------------ ; FindClosedSetRow ; ; Try to find a closed set of options in a row. ; ; Registers on input: Registers on output: ; A A indicates whether option (1) or value (2) or no move (0 and Z set) ; B B column (if move available) ; C C row (if move available) ; D D number (if move available) ; E E board address (if move available) ; H H trashed ; L L trashed ;------------------------------------------------------------ FindClosedSetRow: LD HL,(vBARowStarts) LD DE,(vBARowCellOffsets) LD BC,sClosedSetRowMessage JR FindClosedSet ; RET merged with CALL ;------------------------------------------------------------ ; FindClosedSetColumn ; ; Try to find a closed set of options in a column. ; ; Registers on input: Registers on output: ; A A indicates whether option (1) or value (2) or no move (0 and Z set) ; B B column (if move available) ; C C row (if move available) ; D D number (if move available) ; E E board address (if move available) ; H H trashed ; L L trashed ;------------------------------------------------------------ FindClosedSetColumn: LD HL,(vBAColumnStarts) LD DE,(vBAColumnCellOffsets) LD BC,sClosedSetColumnMessage JR FindClosedSet ; RET merged with CALL ;------------------------------------------------------------ ; FindClosedSetBlock ; ; Try to find a closed set of options in a block. ; ; Registers on input: Registers on output: ; A A indicates whether option (1) or value (2) or no move (0 and Z set) ; B B column (if move available) ; C C row (if move available) ; D D number (if move available) ; E E board address (if move available) ; H H trashed ; L L trashed ;------------------------------------------------------------ FindClosedSetBlock: LD HL,(vBABlockStarts) LD DE,(vBABlockCellOffsets) LD BC,sClosedSetBlockMessage ; Intentionally drop through to FindClosedSet ;------------------------------------------------------------ ; FindClosedSet ; ; Try to find a closed set of options in a group of cells. ; ; Registers on input: Registers on output: ; A A indicates whether option (1) or value (2) or no move (0 and Z set) ; B } The move message B column (if move available) ; C } C row (if move available) ; D } The cell group offsets D number (if move available) ; E } E board address (if move available) ; H } The cell group start H trashed ; L } L trashed ;------------------------------------------------------------ FindClosedSet: .MODULE FCS LD (vFcsMessage),BC ; Save the address of the message LD (vFcsStarts),HL ; Save the address of the starts for the group LD (vFcsOffsets),DE ; Save the address of the offsets for the group LD A,(vBoardSize) ; Go through all the groups identified by the start offsets table LD B,A ; Iterate over the vBoardSize groups LD HL,(vFcsStarts) ; Set HL to the location of the first group start offset _groupLoop LD C,(HL) ; Get the current group start offset LD A,C LD (vFcsBAStart),A ; Save the group start offset for later LD E,0 ; Set the number of empty cells found to 0 PUSH HL ; Save current group start address location PUSH BC ; Save group iterator LD A,(vBoardSize) LD B,A ; Iterate over the vBoardSize cells in this group LD HL,(vFcsOffsets) ; Set HL to the location of the first cell offset _cellLoop LD A,(HL) ; Get the current cell offset ADD A,C ; Add to the group start offset PUSH HL ; Save current cell offset location LD H,vBoardContentsHigh ; Get the contents of the cell LD L,A ; vBoardContents is on a 256-byte boundary LD A,(HL) POP HL ; Restore current cell offset location OR A ; Check if cell content = 0 JR NZ,_nextCell ; If not, move on to the next cell INC E ; Increment the count of empty cells _nextCell INC HL ; Move on to the next offset in the table DJNZ _cellLoop ; Keep going for all offsets in the table LD A,E ; Try to find a closed set within the current group CP 4 ; of between 2 and # empty cells - 2 members JR C,_nextGroup ; Don't bother for three empty cells or less LD D,2 ; Start looking at sets of two DEC E ; Stop looking at # of empty cells - 1 LD A,5 ; Cap the set size at 4 CP E JR NC,_setSizeLoop LD E,A _setSizeLoop LD BC,0 ; Initialise number of members found, and starting cell to 0 PUSH DE ; Save set size, # empty cells - 1 CALL FindClosedSet2 ; Try to find a closed set of the current size JR NZ,_foundMove ; Found a move POP DE ; Restore set size, # empty cells - 1 INC D ; Try with a set with 1 more member LD A,E CP D JR NZ,_setSizeLoop ; Keep going until set size is # empty cells - 1 _nextGroup POP BC ; Restore group iterator POP HL ; Restore current group start offset location INC HL ; Move on to the next group start offset in the table DJNZ _groupLoop ; Keep going for all groups in the table XOR A ; No moves found - indicate failure RET _foundMove POP HL ; Discard set size, # empty cells - 1 POP HL ; Discard group iterator POP HL ; Discard current group start address location RET ; Return the move (NZ already set) ; Variables used by this module and other modules. vFcsMessage: DEFW 0 vFcsStarts: DEFW 0 vFcsOffsets: DEFW 0 vFcsBAStart: DEFB 0 ;------------------------------------------------------------ ; FindClosedSet2 ; ; Find the remaining members of a closed group. ; ; Note that the parameters boardAddressStart, boardAddressOffsets ; and name are constant and use the values set in the ; findClosedSet method. ; This method is called recursively so must rely on the stack ; for local variable storage. ; ; TODO: the current logic doesn't cover all cases. ; For example, consider the following case: ; ; Case 1: ; ; 12 123 3456789 3456789 3456789 ... ; ; In this case there is a closed set of 1, 2 in cells 1 and 2 ; which means we can eliminate 3 from cell 2. ; ; The current logic can eliminate options from other cells ; in the group outside the closed set, e.g: ; ; Case 2: ; ; 12 12 123456789 123456789 123456789 ... ; ; Due to the closed set of 1, 2 in cells 1 and 2, all ; 1s and 2s can be removed from cells 3, 4, 5, .... ; ; So current logic finds n cells with n or less of the same options. ; ; We also need to find n options with counts of n or less that ; occupy the same set of cells. ; ; Ideally the additional logic would share as much in common ; with the existing code; The one significant difference is ; that in case 1 the move is chosen from an option not in the set, that ; is found inside the set's cells. In case 2 the move is chosen from ; an option in the set, that is found outside of the set's cells. ; ; I need to write out the two cases in pseudocode side by side to ; see if the same routine can be used for both, with some extra ; parameterisation. ; ; However, lets get the existing logic working first ;-) ; ; That would result in two sets of calls: ; ; findOptionInsideClosedSetRow, ... <- new logic ; findOptionOutsideClosedSetRow, ... <- current logic ; ; ; Registers on input: Registers on output: ; A A indicates whether option (1) or value (2) or no move (0 and Z set) ; B numMembersFound B column (if move available) ; C startCell C row (if move available) ; D groupSize D number (if move available) ; E E board address (if move available) ; H H trashed ; L L trashed ;------------------------------------------------------------ FindClosedSet2: .MODULE FCS2 ; Work out how many members of the set there are left to find ; after this one. If there are less than that number of cells ; left to look at, stop as there won't be enough cells left to ; form a set of the required size. LD A,D SUB B DEC A LD E,A ; E = set size - number of members found - 1 LD A,(vBoardSize) SUB E LD E,A ; E = vBoardSize - membersToFind LD A,C ; C already holds the starting cell ; Go through the cells in the group, starting from the current ; cell, trying to find a member of the set, i.e. a cell with no ; more valid options than the size of the set. _cellLoop LD HL,(vFcsOffsets) ; Work out the address of the next cell offset ADD A,L ; A contains the cell number LD L,A ; offsets does not cross a 256-byte boundary LD A,(vFcsBAStart) ADD A,(HL) ; Work out the offset of the cell PUSH DE ; Save set size, vBoardSize - number of members to find LD E,A ; E = offset of the cell LD HL,vCellOptionCounts ; Get the option count for the cell ADD A,L LD L,A ; vCellOptionCounts does not cross a 256-byte boundary LD A,(HL) ; A = option count for the cell CP 2 ; If the option count is less than 2, don't bother JR C,_nextCell DEC A ; Now compare option count - 1 with set size CP D ; If the option count - 1 is greater than or equal to the JR NC,_nextCell ; set size, option count is greater than set size so don't bother LD A,B ; Store the offset of this cell in the list of cells in the set LD HL,vClosedSetMembersFound ADD A,L LD L,A ; vClosedSetMembersFound does not cross a 256-byte boundary LD (HL),E ; Store the cell offset INC HL LD (HL),0 ; Always make the next entry 0 LD A,B INC A CP D ; Check whether there is room for more cells in the set PUSH BC ; Save number of members found, and cell index JR NC,_checkGroup ; No more room for cells, check if the set is closed INC B ; Increment the number of members found INC C ; Increment the cell index CALL FindClosedSet2 ; Recursively find another potential member of the set JR Z,_nextCell2 ; If no move found, carry on _foundMove POP HL ; Discard number of members found, cell index POP HL ; Discard set size, vBoardSize - membersToFind RET ; Return the selected move _checkGroup CALL CheckClosedSet ; Check whether the options in the cells found make a closed set JR NZ,_foundMove ; If so, then we've found a move to make _nextCell2 POP BC ; Restore number of members found, cell index _nextCell POP DE ; Restore set size, vBoardSize - membersToFind INC C ; Move on to the next cell LD A,C CP E ; Keep going while there are enough cells left to form a closed set JR NZ,_cellLoop XOR A ; No move found. Indicate failure RET ;------------------------------------------------------------ ; CheckClosedSet ; ; Check whether the group is closed, and a move is available. ; ; Note that the parameters boardAddressStart, boardAddressOffsets ; and name are constant and use the values set in the ; findClosedSet method. ; ; Registers on input: Registers on output: ; A A indicates whether option (1) or value (2) or no move (0 and Z set) ; B B column (if move available) ; C C row (if move available) ; D groupSize D number (if move available) ; E E board address (if move available) ; H H trashed ; L L trashed ;------------------------------------------------------------ CheckClosedSet: .MODULE CCS LD B,D ; B = set size PUSH DE ; Save set size LD HL,vClosedSetMembersFound ; HL = address of first cell offset found LD DE,vClosedCellOptAddresses ; DE = address of first cell option to be set _optAddrLoop PUSH HL ; Save address of current cell offset PUSH DE ; Save the address of the cell option LD E,(HL) ; Get the current cell offset CALL GetOptionAddressBase ; Get the offset for option 0 for this cell POP DE ; Restore the address of the cell option EX DE,HL ; Store the address of option 0 LD (HL),E INC HL LD (HL),D INC HL EX DE,HL ; Now have the address of the next cell option to be set POP HL ; Restore the address of the current cell offset INC HL ; Move on to the next cell offset DJNZ _optAddrLoop ; Work out all option 0 addresses for the cells POP DE ; Restore set size LD E,0 ; Set number of options found to 0 LD C,E ; Set option index to 0 _optionLoop LD B,D ; B = set size LD HL,vClosedCellOptAddresses ; HL = address of the first cell option 0 address _cellLoop LD A,(HL) ; Get the option address low byte INC HL ; Move on to the high byte of the option 0 address PUSH HL ; Save the address of the high byte of the option 0 address LD H,(HL) ; Get the option address high byte ADD A,C ; Add the current option to the option address JR NC,_notCrossing ; Check whether add carries over to the high byte INC H ; Increment the high byte if so _notCrossing LD L,A ; HL = address of the current option for the current cell LD A,(HL) ; Get the value of the option AND PENCILLED_MASK ; Check if the option value (ignoring pencilled flag) = 0 JR NZ,_nextCell ; If the option is not available, move on to the next cell in the set PUSH BC ; Save the set cell index and current option LD HL,vClosedSetOptions ; HL = address of the first closed set option CP E ; A already 0, check if number of options found is zero JR Z,_firstOption ; If no options found, then just remember this one LD B,E ; Get the number of options found _nextOther LD A,(HL) CP C ; Compare current option with those already found JR Z,_gotOption ; This option has already been found INC HL ; Move on to the next option DJNZ _nextOther ; Carry on until all options found so far have been checked LD A,D ; The option has not already been found CP E ; If we've already found a set full of options JR Z,_notClosed ; then the set is not closed (i.e. # options > # cells) _firstOption INC E ; We have found another option in the group LD (HL),C ; Store the option at the end of the list POP BC ; Restore the set cell index and current option JR _nextCell ; Process the next cell in the set _notClosed POP HL ; Discard the set cell index and current option POP HL ; Discard the address of the high byte of the option address XOR A ; Indicate no move found for this set RET _gotOption POP BC ; Restore the set member index and current option _nextCell POP HL ; Restore the address of the high byte of the current option address INC HL ; Move on to the low byte of the next option address DJNZ _cellLoop ; Process all cells in the set _nextOption INC C ; Move on to the next option LD A,(vBoardSize) CP C JR NZ,_optionLoop ; Keep going while there are more options LD C,D ; C = set size LD DE,vClosedSetMembersFound ; DE = address of the cells in the closed set LD HL,(vFcsOffsets) ; HL = address of the offsets of cells in the group LD A,(vBoardSize) LD B,A ; Process all the cells in the group _moveCellLoop LD A,(vFcsBAStart) ; Get the offset of the first cell in the group ADD A,(HL) ; Work out the offset of the current cell in the group EX DE,HL ; Is it in the closed set? CP (HL) EX DE,HL JR NZ,_moveOutside ; The cell is outside the closed set INC DE ; Move on to the next cell in the closed set JR _moveNextCell ; Move on to the next cell in the group _moveOutside PUSH HL ; Save the address of the offset of the current cell LD (_vBACell),A ; Save the offset of the current cell in the group LD H,vBoardContentsHigh ; LD L,A ; vBoardContents is on a 256-byte boundary LD A,(HL) ; Get the value in the current cell OR A ; Check if cell content = 0 LD A,L ; A = offset of the current cell in the group JR NZ,_moveNextCell2 ; The cell is occupied PUSH DE ; Save the address of the current cell in the closed set LD E,A ; E = offset of the current cell CALL GetOptionAddressBase ; Get the offset of option 0 for the current cell PUSH BC ; Save cell iterator, set size LD B,C ; B = set size LD DE,vClosedSetOptions ; DE = address of the closed set options _mo_loop LD A,(DE) ; See if there is an option that is in the closed set PUSH HL ; Save the address of option 0 for the current cell ADD A,L ; Add option to the low byte of the option address JR NC,_mo_noCrossing ; Check for carry to the high byte INC H ; Increment the high byte if necessary _mo_noCrossing LD L,A ; HL = address of the current option for the current cell LD A,(HL) ; Get the option value POP HL ; Restore the address of option 0 for the current cell AND PENCILLED_MASK ; Check if the option value (ignoring pencilled flag) = 0 JR Z,_foundMove ; Found an option in the set in a cell outside the set _mo_next INC DE ; Move on the next option in the set DJNZ _mo_loop ; Keep going while there are options available POP BC ; Restore cell iterator, set size POP DE ; Restore the address of the current cell in the closed set _moveNextCell2 POP HL ; Restore the address of the offset of the current cell _moveNextCell INC HL ; Move on the address of the offset of the next cell DJNZ _moveCellLoop ; Process all cells in the group XOR A ; Indicate no move found RET _foundMove POP HL ; Discard cell iterator, set size POP HL ; Discard the address of the current cell in the closed set POP HL ; Discard the address of the offset of the current cell LD A,C ; Save the closed set size LD (_vSetSize),A LD A,(DE) ; Get the option value (0..8) INC A ; Adjust to 1..9 LD D,A ; Set the option value LD A,(_vBACell) ; Get the offset of the cell with the option to remove LD E,A ; Move that into E CALL GetRowColumnNumber ; Get the row and column number of the move LD A,(vNoExplanation) ; Check if move explanation required OR A JR NZ,_return ; If not, just return the values PUSH BC ; Save row/column PUSH DE ; Save option value (1-based) and board address LD HL,sFindClosedSetMessage ; Copy the appropriate message CALL CopyMoveExplanation LD HL,(vFcsMessage) ; Copy in the message for this specific operation LD DE,vMoveExplanation+32-sFindClosedSetSubMsgLen LD BC,sFindClosedSetSubMsgLen LDIR ; Copy in the additional text LD HL,vClosedSetOptions ; Copy in the set of options in the group LD DE,vMoveExplanation+17 LD A,(_vSetSize) ; Restore set size LD B,A ; Copy in all options in the set _copyOptsLoop LD A,(HL) ; Get the option ADD A,$1D ; Adjust option 0..8 to '1'..'9' LD (DE),A ; Write into the message INC DE ; Move on to the next character in the message INC HL ; Move on to the next option in the set DJNZ _copyOptsLoop ; Copy all options in the set POP DE ; Restore option value (1-based) and board address POP BC ; Restore row/column CALL PrintCoordsInMessage2 ; Fill in the coordinates in the message LD A,D ; Get the option number ADD A,$1C ; Adjust option 1..9 to '1'..'9' LD (vMoveExplanation+11),A ; Put that in the explanation _return LD HL,vDifficulty SET 2,(HL) ; Set difficulty bit 2 LD A,FIND_MOVE_ACTUAL ; Indicate remove option OR A ; Indicate a move found RET ; Local variable storage for CheckClosedSet _vBACell DEFB 0 _vSetSize DEFB 0 ;------------------------------------------------------------ ; FindXWingColumn ; ; An X-wing occurs in two columns: ; When an option appears twice in two columns, and those two are in the same row. ; In this case, all occurrences of the option in those rows can be removed. ; ; Registers on input: Registers on output: ; A A indicates whether option (1) or value (2) or no move (0 and Z set) ; B B column (if move available) ; C C row (if move available) ; D D number (if move available) ; E E board address (if move available) ; H H trashed ; L L trashed ;------------------------------------------------------------ FindXWingColumn: LD HL,(vBAColumnStarts) LD (vFxwStarts),HL LD HL,(vBAColumnCellOffsets) LD (vFxwOffsets),HL LD HL,vColumnOptionCounts LD (vFxwCounts),HL LD HL,vColumnOnlyOptionRows) LD (vFxwOnlyOption),HL LD HL,sOnlyOptionColumnMessage LD (vFxwMessage),HL JR FindXWing ; RET merged with CALL ;------------------------------------------------------------ ; FindXWingRow ; ; An X-wing occurs in rows: ; When an option appears twice in two rows, and those two are in the same column. ; In this case, all occurrences of the option in those columns can be removed. ; ; Registers on input: Registers on output: ; A A indicates whether option (1) or value (2) or no move (0 and Z set) ; B B column (if move available) ; C C row (if move available) ; D D number (if move available) ; E E board address (if move available) ; H H trashed ; L L trashed ;------------------------------------------------------------ FindXWingRow: LD HL,(vBARowStarts) LD (vFxwStarts),HL LD HL,(vBARowCellOffsets) LD (vFxwOffsets),HL LD HL,vRowOptionCounts LD (vFxwCounts),HL LD HL,vRowOnlyOptionColumns) LD (vFxwOnlyOption),HL LD HL,sOnlyOptionRowMessage LD (vFxwMessage),HL ; Intentionally drop through to findXWing ;------------------------------------------------------------ ; FindXWing ; ; Find an X-Wing looking at groups with pairs of options. ; ; If an option appears twice in two groups, and those two are in the same other ; groups, then all occurrences of the option in those other groups can be removed. ; ; Registers on input: Registers on output: ; A A indicates whether option (1) or value (2) or no move (0 and Z set) ; B B column (if move available) ; C C row (if move available) ; D D number (if move available) ; E E board address (if move available) ; H H trashed ; L L trashed ;------------------------------------------------------------ FindXWing: .MODULE FXW LD D,0 ; Process each option in turn _optionLoop LD A,(vBoardSize) ; Zero out the cell pairs list LD B,A XOR A LD HL,vFxwCellPairs _clearLoop LD (HL),A INC HL DJNZ _clearLoop LD E,A ; Process each group in turn LD (_vFxwPairsFound),A ; Initialize number of values found ; Look for groups with an option count of 2 for this option. _groupLoop LD HL,(vFxwStarts) ; Work out the address of the start offset LD A,E ADD A,L ; starts does not cross a 256-byte boundary LD L,A LD B,(HL) ; Get the start offset LD HL,(vMultBoardSize) ; Work out the count address of the group/option LD L,E ; vMultBoardSize is on a 256-byte boundary LD A,(HL) ADD A,D ; A = group * vBoardSize + option LD C,A ; Hang on to the count address LD HL,(vFxwCounts) ; Work out the address of the counts value ADD A,L LD L,A ; counts does not cross a 256-byte boundary LD A,(HL) ; Get the count value CP 2 ; We're only interested in option pairs JR NZ,_nextGroup ; Keep going if not 2 LD HL,(vFxwOnlyOption) ; Work out the address of the only option value LD A,C ADD A,L ; onlyOption doesn't cross a 256-byte boundary LD L,A LD C,(HL) ; Get the onlyOption value ; The onlyOption value is the sum of two cell numbers in the group ; We need to find those two cell numbers. This is done by locating ; one cell that has the option available; the other cell is then ; onlyOption value minus the found cell number. LD A,C ; Work out the minimum possible first cell SUB 8 JR NC,_findFirstCell ; Start looking at onlyOption value - 8 XOR A ; Start looking at zero _findFirstCell LD (vFxwGroup),DE ; Save group and option for later LD D,A _cellLoop LD HL,(vFxwOffsets) ; Work out the cell offset LD A,D ADD A,L ; offsets does not cross a 256-byte boundary LD L,A LD A,(HL) ; Get the offset value ADD A,B ; Add to the group start offset LD H,vBoardContentsHigh ; vBoardContents is on a 256-byte boundary LD L,A LD A,(HL) ; Get the contents of the cell OR A JR NZ,_nextCell ; The cell is occupied, so doesn't have any options LD E,L ; Get the cell offset LD A,(vFxwOption) CALL GetOptionAddress0 ; Get the option address for this cell LD A,(HL) AND PENCILLED_MASK ; Check if the option, ignoring pencil mark, is available JR Z,_foundFirst ; The option is not available in this cell _nextCell INC D ; Move on to the next cell LD A,(vBoardSize) ; Check if all cells processed CP D JR NZ,_cellLoop ; Keep going while there are more cells _nextGroup2 LD DE,(vFxwGroup) ; Restore group and option _nextGroup INC E ; Move on to the next group LD A,(vBoardSize) ; Check if all groups processed CP E JR NZ,_groupLoop ; Keep going while there are more groups LD A,(_vFxwPairsFound) ; Check to see if more than one pair CP 2 ; has been found JR C,_nextOption ; If not, move on to the next option CALL FindXWingMove ; Check if pairs form an XWing and there is a valid move RET NZ ; Return if valid move LD DE,(vFxwGroup) ; Restore the option number _nextOption INC D ; Move on to the next option LD A,(vBoardSize) ; Check if all options processed CP D JR NZ,_optionLoop ; Keep going while there are more options XOR A ; Indicate no move found RET ; Having found one available option, work out the other option value ; and store the combination of the values in the pairs list. _foundFirst LD HL,(vMultBoardSize) LD L,D ; vMultBoardSize is on a 256-byte boundary LD A,(HL) ; first cell * board size ADD A,C SUB D LD E,A ; first cell * board size + other cell LD HL,vFxwCellPairs LD A,(vFxwGroup) ADD A,L ; pairs found does not cross a 256-byte boundary LD L,A LD (HL),E ; Store the cell pair value LD HL,_vFxwPairsFound INC (HL) ; Increment the number of pairs found JR _nextGroup2 vFxwStarts: DEFW 0 vFxwOffsets: DEFW 0 vFxwCounts: DEFW 0 vFxwOnlyOption: DEFW 0 vFxwMessage: DEFW 0 Start256(vFxwCellPairs) vFxwCellPairs: .BLOCK 9 ; The cell pair values for each group for the option Check256(vFxwCellPairs) vFxwGroup DEFB 0 ; The current group vFxwOption DEFB 0 ; The current option ; Local variables _vFxwPairsFound DEFB 0 ; The number of pairs found for the option ;------------------------------------------------------------ ; FindXWingMove ; ; Look for a move given a list of cell pairs. ; ; Registers on input: Registers on output: ; A A indicates whether option (1) or value (2) or no move (0 and Z set) ; B B column (if move available) ; C C row (if move available) ; D D number (if move available) ; E E board address (if move available) ; H H trashed ; L L trashed ;------------------------------------------------------------ FindXWingMove: .MODULE FXWM LD B,0 ; Go through each group LD HL,vFxwCellPairs _group1Loop LD A,(HL) ; Check if this group has a pair OR A JR Z,_group1Next ; If not, move on to the next group LD C,B INC C ; Start at first group plus 1 LD D,H LD E,L INC DE _group2Loop LD A,(DE) ; Get the pair value for the second group CP (HL) ; Compare with the pair value for the first group JR Z,_foundXWing ; If the same, then we've found an XWing _group2Next INC DE ; Move on to the next cell pair value INC C ; Move on to the next second group LD A,(vBoardSize) ; Check if any groups left CP C JR NZ,_group2Loop ; Keep going if more groups _group1Next INC HL ; Move on to the next cell pair value INC B ; Move on to the next first group LD A,(vBoardSize) DEC A ; Check if any first groups left CP B JR NZ,_group1Loop ; Keep going if more groups XOR A ; Indicate no move found RET ; For this X-wing to be effective, we need to find any other cell in the ; row/column of the two found that also contains this option. _foundXWing PUSH HL ; Save the second cell pair value address PUSH DE ; Save the first cell pair value address LD L,(HL) LD A,(vDivideBoardSize+1) ; vDivideBoardSize is on a 256-byte boundary LD H,A LD D,(HL) ; Get the first cell of the pair INC H ; Get the cell pair value modulo board size LD E,(HL) ; Get the second cell of the pair LD H,0 ; Go through each group _otherGroupLoop LD A,H CP B ; Ignore the two groups containing the matching cells JR Z,_nextOtherGroup CP C JR Z,_nextOtherGroup PUSH HL ; Save the other group number PUSH BC ; Save the two matching group numbers LD HL,(vFxwStarts) ; Get the board address of the first cell in the group ADD A,L ; starts doesn't cross a 256-byte boundary LD L,A LD B,(HL) ; Get the group start offset LD HL,(vFxwOffsets) LD A,D ADD A,L ; offsets doesn't cross a 256-byte boundary LD L,A LD A,(HL) ; Get the first cell offset ADD A,B PUSH DE ; Save the two cell values LD E,A LD D,vBoardContentsHigh ; Check if the first cell is empty LD A,(DE) OR A JR NZ,_checkCell2 ; If the cell is not empty, check the second cell LD A,(vFxwOption) CALL GetOptionAddress0 ; Get the option address for this cell LD A,(HL) AND PENCILLED_MASK ; Check if the option, ignoring pencil mark, is available JR Z,_foundMove ; We've found a move. _checkCell2 POP DE ; Restore the two cell values LD HL,(vFxwOffsets) LD A,E ADD A,L ; offsets doesn't cross a 256-byte boundary LD L,A LD A,(HL) ; Get the second cell offset ADD A,B PUSH DE ; Save the two cell values LD E,A LD D,vBoardContentsHigh ; Check if the second cell is empty LD A,(DE) OR A JR NZ,_checkedBoth ; If the cell is not empty, check the second cell LD A,(vFxwOption) CALL GetOptionAddress0 ; Get the option address for this cell LD A,(HL) AND PENCILLED_MASK ; Check if the option, ignoring pencil mark, is available JR Z,_foundMove ; We've found a move. _checkedBoth POP DE ; Restore the two cell values POP BC ; Restore the two matching group numbers POP HL ; Restore the other group number _nextOtherGroup INC H ; Move on to the next group LD A,(vBoardSize) ; Process all groups CP H JR NZ,_otherGroupLoop ; Keep going until all groups checked POP DE ; Restore the first cell pair value address POP HL ; Restore the second cell pair value address JR _group2Next ; Keep looking for other matching pairs _foundMove POP HL ; Restore the two cell values LD (_cells),HL ; Save the value for the explanation if required POP HL ; Restore the two group values LD (_groups),HL ; Save the value for the explanation if required POP HL ; Discard the other group number POP HL ; Discard the first cell pair value address POP HL ; Discard the second cell pair value address LD A,(vFxwOption) ; Get the option for which the XWing has been found LD D,A INC D ; Adjust to 1..9 CALL GetRowColumnNumber ; Get the row/column number LD A,(vNoExplanation) ; Check if move explanation required OR A JR NZ,_return ; If not, just return the values PUSH BC ; Save row/column PUSH DE ; Save option value (1-based) and board address LD HL,sFindXWingMessage ; Copy the appropriate message CALL CopyMoveExplanation LD HL,(vFxwMessage) ; Copy in the message for this specific operation LD DE,vMoveExplanation+32-sFindXWingSubMsgLen LD BC,sFindClosedSetSubMsgLen LDIR ; Copy in the additional text LD DE,vMoveExplanation+17 LD HL,(_groups) CALL _displayHL ; Display the two groups LD HL,(_cells) INC DE CALL _displayHL ; Display the two cells POP DE ; Restore option value (1-based) and board address POP BC ; Restore row/column CALL PrintCoordsInMessage2 ; Fill in the coordinates in the message LD A,D ; Get the option number ADD A,$1C ; Adjust option 1..9 to '1'..'9' LD (vMoveExplanation+11),A ; Put that in the explanation _return LD HL,vDifficulty SET 3,(HL) ; Set difficulty bit 3 LD A,FIND_MOVE_ACTUAL ; Indicate remove option OR A ; Indicate a move found RET _displayHL LD A,H ; Copy in the first number ADD A,$1D LD (DE),A INC DE LD A,L ; Copy in the second number ADD A,$1D LD (DE),A INC DE RET ; Local variables _cells DEFW 0 _groups DEFW 0 ;------------------------------------------------------------ ; Board state and computation data ; ; Allocate enough space for all computation data for a 9x9 Sudoku. ; Others will use the same space, but less of it... ; Care is taken to ensure that the blocks don't go over a 256-byte boundary, which ; allows array indexing to ignore the high byte. Of course, this can't be done for ; the Options table which is 729 bytes... ; Aligning the blocks wastes some memory, but reduces instructions in the code and ; improves speed. If I get desparate I can always use the gaps to store variable ; values or some of the static arrays... ; 'only' values are sum of 0..boardSize-1. When only one valid option ; remains, the 'only' value will contain the index of the only valid option. ;------------------------------------------------------------ ; First are some scratch areas that are used by several routines at different ; times, so these can be at the same location. ; Note that the largest block needs to be last. vScratch vScratch1Len EQU $ - vScratch vBoardCopy .BLOCK 9*9 Start256 vBruteForceEmptyCells: .BLOCK 9*9 Check256(vBruteForceEmptyCells) vGenerateRandomPairs EQU vBoardCopy ORG vScratch vGenerateRandomCells: .BLOCK 9 vGenerateStack: .BLOCK 160 vScratch2Len EQU $ - vScratch #IF vScratch1Len > vScratch2Len !!!ScratchLength #ENDIF ; End of scratch area. ; General variables. vMoves: DEFB 0 ; } NOTE: there is code that depends on these two being contiguous vMovesLeft: DEFB 0 ; } vBoardSize: DEFB 0 vBoardSizeSquared: DEFB 0 DEFB 0 ; This allows 16-bit load of vBoardSizeSquared vBoardSizeValueSum: DEFB 0 vSetupMode: DEFB 0 vCheckUnique: DEFB 0 vCurrentRowColumn: ; Allows loading row/column into HL register in one go ; In which case, H = col, L = row. vCurrentRow: DEFB 0 ; zero-based vCurrentColumn: DEFB 0 ; zero-based vSavedRowColumn: DEFW 0 ; Used to save the row/column when doing computations vCurrentBoardAddress: DEFB 0 ; The offset of the currently selected cell DEFB vBoardContentsHigh ; This allows direct 16-bit load of board address vImpossible: DEFB 0 ; Indicates whether board is impossible to solve vSolvingAll: DEFB 0 ; Indicates whether solving all vNoExplanation: DEFB 0 ; Indicates whether explanation of moves is required vNumBoards: DEFB 0 ; The number of supplied board of the currently selected type vCurrentBoard: DEFB 0 ; The current supplied board vDifficulty: DEFB 0 ; The difficulty of the board ; These values hold the offsets for the tables for the current board size. vLookupTables: vBARowStarts: DEFW 0 vBARowCellOffsets: DEFW 0 vBAColumnStarts: DEFW 0 vBAColumnCellOffsets: DEFW 0 vBABlockStarts: DEFW 0 vBABlockCellOffsets: DEFW 0 vBlockNumbers: DEFW 0 vCellNumbers: DEFW 0 vDivideBoardSize: DEFW 0 vModBoardSize: DEFW 0 vMultBoardSize: DEFW 0 vMultBoardSizeSq: DEFW 0 vBlockRowIntersectSize: DEFW 0 vBlockColumnIntersectSize: DEFW 0 vRowBlockIntersectSize: DEFW 0 vColumnBlockIntersectSize: DEFW 0 vBlockRowIntersect: DEFW 0 vBlockColumnIntersect: DEFW 0 vRowBlockIntersect: DEFW 0 vColumnBlockIntersect: DEFW 0 vBlockRowReverseMap: DEFW 0 vBlockColumnReverseMap: DEFW 0 vRowBlockReverseMap: DEFW 0 vColumnBlockReverseMap: DEFW 0 vBoardData: DEFW 0 vLookupTablesLength EQU $ - vLookupTables sFindBlockSingleRowParams: DEFW vBABlockStarts DEFW vBABlockCellOffsets DEFW vBlockRowIntersect DEFW vBlockRowReverseMap DEFW vBARowStarts DEFW vBARowCellOffsets DEFW vBlockRowIntersectSize sFindRowSingleBlockParams: DEFW vBARowStarts DEFW vBARowCellOffsets DEFW vRowBlockIntersect DEFW vRowBlockReverseMap DEFW vBABlockStarts DEFW vBABlockCellOffsets DEFW vRowBlockIntersectSize sFindColumnSingleBlockParams: DEFW vBAColumnStarts DEFW vBAColumnCellOffsets DEFW vColumnBlockIntersect DEFW vColumnBlockReverseMap DEFW vBABlockStarts DEFW vBABlockCellOffsets DEFW vColumnBlockIntersectSize sFindBlockSingleColumnParams: DEFW vBABlockStarts DEFW vBABlockCellOffsets DEFW vBlockColumnIntersect DEFW vBlockColumnReverseMap DEFW vBAColumnStarts DEFW vBAColumnCellOffsets DEFW vBlockColumnIntersectSize ; The "computation data" area is zeroed by calls to ResetBoard and InitializeBoard vComputationData: Align256(vCellOptionCounts) vCellOptionCounts: .BLOCK 9*9 Check256(vCellOptionCounts) vClosedCellOptAddresses: .BLOCK 9*2 Check256(vClosedCellOptAddresses) vBlockOnlyOptionCells: .BLOCK 9*9 Check256(vBlockOnlyOptionCells) Align256(vOptions) vOptions: .BLOCK 9*9*9 vOptionsHigh: EQU vOptions/0FFH ; Allow efficient vOptions access vOptionsLen EQU $ - vOptions ; Reserve a block of text to hold the explanation of a found move. ; This is here as it fits underneath the 256-byte alignment of vBoardContents vMoveExplanation: .BLOCK 32 Align256(vBoardContents) vBoardContents: .BLOCK 9*9 vBoardContentsHigh EQU vBoardContents/0FFH ; Allow efficient vBoardContents access Check256(vBoardContents) vRowOptionCounts: .BLOCK 9*9 Check256(vRowOptionCounts) vColumnOptionCounts: .BLOCK 9*9 Check256(vColumnOptionCounts) vClosedSetMembersFound: .BLOCK 9 Check256(vClosedSetMembersFound) Align256(vHistory) vHistory: .BLOCK 9*9 vHistoryHigh EQU vHistory/0FFH ; Allow efficient vHistory access Check256(vHistory) vBlockOptionCounts: .BLOCK 9*9 Check256(vBlockOptionCounts) vRowOnlyOptionColumns: .BLOCK 9*9 Check256(vRowOnlyOptionCounts) vClosedSetOptions: .BLOCK 9 Check256(vClosedSetOptions) Align256(vColumnOnlyOptionRows) vColumnOnlyOptionRows: .BLOCK 9*9 Check256(vColumnOnlyOptionRows) vComputationDataLength EQU $-vComputationData ;------------------------------------------------------------ ; Static data tables for a 9x9 board. ;------------------------------------------------------------ ; Simple seqence of numbers from 0 to 9. sSequenceTo9 EQU sModBoardSize9x9 ; Reuse first row of the table. ; The addresses of the first cell in each row on the 9x9 board. sBARowStarts9x9 EQU sMultBoardSize9x9 ;DEFB 0, 9, 18, 27, 36, 45, 54, 63, 72 ;Check256(sBARowStarts9x9) ; Note: all of the following static blocks are also set up so they don't cross a 256-byte boundary ; to allow for quicker lookups. ; The offsets to the addresses of the other cells a row. sBARowCellOffsets9x9: EQU sSequenceTo9 ;DEFB 0, 1, 2, 3, 4, 5, 6, 7, 8 ;Check256(sBARowCellOffsets9x9) ; The addresses of the first cell in each column on the 9x9 board. sBAColumnStarts9x9: EQU sSequenceTo9 ;DEFB 0, 1, 2, 3, 4, 5, 6, 7, 8 ;Check256(sBAColumnStarts9x9) ; The offsets to the addresses of the other cells in a column. sBAColumnCellOffsets9x9: EQU sMultBoardSize9x9 ;DEFB 0, 9, 18, 27, 36, 45, 54, 63, 72 ;Check256(sBAColumnCellOffsets9x9) ; The addresses of the first cell in each block on the 9x9 board. sBABlockStarts9x9: DEFB 0, 3, 6, 27, 30, 33, 54, 57, 60 Check256(sBABlockStarts9x9) ; The offsets to the addresses of the other cells in a block. sBABlockCellOffsets9x9: DEFB 0, 1, 2, 9, 10, 11, 18, 19, 20 Check256(sBABlockOffsets9x9) ; The sizes of intersections and the number of those intersections. ; These must be in contiguous bytes as they are treated as a single ; word parameter. sBlockRowIntersectSize9x9 DEFB 3 sBlockRowNumIntersects9x9 DEFB 3 sBlockColumnIntersectSize9x9 DEFB 3 sBlockColumnNumIntersects9x9 DEFB 3 sRowBlockIntersectSize9x9 DEFB 3 sRowBlockNumIntersects9x9 DEFB 3 sColumnBlockIntersectSize9x9 DEFB 3 sColumnBlockNumIntersects9x9 DEFB 3 ; These values indicate the element in the first group of each intersecting ; element in the second. For example, when processing a block the elements in ; the first row are 0,1,2, then 3,4,5, then 6,7,8. ;Start256 sBlockRowIntersect9x9 EQU sSequenceTo9 ;DEFB 0,1,2,3,4,5,6,7,8 ;Check256(sBlockRowIntersect9x9) sBlockColumnIntersect9x9 DEFB 0,3,6,1,4,7,2,5,8 Check256(sBlockColumnIntersect9x9) sRowBlockIntersect9x9 EQU sBlockRowIntersect9x9 sColumnBlockIntersect9x9 EQU sBlockRowIntersect9x9 ; This maps the first element in each row of each block back to the row number. ; for example, in block 4, the first row is row 3, second row 4, third row 5. sBlockRowReverseMap9x9 EQU sCellNumbers9x9 ; Reuse first three rows ;DEFB 0,1,2,0,1,2,0,1,2,3,4,5,3,4,5,3,4,5,6,7,8,6,7,8,6,7,8 ;Check256(sBlockRowReverseMap9x9) sBlockColumnReverseMap9x9 EQU sModBoardSize9x9 ; Reuse first three rows ;DEFB 0,1,2,3,4,5,6,7,8,0,1,2,3,4,5,6,7,8,0,1,2,3,4,5,6,7,8 ;Check256(sBlockColumnReverseMap9x9) sRowBlockReverseMap9x9 EQU sBlockRowReverseMap9x9 sColumnBlockReverseMap9x9 DEFB 0,3,6,0,3,6,0,3,6,1,4,7,1,4,7,1,4,7,2,5,8,2,5,8,2,5,8 Check256(sColumnBlockReverseMap9x9) ;------------------------------------------------------------ ; Static data tables for a 6x6 board. ;------------------------------------------------------------ ; Simple seqence of numbers from 0 to 5. sSequenceTo6 EQU sModBoardSize6x6 ; Reuse first row of the table. ; The addresses of the first cell in each row on the 6x6 board. sBARowStarts6x6 EQU sMultBoardSize6x6 ;DEFB 0, 6, 12, 18, 24, 30 ;Check256(sBARowStarts6x6) ; Note: all of the following static blocks are also set up so they don't cross a 256-byte boundary ; to allow for quicker lookups. ; The offsets to the addresses of the other cells a row. sBARowCellOffsets6x6: EQU sSequenceTo6 ;DEFB 0, 1, 2, 3, 4, 5 ;Check256(sBARowCellOffsets6x6) ; The addresses of the first cell in each column on the 9x9 board. sBAColumnStarts6x6: EQU sSequenceTo6 ;DEFB 0, 1, 2, 3, 4, 5 ;Check256(sBAColumnStarts6x6) ; The offsets to the addresses of the other cells in a column. sBAColumnCellOffsets6x6: EQU sMultBoardSize6x6 ;DEFB 0, 6, 12, 18, 24, 30 ;Check256(sBAColumnCellOffsets6x6) ; The addresses of the first cell in each block on the 6x6 board. sBABlockStarts6x6: DEFB 0, 3, 12, 15, 24, 27 Check256(sBABlockStarts6x6) ; The offsets to the addresses of the other cells in a block. sBABlockCellOffsets6x6: DEFB 0, 1, 2, 6, 7, 8 Check256(sBABlockOffsets6x6) ; The sizes of intersections and the number of those intersections. ; These must be in contiguous bytes as they are treated as a single ; word parameter. sBlockRowIntersectSize6x6 DEFB 3 sBlockRowNumIntersects6x6 DEFB 2 sBlockColumnIntersectSize6x6 DEFB 2 sBlockColumnNumIntersects6x6 DEFB 3 sRowBlockIntersectSize6x6 DEFB 3 sRowBlockNumIntersects6x6 DEFB 2 sColumnBlockIntersectSize6x6 DEFB 2 sColumnBlockNumIntersects6x6 DEFB 3 ; These values indicate the element in the first group of each intersecting ; element in the second. For example, when processing a block the elements in ; the first row are 0,1,2, then 3,4,5, then 6,7,8. ;Start256 sBlockRowIntersect6x6 EQU sSequenceTo6 ;DEFB 0,1,2,3,4,5 ;Check256(sBlockRowIntersect6x6) sBlockColumnIntersect6x6 DEFB 0,3,1,4,2,5 Check256(sBlockColumnIntersect6x6) sRowBlockIntersect6x6 EQU sBlockRowIntersect6x6 sColumnBlockIntersect6x6 EQU sBlockRowIntersect6x6 ; This maps the first element in each row of each block back to the row number. ; for example, in block 4, the first row is row 3, second row 4, third row 5. sBlockRowReverseMap6x6 DEFB 0,1,0,1,2,3,2,3,4,5,4,5 Check256(sBlockRowReverseMap6x6) sBlockColumnReverseMap6x6 EQU sModBoardSize6x6 ; Reuse first three rows. ;DEFB 0,1,2,3,4,5,0,1,2,3,4,5,0,1,2,3,4,5 ;Check256(sBlockColumnReverseMap6x6) sRowBlockReverseMap6x6 EQU sBlockRowReverseMap6x6 sColumnBlockReverseMap6x6 DEFB 0,2,4,0,2,4,0,2,4,1,3,5,1,3,5,1,3,5 Check256(sColumnBlockReverseMap6x6) ; The addresses of the offset tables to use for a 9x9 board. sLookupTables9x9: DEFW sBARowStarts9x9 DEFW sBARowCellOffsets9x9 DEFW sBAColumnStarts9x9 DEFW sBAColumnCellOffsets9x9 DEFW sBABlockStarts9x9 DEFW sBABlockCellOffsets9x9 DEFW sBlockNumbers9x9 DEFW sCellNumbers9x9 DEFW sDivideBoardSize9x9 DEFW sModBoardSize9x9 DEFW sMultBoardSize9x9 DEFW sMultBoardSizeSq9x9 DEFW sBlockRowIntersectSize9x9 DEFW sBlockColumnIntersectSize9x9 DEFW sRowBlockIntersectSize9x9 DEFW sColumnBlockIntersectSize9x9 DEFW sBlockRowIntersect9x9 DEFW sBlockColumnIntersect9x9 DEFW sRowBlockIntersect9x9 DEFW sColumnBlockIntersect9x9 DEFW sBlockRowReverseMap9x9 DEFW sBlockColumnReverseMap9x9 DEFW sRowBlockReverseMap9x9 DEFW sColumnBlockReverseMap9x9 DEFW sBoardData9x9 ; The addresses of the offset tables to use for a 6x6 board. sLookupTables6x6: DEFW sBARowStarts6x6 DEFW sBARowCellOffsets6x6 DEFW sBAColumnStarts6x6 DEFW sBAColumnCellOffsets6x6 DEFW sBABlockStarts6x6 DEFW sBABlockCellOffsets6x6 DEFW sBlockNumbers6x6 DEFW sCellNumbers6x6 DEFW sDivideBoardSize6x6 DEFW sModBoardSize6x6 DEFW sMultBoardSize6x6 DEFW sMultBoardSizeSq6x6 DEFW sBlockRowIntersectSize6x6 DEFW sBlockColumnIntersectSize6x6 DEFW sRowBlockIntersectSize6x6 DEFW sColumnBlockIntersectSize6x6 DEFW sBlockRowIntersect6x6 DEFW sBlockColumnIntersect6x6 DEFW sRowBlockIntersect6x6 DEFW sColumnBlockIntersect6x6 DEFW sBlockRowReverseMap6x6 DEFW sBlockColumnReverseMap6x6 DEFW sRowBlockReverseMap6x6 DEFW sColumnBlockReverseMap6x6 DEFW sBoardData6x6 ;------------------------------------------------------------ ; Static data, screens, etc. ;------------------------------------------------------------ ; Board data for 9x9 boards. sBoardData9x9: ; Difficulty 2 DEFB 4,0,0,0,5,1,0,0,2 DEFB 0,0,0,9,0,0,0,0,1 DEFB 0,0,2,0,0,3,6,0,0 DEFB 0,5,0,0,8,0,1,6,0 DEFB 0,7,0,0,0,0,0,5,0 DEFB 0,3,1,0,2,0,0,4,0 DEFB 0,0,8,1,0,0,9,0,0 DEFB 9,0,0,0,0,7,0,0,0 DEFB 5,0,0,2,9,0,0,0,6 ; Difficulty 3 DEFB 0,0,1,0,9,0,0,0,0 DEFB 0,0,0,0,0,0,5,7,9 DEFB 0,0,3,0,0,4,0,0,0 DEFB 0,5,0,0,6,3,2,0,0 DEFB 0,7,6,0,0,0,8,4,0 DEFB 0,0,9,2,4,0,0,5,0 DEFB 0,0,0,8,0,0,4,0,0 DEFB 6,1,7,0,0,0,0,0,0 DEFB 0,0,0,0,1,0,7,0,0 ; Difficulty 4 DEFB 0,0,2,0,0,0,6,0,0 DEFB 0,3,0,0,0,6,0,0,9 DEFB 8,0,9,0,2,0,0,0,0 DEFB 9,0,0,8,4,0,0,0,0 DEFB 0,5,7,0,9,0,2,8,0 DEFB 0,0,0,0,5,1,0,0,4 DEFB 0,0,0,0,8,0,1,0,2 DEFB 1,0,0,3,0,0,0,5,0 DEFB 0,0,8,0,0,0,3,0,0 ; Difficulty 5 DEFB 0,9,0,0,0,0,2,4,0 DEFB 0,0,1,0,4,9,0,0,3 DEFB 0,5,0,0,0,0,0,0,6 DEFB 0,0,4,0,5,6,0,0,0 DEFB 0,6,0,0,0,0,0,7,0 DEFB 0,0,0,3,8,0,9,0,0 DEFB 7,0,0,0,0,0,0,1,0 DEFB 5,0,0,6,9,0,4,0,0 DEFB 0,1,9,0,0,0,0,5,0 sNumBoards9x9 EQU ($ - sBoardData9x9)/81 ; Board data for 6x6 boards. sBoardData6x6: ; Difficulty 1 DEFB 0,0,6,4,0,0 DEFB 0,0,0,0,2,0 DEFB 0,6,0,0,0,3 DEFB 2,0,0,0,6,0 DEFB 0,4,0,0,0,0 DEFB 0,0,1,5,0,0 ; Difficulty 2 DEFB 0,0,0,6,1,4 DEFB 0,0,0,0,0,0 DEFB 0,0,3,0,0,2 DEFB 5,0,0,3,0,0 DEFB 0,0,0,0,0,0 DEFB 3,6,2,0,0,0 ; Difficulty 3 * Failed to generate one requiring only a closed group.. ; Difficulty 4 DEFB 0,1,2,6,0,0 DEFB 6,4,0,0,0,0 DEFB 0,2,0,5,0,0 DEFB 0,0,6,0,2,0 DEFB 0,0,0,0,6,4 DEFB 0,0,4,1,5,0 sNumBoards6x6 EQU ($ - sBoardData6x6)/36 sOptionsScreenData: ; Column 00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 ;@COMP DEFB $06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06 ; Line 0 DEFB $5F,$06 ; Line 0 ;@COMP DEFB $06,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 1 DEFB $06,$7D,$06 ; Line 1 ;@COMP DEFB $06,$00,$34,$35,$39,$2E,$34,$33,$38,$0E,$00,$00,$00,$B8,$39,$26,$37,$39,$00,$2C,$26,$32,$2A,$00,$00,$00,$B6,$3A,$2E,$39,$00,$06 ; Line 2 DEFB $06,$FF,$04,$0E,$62,$FE,$60,$00,$FE,$4C,$06 ; Line 2 ;@COMP DEFB $06,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 3 DEFB $06,$7D,$06 ; Line 3 ;@COMP DEFB $06,$00,$07,$07,$07,$88,$07,$07,$07,$88,$07,$07,$07,$05,$00,$00,$00,$00,$AE,$33,$38,$39,$37,$3A,$28,$39,$2E,$34,$33,$38,$00,$06 ; Line 4 DEFB $D2,$62,$AE,$33,$FF,$80,$FF,$1E,$FF,$26 ; Line 4 ;@COMP DEFB $06,$00,$07,$07,$07,$88,$07,$07,$07,$88,$07,$07,$07,$05,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 5 DEFB $D2,$6F,$06 ; Line 5 ;@COMP DEFB $06,$00,$07,$07,$07,$88,$07,$07,$07,$88,$07,$07,$07,$05,$00,$A5,$3D,$25,$00,$00,$00,$07,$07,$07,$88,$07,$07,$07,$05,$00,$00,$06 ; Line 6 DEFB $D2,$A5,$3D,$25,$FF,$29 ; Line 6 ;@COMP DEFB $06,$00,$88,$88,$88,$88,$88,$88,$88,$88,$88,$88,$88,$05,$00,$03,$03,$03,$00,$00,$00,$07,$07,$07,$88,$07,$07,$07,$05,$00,$00,$06 ; Line 7 DEFB $06,$00,$44,$88,$D6,$42,$03,$FF,$29 ; Line 7 ;@COMP DEFB $06,$00,$07,$07,$07,$88,$07,$07,$07,$88,$07,$07,$07,$05,$00,$00,$00,$00,$00,$00,$00,$88,$88,$88,$88,$88,$88,$88,$05,$00,$00,$06 ; Line 8 DEFB $D2,$65,$88,$D6,$00,$06 ; Line 8 ;@COMP DEFB $06,$00,$07,$07,$07,$88,$07,$07,$07,$88,$07,$07,$07,$05,$00,$00,$00,$00,$00,$00,$00,$07,$07,$07,$88,$07,$07,$07,$05,$00,$00,$06 ; Line 9 DEFB $D2,$62,$FF,$29 ; Line 9 ;@COMP DEFB $06,$00,$07,$07,$07,$88,$07,$07,$07,$88,$07,$07,$07,$05,$00,$00,$00,$A2,$3D,$22,$00,$07,$07,$07,$88,$07,$07,$07,$05,$00,$00,$06 ; Line 10 DEFB $D2,$61,$A2,$3D,$22,$00,$42,$07,$88,$42,$07,$05,$61,$06 ; Line 10 ;@COMP DEFB $06,$00,$88,$88,$88,$88,$88,$88,$88,$88,$88,$88,$88,$05,$00,$00,$00,$00,$00,$00,$00,$88,$88,$88,$88,$88,$88,$88,$05,$00,$00,$06 ; Line 11 DEFB $06,$00,$44,$88,$D6,$65,$88,$D6,$00,$06 ; Line 11 ;@COMP DEFB $06,$00,$07,$07,$07,$88,$07,$07,$07,$88,$07,$07,$07,$05,$00,$00,$00,$00,$00,$00,$00,$07,$07,$07,$88,$07,$07,$07,$05,$00,$00,$06 ; Line 12 DEFB $D2,$62,$FF,$29 ; Line 12 ;@COMP DEFB $06,$00,$07,$07,$07,$88,$07,$07,$07,$88,$07,$07,$07,$05,$00,$00,$00,$00,$00,$00,$00,$07,$07,$07,$88,$07,$07,$07,$05,$00,$00,$06 ; Line 13 DEFB $D2,$62,$FF,$29 ; Line 13 ;@COMP DEFB $06,$00,$07,$07,$07,$88,$07,$07,$07,$88,$07,$07,$07,$05,$00,$00,$00,$00,$00,$00,$00,$03,$03,$03,$03,$03,$03,$03,$01,$00,$00,$06 ; Line 14 DEFB $D2,$65,$46,$03,$01,$61,$06 ; Line 14 ;@COMP DEFB $06,$00,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$01,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 15 DEFB $06,$00,$4A,$03,$01,$70,$06 ; Line 15 ;@COMP DEFB $06,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 16 DEFB $06,$7D,$06 ; Line 16 ;@COMP DEFB $06,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$3A,$35,$00,$B6,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 17 DEFB $06,$69,$3A,$35,$00,$B6,$6F,$06 ; Line 17 ;@COMP DEFB $06,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 18 DEFB $06,$7D,$06 ; Line 18 ;@COMP DEFB $06,$00,$30,$2A,$3E,$38,$0E,$00,$00,$00,$00,$00,$00,$B4,$00,$B5,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 19 DEFB $06,$FF,$38,$38,$0E,$65,$B4,$00,$B5,$6E,$06 ; Line 19 ;@COMP DEFB $06,$00,$00,$00,$00,$00,$00,$00,$00,$31,$2A,$2B,$39,$00,$00,$00,$37,$2E,$2C,$2D,$39,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 20 DEFB $06,$66,$FE,$47,$61,$37,$2E,$2C,$2D,$39,$69,$06 ; Line 20 ;@COMP DEFB $06,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$A6,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 21 DEFB $06,$6C,$A6,$6F,$06 ; Line 21 ;@COMP DEFB $06,$00,$00,$00,$00,$00,$00,$00,$00,$00,$29,$34,$3C,$33,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 22 DEFB $06,$67,$FE,$45,$6F,$06 ; Line 22 ;@COMP DEFB $06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06 ; Line 23 DEFB $5F,$06 ; Line 23 ; "////////////////////////////////" Line 0 ; "/ /" Line 1 ; "/ OPTIONS: sTART GAME qUIT /" Line 2 ; "/ /" Line 3 ; "/ rrr#rrr#rrr| iNSTRUCTIONS /" Line 4 ; "/ rrr#rrr#rrr| /" Line 5 ; "/ rrr#rrr#rrr| 9x9 rrr#rrr| /" Line 6 ; "/ ###########| --- rrr#rrr| /" Line 7 ; "/ rrr#rrr#rrr| #######| /" Line 8 ; "/ rrr#rrr#rrr| rrr#rrr| /" Line 9 ; "/ rrr#rrr#rrr| 6x6 rrr#rrr| /" Line 10 ; "/ ###########| #######| /" Line 11 ; "/ rrr#rrr#rrr| rrr#rrr| /" Line 12 ; "/ rrr#rrr#rrr| rrr#rrr| /" Line 13 ; "/ rrr#rrr#rrr| -------+ /" Line 14 ; "/ -----------+ /" Line 15 ; "/ /" Line 16 ; "/ UP Q /" Line 17 ; "/ /" Line 18 ; "/ KEYS: O P /" Line 19 ; "/ LEFT RIGHT /" Line 20 ; "/ A /" Line 21 ; "/ DOWN /" Line 22 ; "////////////////////////////////" Line 23 sSetup9x9ScreenData: ; Column 00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 ;@COMP DEFB $38,$2A,$39,$3A,$35,$00,$35,$2D,$26,$38,$2A,$00,$00,$00,$00,$00,$00,$00,$00,$32,$34,$3B,$2A,$38,$00,$31,$2A,$2B,$39,$0E,$00,$00 ; Line 0 DEFB $D5,$35,$FF,$3F,$2A,$67,$FE,$58,$00 ; Line 0 ;@COMP DEFB $2B,$2E,$31,$31,$00,$2E,$33,$00,$2B,$2E,$3D,$2A,$29,$00,$3B,$26,$31,$3A,$2A,$38,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00 ; Line 1 DEFB $FF,$1D,$FE,$67,$6A ; Line 1 ;@COMP DEFB $3B,$26,$31,$2E,$29,$00,$34,$35,$39,$2E,$34,$33,$38,$00,$0E,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00 ; Line 2 DEFB $FF,$27,$C4,$0E,$70 ; Line 2 ;@COMP DEFB $87,$89,$9D,$89,$9E,$89,$9F,$89,$A0,$89,$A1,$89,$A2,$89,$A3,$89,$A4,$89,$A5,$89,$04,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00 ; Line 3 DEFB $87,$89,$9D,$89,$9E,$89,$9F,$89,$A0,$89,$A1,$89,$A2,$89,$A3,$89,$A4,$89,$A5,$89,$04,$6A ; Line 3 ;@COMP DEFB $85,$9D,$00,$0E,$00,$0E,$00,$88,$00,$0E,$00,$0E,$00,$88,$00,$0E,$00,$0E,$00,$9D,$05,$00,$B6,$00,$3A,$35,$00,$00,$00,$00,$00,$00 ; Line 4 DEFB $85,$9D,$CF,$9D,$05,$00,$B6,$00,$3A,$35,$65 ; Line 4 ;@COMP DEFB $85,$88,$16,$15,$16,$15,$16,$88,$16,$15,$16,$15,$16,$88,$16,$15,$16,$15,$16,$88,$05,$00,$A6,$00,$29,$34,$3C,$33,$00,$00,$00,$00 ; Line 5 DEFB $E8,$A6,$FE,$45,$62 ; Line 5 ;@COMP DEFB $85,$9E,$00,$0E,$00,$0E,$00,$88,$00,$0E,$00,$0E,$00,$88,$00,$0E,$00,$0E,$00,$9E,$05,$00,$B4,$00,$31,$2A,$2B,$39,$00,$00,$00,$00 ; Line 6 DEFB $85,$9E,$CF,$9E,$05,$00,$B4,$FE,$47,$62 ; Line 6 ;@COMP DEFB $85,$88,$16,$15,$16,$15,$16,$88,$16,$15,$16,$15,$16,$88,$16,$15,$16,$15,$16,$88,$05,$00,$B5,$00,$37,$2E,$2C,$2D,$39,$00,$00,$00 ; Line 7 DEFB $E8,$FE,$85,$61 ; Line 7 ;@COMP DEFB $85,$9F,$00,$0E,$00,$0E,$00,$88,$00,$0E,$00,$0E,$00,$88,$00,$0E,$00,$0E,$00,$9F,$05,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00 ; Line 8 DEFB $85,$9F,$CF,$9F,$05,$6A ; Line 8 ;@COMP DEFB $85,$88,$88,$88,$88,$88,$88,$08,$88,$88,$88,$88,$88,$08,$88,$88,$88,$88,$88,$88,$05,$00,$9D,$00,$16,$00,$A5,$00,$00,$00,$00,$00 ; Line 9 DEFB $85,$45,$88,$08,$44,$88,$08,$D6,$FE,$84,$A5,$64 ; Line 9 ;@COMP DEFB $85,$A0,$00,$0E,$00,$0E,$00,$88,$00,$0E,$00,$0E,$00,$88,$00,$0E,$00,$0E,$00,$A0,$05,$00,$00,$00,$38,$2A,$39,$00,$3B,$26,$31,$00 ; Line 10 DEFB $85,$A0,$CF,$A0,$05,$62,$FE,$7E ; Line 10 ;@COMP DEFB $85,$88,$16,$15,$16,$15,$16,$88,$16,$15,$16,$15,$16,$88,$16,$15,$16,$15,$16,$88,$05,$00,$BA,$33,$29,$34,$00,$00,$00,$00,$00,$00 ; Line 11 DEFB $E8,$BA,$33,$29,$34,$65 ; Line 11 ;@COMP DEFB $85,$A1,$00,$0E,$00,$0E,$00,$88,$00,$0E,$00,$0E,$00,$88,$00,$0E,$00,$0E,$00,$A1,$05,$00,$A8,$31,$2A,$26,$37,$00,$28,$2A,$31,$31 ; Line 12 DEFB $85,$A1,$CF,$A1,$05,$FE,$4B,$FF,$07 ; Line 12 ;@COMP DEFB $85,$88,$16,$15,$16,$15,$16,$88,$16,$15,$16,$15,$16,$88,$16,$15,$16,$15,$16,$88,$05,$00,$AE,$38,$00,$3A,$33,$2E,$36,$3A,$2A,$0F ; Line 13 DEFB $E8,$FF,$5F,$0F ; Line 13 ;@COMP DEFB $85,$A2,$00,$0E,$00,$0E,$00,$88,$00,$0E,$00,$0E,$00,$88,$00,$0E,$00,$0E,$00,$A2,$05,$00,$BF,$00,$35,$37,$2E,$33,$39,$00,$00,$00 ; Line 14 DEFB $85,$A2,$CF,$A2,$05,$FA,$61 ; Line 14 ;@COMP DEFB $85,$88,$88,$88,$88,$88,$88,$08,$88,$88,$88,$88,$88,$08,$88,$88,$88,$88,$88,$88,$05,$00,$B8,$39,$26,$37,$39,$00,$2C,$26,$32,$2A ; Line 15 DEFB $85,$45,$88,$08,$44,$88,$08,$D6,$FF,$60 ; Line 15 ;@COMP DEFB $85,$A3,$00,$0E,$00,$0E,$00,$88,$00,$0E,$00,$0E,$00,$88,$00,$0E,$00,$0E,$00,$A3,$05,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00 ; Line 16 DEFB $85,$A3,$CF,$A3,$05,$6A ; Line 16 ;@COMP DEFB $85,$88,$16,$15,$16,$15,$16,$88,$16,$15,$16,$15,$16,$88,$16,$15,$16,$15,$16,$88,$05,$00,$B1,$34,$26,$29,$00,$27,$34,$26,$37,$29 ; Line 17 DEFB $E8,$B1,$34,$26,$29,$FF,$03 ; Line 17 ;@COMP DEFB $85,$A4,$00,$0E,$00,$0E,$00,$88,$00,$0E,$00,$0E,$00,$88,$00,$0E,$00,$0E,$00,$A4,$05,$00,$B3,$2A,$3C,$00,$27,$34,$26,$37,$29,$00 ; Line 18 DEFB $85,$A4,$CF,$A4,$05,$00,$B3,$2A,$3C,$C3 ; Line 18 ;@COMP DEFB $85,$88,$16,$15,$16,$15,$16,$88,$16,$15,$16,$15,$16,$88,$16,$15,$16,$15,$16,$88,$05,$00,$AC,$2A,$33,$2A,$37,$26,$39,$2A,$00,$00 ; Line 10 DEFB $E8,$FE,$5E,$00 ; Line 10 ;@COMP DEFB $85,$A5,$00,$0E,$00,$0E,$00,$88,$00,$0E,$00,$0E,$00,$88,$00,$0E,$00,$0E,$00,$A5,$05,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00 ; Line 20 DEFB $85,$A5,$CF,$A5,$05,$6A ; Line 20 ;@COMP DEFB $02,$8A,$9D,$8A,$9E,$8A,$9F,$8A,$A0,$8A,$A1,$8A,$A2,$8A,$A3,$8A,$A4,$8A,$A5,$8A,$01,$00,$AA,$3D,$2E,$39,$00,$00,$00,$00,$00,$00 ; Line 21 DEFB $02,$8A,$9D,$8A,$9E,$8A,$9F,$8A,$A0,$8A,$A1,$8A,$A2,$8A,$A3,$8A,$A4,$8A,$A5,$8A,$01,$00,$AA,$3D,$2E,$39,$65 ; Line 21 ;@COMP DEFB $00,$10,$28,$11,$00,$38,$2E,$32,$34,$33,$00,$2D,$34,$31,$29,$38,$3C,$34,$37,$39,$2D,$00,$1E,$1C,$1C,$22,$1A,$1E,$1C,$1C,$23,$00 ; Line 22 DEFB $FE,$63 ; Line 22 ;@COMP DEFB $00,$00,$2D,$39,$39,$35,$0E,$18,$18,$3C,$3C,$3C,$1B,$3F,$3D,$24,$1D,$38,$39,$3A,$2B,$2B,$1B,$34,$37,$2C,$1B,$3A,$30,$18,$00,$00 ; Line 23 DEFB $FE,$62,$00 ; Line 23 ; "SETUP PHASE MOVES LEFT: " Line 0 ; "FILL IN FIXED VALUES " Line 1 ; "VALID OPTIONS : " Line 2 ; "/#1#2#3#4#5#6#7#8#9#\ " Line 3 ; "|1 : : # : : # : : 1| q UP " Line 4 ; "|#-+-+-#-+-+-#-+-+-#| a DOWN " Line 5 ; "|2 : : # : : # : : 2| o LEFT " Line 6 ; "|#-+-+-#-+-+-#-+-+-#| p RIGHT " Line 7 ; "|3 : : # : : # : : 3| " Line 8 ; "|###################| 1 - 9 " Line 9 ; "|4 : : # : : # : : 4| SET VAL " Line 10 ; "|#-+-+-#-+-+-#-+-+-#| uNDO " Line 11 ; "|5 : : # : : # : : 5| cLEAR CELL" Line 12 ; "|#-+-+-#-+-+-#-+-+-#| iS UNIQUE?" Line 13 ; "|6 : : # : : # : : 6| z PRINT " Line 14 ; "|###################| sTART GAME" Line 15 ; "|7 : : # : : # : : 7| " Line 16 ; "|#-+-+-#-+-+-#-+-+-#| lOAD BOARD" Line 17 ; "|8 : : # : : # : : 8| nEW BOARD " Line 18 ; "|#-+-+-#-+-+-#-+-+-#| gENERATE " Line 19 ; "|9 : : # : : # : : 9| " Line 20 ; "\#1#2#3#4#5#6#7#8#9#/ EXIT " Line 21 ; " (C) SIMON HOLDSWORTH 2006,2007 " Line 22 ; " HTTP://WWW.ZX81STUFF.ORG.UK/ " Line 23 sRunPartialScreenData1: ; Column 00 01 02 03 04 05 06 07 08 09 DEFB $B8,$2D,$34,$3C,$00,$34,$35,$39,$38,$00 ; Line 0 "sHOW OPTS " DEFB $35,$2A,$33,$28,$2E,$31,$00,$34,$35,$B9 ; Line 1 "PENCIL OPt" DEFB $AD,$2E,$33,$39,$00,$00,$00,$00,$00,$00 ; Line 2 "hINT " DEFB $38,$34,$31,$3B,$2A,$00,$34,$B3,$2A,$00 ; Line 3 "SOLVE OnE " DEFB $38,$34,$31,$3B,$2A,$00,$26,$B1,$31,$00 ; Line 4 "SOLVE AlL " DEFB $A9,$2E,$2B,$2B,$2E,$28,$3A,$31,$39,$3E ; Line 5 "dIFFICULTY" sRunPartialScreenData2: ; Column 00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 ;@COMP DEFB $38,$34,$31,$3B,$2A,$00,$39,$2D,$2A,$00,$35,$3A,$3F,$3F,$31,$2A,$00,$00,$00,$32,$34,$3B,$2A,$38,$00,$31,$2A,$2B,$39,$0E,$1C,$1C ; Line 0 DEFB $C8,$FF,$00,$D9,$61,$FF,$58,$1C,$1C ; Line 0 ;@COMP DEFB $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00 ; Line 1 DEFB $7F ; Line 1 ; "SOLVE THE PUZZLE MOVES LEFT:00" Line 0 ; " " Line 1 sShowOptionsPencilMessage: ;@COMP DEFB $35,$2A,$33,$28,$2E,$31,$00,$34,$35,$39,$2E,$34,$33,$38,$0E,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00 ; Line 2 DEFB $FF,$0E,$FF,$04,$0E,$70 ; Line 2 ; "PENCIL OPTIONS: " Line 2 sSetup6x6ScreenData: ; Column 00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 ;@COMP DEFB $38,$2A,$39,$3A,$35,$00,$35,$2D,$26,$38,$2A,$00,$00,$00,$00,$00,$00,$00,$00,$32,$34,$3B,$2A,$38,$00,$31,$2A,$2B,$39,$0E,$00,$00 ; Line 0 DEFB $D5,$35,$FF,$3F,$2A,$67,$FE,$58,$00 ; Line 0 ;@COMP DEFB $2B,$2E,$31,$31,$00,$2E,$33,$00,$2B,$2E,$3D,$2A,$29,$00,$3B,$26,$31,$3A,$2A,$38,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00 ; Line 1 DEFB $FF,$1D,$FE,$67,$6A ; Line 1 ;@COMP DEFB $3B,$26,$31,$2E,$29,$00,$34,$35,$39,$2E,$34,$33,$38,$00,$0E,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00 ; Line 2 DEFB $FF,$27,$C4,$0E,$70 ; Line 2 ;@COMP DEFB $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00 ; Line 3 DEFB $7F ; Line 3 ;@COMP DEFB $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$B6,$00,$3A,$35,$00,$00,$00,$00,$00,$00 ; Line 4 DEFB $75,$B6,$00,$3A,$35,$65 ; Line 4 ;@COMP DEFB $00,$00,$00,$00,$83,$83,$83,$83,$83,$83,$83,$83,$83,$83,$83,$83,$83,$00,$00,$00,$00,$00,$A6,$00,$29,$34,$3C,$33,$00,$00,$00,$00 ; Line 5 DEFB $63,$4C,$83,$64,$A6,$FE,$45,$62 ; Line 5 ;@COMP DEFB $00,$00,$00,$85,$88,$9D,$88,$9E,$88,$9F,$88,$A0,$88,$A1,$88,$A2,$88,$05,$00,$00,$00,$00,$B4,$00,$31,$2A,$2B,$39,$00,$00,$00,$00 ; Line 6 DEFB $FE,$61,$62,$B4,$FE,$47,$62 ; Line 6 ;@COMP DEFB $00,$00,$00,$85,$9D,$00,$0E,$00,$0E,$00,$88,$00,$0E,$00,$0E,$00,$9D,$05,$00,$00,$00,$00,$B5,$00,$37,$2E,$2C,$2D,$39,$00,$00,$00 ; Line 7 DEFB $62,$85,$9D,$E0,$9D,$05,$63,$FE,$85,$61 ; Line 7 ;@COMP DEFB $00,$00,$00,$85,$88,$16,$15,$16,$15,$16,$88,$16,$15,$16,$15,$16,$88,$05,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00 ; Line 8 DEFB $FE,$43,$6C ; Line 8 ;@COMP DEFB $00,$00,$00,$85,$9E,$00,$0E,$00,$0E,$00,$88,$00,$0E,$00,$0E,$00,$9E,$05,$00,$00,$00,$00,$9D,$00,$16,$00,$A2,$00,$00,$00,$00,$00 ; Line 9 DEFB $62,$85,$9E,$E0,$9E,$05,$63,$FE,$84,$A2,$64 ; Line 9 ;@COMP DEFB $00,$00,$00,$85,$88,$88,$88,$88,$88,$88,$08,$88,$88,$88,$88,$88,$88,$05,$00,$00,$00,$00,$00,$00,$38,$2A,$39,$00,$3B,$26,$31,$00 ; Line 10 DEFB $62,$85,$45,$88,$08,$D6,$64,$FE,$7E ; Line 10 ;@COMP DEFB $00,$00,$00,$85,$9F,$00,$0E,$00,$0E,$00,$88,$00,$0E,$00,$0E,$00,$9F,$05,$00,$00,$00,$00,$BA,$33,$29,$34,$00,$00,$00,$00,$00,$00 ; Line 11 DEFB $62,$85,$9F,$E0,$9F,$05,$62,$FE,$4D,$64 ; Line 11 ;@COMP DEFB $00,$00,$00,$85,$88,$16,$15,$16,$15,$16,$88,$16,$15,$16,$15,$16,$88,$05,$00,$00,$00,$00,$A8,$31,$2A,$26,$37,$00,$28,$2A,$31,$31 ; Line 12 DEFB $FE,$43,$61,$FE,$4B,$FF,$07 ; Line 12 ;@COMP DEFB $00,$00,$00,$85,$A0,$00,$0E,$00,$0E,$00,$88,$00,$0E,$00,$0E,$00,$A0,$05,$00,$00,$00,$00,$AE,$38,$00,$3A,$33,$2E,$36,$3A,$2A,$0F ; Line 13 DEFB $62,$85,$A0,$E0,$A0,$05,$63,$FF,$5F,$0F ; Line 13 ;@COMP DEFB $00,$00,$00,$85,$88,$88,$88,$88,$88,$88,$08,$88,$88,$88,$88,$88,$88,$05,$00,$00,$00,$00,$BF,$00,$35,$37,$2E,$33,$39,$00,$00,$00 ; Line 14 DEFB $62,$85,$45,$88,$08,$D6,$61,$FA,$61 ; Line 14 ;@COMP DEFB $00,$00,$00,$85,$A1,$00,$0E,$00,$0E,$00,$88,$00,$0E,$00,$0E,$00,$A1,$05,$00,$00,$00,$00,$B8,$39,$26,$37,$39,$00,$2C,$26,$32,$2A ; Line 15 DEFB $62,$85,$A1,$E0,$A1,$05,$63,$FF,$60 ; Line 15 ;@COMP DEFB $00,$00,$00,$85,$88,$16,$15,$16,$15,$16,$88,$16,$15,$16,$15,$16,$88,$05,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00 ; Line 16 DEFB $FE,$43,$6C ; Line 16 ;@COMP DEFB $00,$00,$00,$85,$A2,$00,$0E,$00,$0E,$00,$88,$00,$0E,$00,$0E,$00,$A2,$05,$00,$00,$00,$00,$B1,$34,$26,$29,$00,$27,$34,$26,$37,$29 ; Line 17 DEFB $62,$85,$A2,$E0,$A2,$05,$62,$FF,$6E,$FF,$03 ; Line 17 ;@COMP DEFB $00,$00,$00,$85,$88,$9D,$88,$9E,$88,$9F,$88,$A0,$88,$A1,$88,$A2,$88,$05,$00,$00,$00,$00,$B3,$2A,$3C,$00,$27,$34,$26,$37,$29,$00 ; Line 18 DEFB $FE,$61,$62,$B3,$2A,$3C,$C3 ; Line 18 ;@COMP DEFB $00,$00,$00,$00,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$00,$00,$00,$00,$00,$AC,$2A,$33,$2A,$37,$26,$39,$2A,$00,$00 ; Line 10 DEFB $63,$4C,$03,$64,$FE,$5E,$00 ; Line 10 ;@COMP DEFB $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00 ; Line 20 DEFB $7F ; Line 20 ;@COMP DEFB $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$AA,$3D,$2E,$39,$00,$00,$00,$00,$00,$00 ; Line 21 DEFB $75,$AA,$3D,$2E,$39,$65 ; Line 21 ;@COMP DEFB $00,$10,$28,$11,$00,$38,$2E,$32,$34,$33,$00,$2D,$34,$31,$29,$38,$3C,$34,$37,$39,$2D,$00,$1E,$1C,$1C,$22,$1A,$1E,$1C,$1C,$23,$00 ; Line 22 DEFB $FE,$63 ; Line 22 ;@COMP DEFB $00,$00,$2D,$39,$39,$35,$0E,$18,$18,$3C,$3C,$3C,$1B,$3F,$3D,$24,$1D,$38,$39,$3A,$2B,$2B,$1B,$34,$37,$2C,$1B,$3A,$30,$18,$00,$00 ; Line 23 DEFB $FE,$62,$00 ; Line 23 ; "SETUP PHASE MOVES LEFT: " Line 0 ; "FILL IN FIXED VALUES " Line 1 ; "VALID OPTIONS : " Line 2 ; " " Line 3 ; " q UP " Line 4 ; " ------------- a DOWN " Line 5 ; " |#1#2#3#4#5#6#| o LEFT " Line 6 ; " |1 : : # : : 1| p RIGHT " Line 7 ; " |#-+-+-#-+-+-#| " Line 8 ; " |2 : : # : : 2| 1 - 6 " Line 9 ; " |#############| SET VAL " Line 10 ; " |3 : : # : : 3| uNDO " Line 11 ; " |#-+-+-#-+-+-#| cLEAR CELL" Line 12 ; " |4 : : # : : 4| iS UNIQUE?" Line 13 ; " |#############| z PRINT " Line 14 ; " |5 : : # : : 5| sTART GAME" Line 15 ; " |#-+-+-#-+-+-#| " Line 16 ; " |6 : : # : : 6| lOAD BOARD" Line 17 ; " |#1#2#3#4#5#6#| nEW BOARD " Line 18 ; " ------------- gENERATE " Line 19 ; " " Line 20 ; " EXIT " Line 21 ; " (C) SIMON HOLDSWORTH 2006,2007 " Line 22 ; " HTTP://WWW.ZX81STUFF.ORG.UK/ " Line 23 sShowOptionsActualMessage: DEFB $26,$28,$39,$3A,$26,$31 ; "ACTUAL" sDifficultyCheckMessage: ;@COMP DEFB $3C,$34,$37,$30,$2E,$33,$2C,$00,$34,$3A,$39,$00,$29,$2E,$2B,$2B,$2E,$28,$3A,$31,$39,$3E,$00,$31,$2A,$3B,$2A,$31,$00,$00,$00,$00 DEFB $3C,$34,$37,$30,$C5,$34,$3A,$39,$00,$FE,$75,$62 ; "WORKING OUT DIFFICULTY LEVEL " sDifficultyMessage: ;@COMP DEFB $29,$2E,$2B,$2B,$2E,$28,$3A,$31,$39,$3E,$00,$31,$2A,$3B,$2A,$31,$0E,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00 DEFB $FF,$75,$0E,$6E ; "DIFFICULTY LEVEL: " sDifficultyMessageSimple: DEFB $1D,$00,$38,$2E,$32,$35,$31,$2A,$00 ; "1 SIMPLE " (level 0) sDifficultyMessageEasy: DEFB $1E,$00,$2A,$26,$38,$3E,$00,$00,$00 ; "2 EASY " (level 1) sDifficultyMessageMedium: DEFB $1F,$00,$32,$2A,$29,$2E,$3A,$32,$00 ; "3 MEDIUM " (level 2) sDifficultyMessageHard: DEFB $20,$00,$2D,$26,$37,$29,$00,$00,$00 ; "4 HARD " (level 3) sDifficultyMessageVeryHard: DEFB $21,$00,$3B,$00,$2D,$26,$37,$29,$00 ; "5 V HARD " (level 4) sDifficultyMessageExtreme: DEFB $22,$00,$2A,$3D,$39,$37,$2A,$32,$2A ; "6 EXTREME" (level 5) sDifficultySubMsgLen EQU $-sDifficultyMessageExtreme sGeneratingMessage: ;@COMP DEFB $2C,$2A,$33,$2A,$37,$26,$39,$2E,$33,$2C,$00,$26,$00,$33,$2A,$3C,$00,$27,$34,$26,$37,$29,$1B,$00,$00,$00,$00,$00,$00,$00,$00,$00 DEFB $2C,$2A,$33,$2A,$37,$26,$39,$C5,$26,$00,$33,$2A,$3C,$FF,$03,$1B,$68 ; "GENERATING A NEW BOARD. " sNoMoveAvailableMessage: ;@COMP DEFB $38,$34,$37,$37,$3E,$1A,$00,$33,$34,$00,$32,$34,$3B,$2A,$00,$26,$3B,$26,$2E,$31,$26,$27,$31,$2A,$00,$0E,$16,$10,$00,$00,$00,$00 DEFB $38,$34,$37,$37,$3E,$1A,$FE,$69,$FF,$31,$E1,$0E,$16,$10,$63 ; "SORRY, NO MOVE AVAILABLE :-( " sInvalidPlacementMessage: ;@COMP DEFB $2E,$33,$3B,$26,$31,$2E,$29,$00,$32,$34,$3B,$2A,$1A,$00,$39,$37,$3E,$00,$26,$2C,$26,$2E,$33,$00,$00,$00,$00,$00,$00,$00,$00,$00 DEFB $2E,$33,$E7,$FF,$31,$1A,$00,$39,$37,$3E,$FE,$64,$67 ; "INVALID MOVE, TRY AGAIN " sBruteForceMoveMessage: ;@COMP DEFB $26,$39,$00,$37,$1A,$28,$0E,$00,$27,$37,$3A,$39,$2A,$00,$2B,$34,$37,$28,$2A,$00,$2B,$34,$3A,$33,$29,$00,$33,$00,$00,$00,$00,$00 DEFB $DC,$27,$37,$3A,$39,$2A,$FF,$0C,$28,$2A,$00,$2B,$34,$3A,$33,$29,$00,$33,$64 ; "AT R,C: BRUTE FORCE FOUND X " sSingleOptionMessage: ;@COMP DEFB $26,$39,$00,$37,$1A,$28,$0E,$00,$34,$33,$31,$3E,$00,$35,$34,$38,$38,$2E,$27,$31,$2A,$00,$34,$35,$39,$2E,$34,$33,$00,$33,$00,$00 DEFB $DC,$FF,$25,$FF,$4A,$2A,$CA,$33,$61 ; "AT R,C: ONLY POSSIBLE OPTION X " sOnlyOptionMessage: ;@COMP DEFB $26,$39,$00,$37,$1A,$28,$0E,$00,$34,$33,$2A,$00,$34,$35,$39,$2E,$34,$33,$00,$33,$00,$2E,$33,$00,$26,$27,$28,$29,$2A,$2B,$00,$00 DEFB $DC,$FF,$0D,$CA,$33,$C1,$26,$27,$28,$29,$2A,$2B,$61 ; "AT R,C: ONE OPTION X IN ABCDEF " sOnlyOptionRowMessage: DEFB $37,$34,$3C,$00,$00,$00 ; "ROW " sOnlyOptionSubMsgLen EQU $-sOnlyOptionRowMessage sOnlyOptionColumnMessage: DEFB $28,$34,$31,$3A,$32,$33 ; "COLUMN" sOnlyOptionBlockMessage: DEFB $27,$31,$34,$28,$30,$00 ; "BLOCK " sCompletionMessage: ;@COMP DEFB $17,$28,$34,$33,$2C,$37,$26,$39,$3A,$31,$26,$39,$2E,$34,$33,$38,$1A,$00,$3E,$34,$3A,$00,$38,$34,$31,$3B,$2A,$29,$00,$2E,$39,$17 DEFB $17,$28,$34,$33,$2C,$37,$26,$39,$3A,$31,$26,$FF,$1E,$38,$1A,$D1,$FF,$08,$29,$FF,$46,$17 ; "*CONGRATULATIONS, YOU SOLVED IT*" sPencilOptionMessage: ;@COMP DEFB $38,$2A,$31,$2A,$28,$39,$00,$39,$2D,$2A,$00,$34,$35,$39,$2E,$34,$33,$00,$39,$34,$00,$35,$2A,$33,$28,$2E,$31,$00,$32,$26,$37,$30 DEFB $38,$2A,$31,$2A,$28,$39,$00,$FF,$00,$CA,$39,$34,$00,$CE,$32,$26,$37,$30 ; "SELECT THE OPTION TO PENCIL MARK" sImpossibleMessage: ;@COMP DEFB $39,$2D,$26,$39,$00,$32,$34,$3B,$2A,$00,$32,$26,$30,$2A,$38,$00,$2E,$39,$00,$3A,$33,$38,$34,$31,$3B,$26,$27,$31,$2A,$00,$00,$00 DEFB $C9,$F1,$32,$FF,$54,$38,$FE,$46,$3A,$33,$38,$34,$31,$3B,$FE,$72,$61 ; "THAT MOVE MAKES IT UNSOLVABLE " sUniqueMessage: ;@COMP DEFB $39,$2D,$2A,$37,$2A,$00,$2E,$38,$00,$26,$00,$3A,$33,$2E,$36,$3A,$2A,$00,$38,$34,$31,$3A,$39,$2E,$34,$33,$00,$00,$00,$00,$00,$00 DEFB $F2,$2E,$38,$F4,$64 ; "THERE IS A UNIQUE SOLUTION " sNotUniqueMessage: ;@COMP DEFB $39,$2D,$2A,$37,$2A,$00,$2E,$38,$00,$33,$34,$00,$3A,$33,$2E,$36,$3A,$2A,$00,$38,$34,$31,$3A,$39,$2E,$34,$33,$00,$00,$00,$00,$00 DEFB $F2,$2E,$38,$FE,$69,$3A,$33,$2E,$36,$3A,$2A,$FF,$2E,$31,$3A,$DE,$63 ; "THERE IS NO UNIQUE SOLUTION " sLookingForUniqueMessage: ;@COMP DEFB $31,$34,$34,$30,$2E,$33,$2C,$00,$2B,$34,$37,$00,$26,$00,$3A,$33,$2E,$36,$3A,$2A,$00,$38,$34,$31,$3A,$39,$2E,$34,$33,$00,$00,$00 DEFB $FF,$57,$FF,$05,$FF,$0C,$F4,$61 ; "LOOKING FOR A UNIQUE SOLUTION " sFindIntersectionMessage: ;@COMP DEFB $26,$39,$00,$37,$1A,$28,$0E,$00,$34,$35,$39,$2E,$34,$33,$00,$3D,$00,$2E,$33,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00 DEFB $DC,$34,$35,$DE,$3D,$C1,$6B ; "AT R,C: OPTION X IN " sFindBlockSingleRowMsg: DEFB $27,$31,$34,$28,$30,$18,$37,$34,$3C,$00,$00,$00 ; "BLOCK/ROW " sFindIntersectionSubMsgLen EQU $-sFindBlockSingleRowMsg sFindBlockSingleColumnMsg: DEFB $27,$31,$34,$28,$30,$18,$28,$34,$31,$3A,$32,$33 ; "BLOCK/COLUMN" sFindRowSingleBlockMsg: DEFB $37,$34,$3C,$18,$27,$31,$34,$28,$30,$00,$00,$00 ; "ROW/BLOCK " sFindColumnSingleBlockMsg: DEFB $28,$34,$31,$3A,$32,$33,$18,$27,$31,$34,$28,$30 ; "COLUMN/BLOCK" sFindClosedSetMessage: ;@COMP DEFB $26,$39,$00,$37,$1A,$28,$0E,$00,$34,$35,$00,$3D,$00,$2C,$37,$35,$00,$00,$00,$00,$00,$00,$00,$2E,$33,$00,$BD,$BD,$BD,$BD,$BD,$BD DEFB $DC,$34,$FE,$7C,$2C,$37,$35,$65,$C1,$45,$BD ; "AT R,C: OP X GRP IN xxxxxx" sFindClosedSetSubMsgLen EQU sOnlyOptionSubMsgLen sClosedSetRowMessage EQU sOnlyOptionRowMessage sClosedSetColumnMessage EQU sOnlyOptionColumnMessage sClosedSetBlockMessage EQU sOnlyOptionBlockMessage sFindWrongPencilMessage: ;@COMP DEFB $26,$39,$00,$37,$1A,$28,$0E,$00,$35,$2A,$33,$28,$2E,$31,$00,$3D,$00,$33,$34,$39,$00,$26,$3B,$26,$2E,$31,$26,$27,$31,$2A,$00,$00 DEFB $DC,$CE,$3D,$FF,$2D,$E1,$00 ; "AT R,C: PENCIL X NOT AVAILABLE " sFindXWingMessage: ;@COMP DEFB $26,$39,$00,$37,$1A,$28,$0E,$00,$34,$35,$00,$3D,$00,$3D,$3C,$2C,$00,$3D,$3D,$1A,$3D,$3D,$00,$2E,$33,$00,$BD,$BD,$BD,$BD,$BD,$BD DEFB $DC,$34,$FE,$7C,$FE,$5D,$3D,$3D,$1A,$3D,$3D,$C1,$45,$BD ; "AT R,C: OP X XWG XX,XX IN xxxxxx" sFindXWingSubMsgLen EQU sOnlyOptionSubMsgLen ;------------------------------------------------------------ ; Handle instruction page display ;------------------------------------------------------------ Instructions: .MODULE I LD HL,sInstructionScreen0 CALL CopyScreenDictionary XOR A LD (_page),A _nextKey CALL GetKeyPress CP $33 ; 'N' Next selected JR Z,_next CP $35 ; 'P' Prev selected JR Z,_prev CP $3F ; 'Z' Copy screen selected JR Z,_copy CP $38 ; 'S' Start game selected RET Z CP $36 ; 'Q' Quit selected JR NZ,_nextKey ; Not a valid key JP 0 ; Reset if quitting _next LD A,(_page) ; Move on to the next page INC A CP sInstructionNumScreens ; If not already on last page JR Z,_nextKey _displayPage LD (_page),A ADD A,A LD HL,sInstructionScreens ; Get the adddress of the instruction screen ADD A,L LD L,A LD A,(HL) INC HL LD H,(HL) LD L,A CALL CopyScreenDictionary JR _nextKey _prev LD A,(_page) ; Move to the previous page OR A JR Z,_nextKey ; If not already zero DEC A JR _displayPage _copy LD D,24 ; Print 24 lines CALL COPY+2 ; Call ROM copy routine JR _nextKey _page DEFB 0 ;------------------------------------------------------------ ; Copy the entire screen from the location pointed to by HL ;------------------------------------------------------------ CopyScreenDictionary: .MODULE CSD ; JP CopyScreen ; LD DE,(D_FILE) ; INC DE ; LD BC,33*24-1 ; LDIR ; RET LD B,24 ; Process 24 lines LD DE,(D_FILE) INC DE _loop PUSH BC LD B,32 CALL Decompress ; Decompress the line POP BC INC DE DJNZ _loop ; Process all lines RET ;------------------------------------------------------------ ; Instruction screens. ;------------------------------------------------------------ sInstructionScreen0: ; Column 00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 ;@COMP DEFB $06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06 ; Line 0 DEFB $5F,$06 ; Line 0 ;@COMP DEFB $06,$00,$2E,$33,$38,$39,$37,$3A,$28,$39,$2E,$34,$33,$38,$0E,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 1 DEFB $FF,$30,$FF,$80,$FF,$1E,$38,$0E,$6F,$06 ; Line 1 ;@COMP DEFB $06,$00,$B1,$34,$26,$29,$00,$26,$00,$38,$3A,$35,$35,$31,$2E,$2A,$29,$00,$35,$3A,$3F,$3F,$31,$2A,$1A,$00,$2D,$26,$3B,$2A,$00,$06 ; Line 2 DEFB $06,$FE,$6E,$26,$00,$38,$3A,$35,$35,$31,$2E,$2A,$29,$FF,$19,$1A,$00,$FE,$79,$06 ; Line 2 ;@COMP DEFB $06,$00,$39,$2D,$2A,$00,$3F,$3D,$24,$1D,$00,$AC,$2A,$33,$2A,$37,$26,$39,$2A,$00,$34,$33,$2A,$1A,$00,$34,$37,$00,$00,$00,$00,$06 ; Line 3 DEFB $FE,$50,$FE,$5E,$FF,$0D,$FE,$53,$62,$06 ; Line 3 ;@COMP DEFB $06,$00,$38,$2A,$39,$00,$34,$33,$2A,$00,$3A,$35,$00,$3E,$34,$3A,$37,$38,$2A,$31,$2B,$00,$27,$3E,$00,$3A,$38,$2E,$33,$2C,$00,$06 ; Line 4 DEFB $06,$00,$38,$2A,$39,$00,$CD,$3A,$35,$FF,$11,$37,$38,$2A,$31,$2B,$F5,$F3,$06 ; Line 4 ;@COMP DEFB $06,$00,$26,$37,$37,$34,$3C,$00,$30,$2A,$3E,$38,$00,$39,$34,$00,$32,$34,$3B,$2A,$00,$39,$2D,$2A,$00,$28,$3A,$37,$38,$34,$37,$06 ; Line 5 DEFB $FF,$2F,$37,$FF,$06,$FF,$38,$38,$FF,$02,$FF,$48,$06 ; Line 5 ;@COMP DEFB $06,$00,$39,$34,$00,$39,$2D,$2A,$00,$28,$2A,$31,$31,$00,$39,$34,$00,$38,$2A,$39,$00,$26,$33,$29,$00,$35,$37,$2A,$38,$38,$00,$06 ; Line 6 DEFB $06,$C2,$C0,$C7,$FF,$5A,$39,$FF,$0B,$D8,$06 ; Line 6 ;@COMP DEFB $06,$00,$1D,$16,$25,$00,$39,$34,$00,$35,$31,$26,$28,$2A,$00,$39,$2D,$2A,$00,$37,$2A,$36,$3A,$2E,$37,$2A,$29,$00,$00,$00,$00,$06 ; Line 7 DEFB $06,$00,$1D,$16,$25,$C2,$FE,$42,$C0,$37,$2A,$36,$3A,$2E,$37,$2A,$29,$63,$06 ; Line 7 ;@COMP DEFB $06,$00,$33,$3A,$32,$27,$2A,$37,$00,$2E,$33,$00,$39,$2D,$2A,$00,$28,$2A,$31,$31,$1B,$00,$00,$3C,$2D,$2A,$33,$00,$00,$00,$00,$06 ; Line 8 DEFB $06,$D7,$2E,$33,$00,$C0,$FF,$07,$1B,$61,$FE,$5B,$62,$06 ; Line 8 ;@COMP DEFB $06,$00,$37,$2A,$26,$29,$3E,$00,$39,$34,$00,$38,$34,$31,$3B,$2A,$1A,$00,$35,$37,$2A,$38,$38,$00,$39,$2D,$2A,$00,$00,$00,$00,$06 ; Line 9 DEFB $06,$00,$37,$2A,$26,$29,$3E,$C2,$FF,$08,$1A,$D8,$C0,$62,$06 ; Line 9 ;@COMP DEFB $06,$00,$B8,$39,$26,$37,$39,$00,$30,$2A,$3E,$1B,$00,$39,$34,$00,$38,$34,$31,$3B,$2A,$00,$26,$00,$35,$3A,$3F,$3F,$31,$2A,$00,$06 ; Line 10 DEFB $FE,$51,$30,$2A,$3E,$1B,$C2,$C8,$26,$D9,$06 ; Line 10 ;@COMP DEFB $06,$00,$2B,$2E,$31,$31,$00,$2A,$26,$28,$2D,$00,$37,$34,$3C,$1A,$00,$28,$34,$31,$3A,$32,$33,$00,$26,$33,$29,$00,$00,$00,$00,$06 ; Line 11 DEFB $06,$00,$FF,$1D,$F6,$FF,$06,$1A,$D0,$FD,$62,$06 ; Line 11 ;@COMP DEFB $06,$00,$27,$31,$34,$28,$30,$00,$3C,$2E,$39,$2D,$00,$33,$3A,$32,$27,$2A,$37,$38,$00,$1D,$00,$39,$34,$00,$25,$1B,$00,$00,$00,$06 ; Line 12 DEFB $06,$D4,$FF,$5C,$FF,$17,$38,$00,$1D,$C2,$25,$1B,$62,$06 ; Line 12 ;@COMP DEFB $06,$00,$3E,$34,$3A,$00,$28,$26,$33,$00,$35,$2A,$33,$28,$2E,$31,$00,$2E,$33,$00,$26,$3B,$26,$2E,$31,$26,$27,$31,$2A,$00,$00,$06 ; Line 13 DEFB $06,$00,$DF,$CE,$2E,$33,$E1,$00,$06 ; Line 13 ;@COMP DEFB $06,$00,$34,$35,$39,$2E,$34,$33,$38,$00,$3E,$34,$3A,$00,$2E,$29,$2A,$33,$39,$2E,$2B,$3E,$1A,$00,$34,$37,$00,$00,$00,$00,$00,$06 ; Line 14 DEFB $06,$C4,$3E,$34,$3A,$00,$2E,$29,$2A,$33,$39,$2E,$2B,$3E,$FE,$53,$63,$06 ; Line 14 ;@COMP DEFB $06,$00,$38,$2D,$34,$3C,$00,$39,$2D,$2A,$00,$26,$28,$39,$3A,$26,$31,$00,$34,$35,$39,$2E,$34,$33,$38,$00,$39,$2D,$26,$39,$00,$06 ; Line 15 DEFB $06,$F9,$FF,$00,$FF,$44,$C4,$C9,$06 ; Line 15 ;@COMP DEFB $06,$00,$26,$37,$2A,$00,$26,$3B,$26,$2E,$31,$26,$27,$31,$2A,$1B,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 16 DEFB $FF,$4E,$FF,$21,$1B,$6E,$06 ; Line 16 ;@COMP DEFB $06,$00,$2E,$2B,$00,$3E,$34,$3A,$00,$2C,$2A,$39,$00,$38,$39,$3A,$28,$30,$1A,$00,$3E,$34,$3A,$00,$28,$26,$33,$00,$00,$00,$00,$06 ; Line 17 DEFB $FF,$4F,$FE,$82,$DF,$62,$06 ; Line 17 ;@COMP DEFB $06,$00,$26,$38,$30,$00,$2B,$34,$37,$00,$26,$00,$AD,$2E,$33,$39,$1A,$00,$34,$37,$00,$2C,$2A,$39,$00,$39,$2D,$2A,$00,$00,$00,$06 ; Line 18 DEFB $FF,$2F,$38,$30,$CC,$26,$00,$AD,$FF,$56,$FE,$53,$FE,$77,$C0,$61,$06 ; Line 18 ;@COMP DEFB $06,$00,$28,$34,$32,$35,$3A,$39,$2A,$37,$00,$39,$34,$00,$38,$34,$31,$3B,$2A,$00,$34,$B3,$2A,$00,$28,$2A,$31,$31,$00,$00,$00,$06 ; Line 19 DEFB $FF,$3B,$34,$32,$35,$3A,$FF,$59,$C2,$C8,$FE,$7B,$C7,$61,$06 ; Line 19 ;@COMP DEFB $06,$00,$34,$37,$00,$26,$B1,$31,$00,$34,$2B,$00,$39,$2D,$2A,$00,$35,$3A,$3F,$3F,$31,$2A,$1B,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 20 DEFB $06,$00,$34,$37,$00,$26,$B1,$31,$FE,$49,$FF,$00,$FF,$19,$1B,$67,$06 ; Line 20 ;@COMP DEFB $06,$00,$32,$34,$37,$2A,$00,$29,$2A,$39,$26,$2E,$31,$38,$00,$34,$33,$00,$33,$2A,$3D,$39,$00,$35,$26,$2C,$2A,$38,$1B,$00,$00,$06 ; Line 21 DEFB $06,$00,$FE,$41,$29,$2A,$39,$26,$2E,$31,$FE,$7D,$FE,$7A,$35,$26,$2C,$2A,$38,$1B,$61,$06 ; Line 21 ;@COMP DEFB $06,$00,$B8,$39,$26,$37,$39,$00,$B3,$2A,$3D,$39,$00,$00,$00,$00,$00,$00,$B6,$3A,$2E,$39,$00,$BF,$00,$35,$37,$2E,$33,$39,$00,$06 ; Line 22 DEFB $FE,$51,$B3,$2A,$3D,$39,$64,$FF,$4C,$FA,$06 ; Line 22 ;@COMP DEFB $06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06 ; Line 23 DEFB $5F,$06 ; Line 23 ; "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%" Line 0 ; "% INSTRUCTIONS: %" Line 1 ; "% lOAD A SUPPLIED PUZZLE, HAVE %" Line 2 ; "% THE ZX81 gENERATE ONE, OR %" Line 3 ; "% SET ONE UP YOURSELF BY USING %" Line 4 ; "% ARROW KEYS TO MOVE THE CURSOR%" Line 5 ; "% TO THE CELL TO SET AND PRESS %" Line 6 ; "% 1-9 TO PLACE THE REQUIRED %" Line 7 ; "% NUMBER IN THE CELL. WHEN %" Line 8 ; "% READY TO SOLVE, PRESS THE %" Line 9 ; "% sTART KEY. TO SOLVE A PUZZLE %" Line 10 ; "% FILL EACH ROW, COLUMN AND %" Line 11 ; "% BLOCK WITH NUMBERS 1 TO 9. %" Line 12 ; "% YOU CAN PENCIL IN AVAILABLE %" Line 13 ; "% OPTIONS YOU IDENTIFY, OR %" Line 14 ; "% SHOW THE ACTUAL OPTIONS THAT %" Line 15 ; "% ARE AVAILABLE. %" Line 16 ; "% IF YOU GET STUCK, YOU CAN %" Line 17 ; "% ASK FOR A hINT, OR GET THE %" Line 18 ; "% COMPUTER TO SOLVE OnE CELL %" Line 19 ; "% OR AlL OF THE PUZZLE. %" Line 20 ; "% MORE DETAILS ON NEXT PAGES. %" Line 21 ; "% sTART nEXT qUIT z PRINT %" Line 22 ; "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%" Line 23 sInstructionScreen1: ; Column 00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 ;@COMP DEFB $06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06 ; Line 0 DEFB $5F,$06 ; Line 0 ;@COMP DEFB $06,$00,$34,$35,$39,$2E,$34,$33,$38,$00,$32,$2A,$33,$3A,$0E,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 1 DEFB $06,$C4,$32,$2A,$33,$3A,$0E,$6F,$06 ; Line 1 ;@COMP DEFB $06,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 2 DEFB $06,$7D,$06 ; Line 2 ;@COMP DEFB $06,$00,$2D,$2A,$37,$2A,$00,$3E,$34,$3A,$00,$26,$37,$2A,$00,$26,$27,$31,$2A,$00,$39,$34,$00,$38,$2A,$31,$2A,$28,$39,$00,$00,$06 ; Line 3 DEFB $06,$00,$2D,$2A,$37,$2A,$D1,$DB,$FE,$72,$FF,$5A,$31,$2A,$28,$39,$61,$06 ; Line 3 ;@COMP DEFB $06,$00,$2B,$37,$34,$32,$00,$39,$2D,$2A,$00,$38,$3A,$29,$34,$30,$3A,$00,$3B,$26,$37,$2E,$26,$33,$39,$38,$00,$00,$00,$00,$00,$06 ; Line 4 DEFB $06,$00,$2B,$37,$34,$32,$00,$FF,$00,$FE,$6A,$3B,$26,$37,$2E,$26,$33,$39,$38,$64,$06 ; Line 4 ;@COMP DEFB $06,$00,$39,$2D,$26,$39,$00,$26,$37,$2A,$00,$38,$3A,$35,$35,$34,$37,$39,$2A,$29,$00,$27,$3E,$00,$39,$2D,$2A,$00,$00,$00,$00,$06 ; Line 5 DEFB $06,$00,$C9,$DB,$38,$3A,$35,$35,$34,$37,$39,$2A,$29,$F5,$C0,$62,$06 ; Line 5 ;@COMP DEFB $06,$00,$2C,$26,$32,$2A,$1A,$00,$26,$33,$29,$00,$39,$34,$00,$38,$39,$26,$37,$39,$00,$39,$2D,$2A,$00,$2C,$26,$32,$2A,$00,$00,$06 ; Line 6 DEFB $06,$FF,$37,$2A,$1A,$CB,$39,$34,$00,$FE,$7F,$FF,$00,$FF,$37,$2A,$61,$06 ; Line 6 ;@COMP DEFB $06,$00,$2C,$34,$2E,$33,$2C,$1B,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 7 DEFB $06,$00,$2C,$34,$FF,$05,$1B,$76,$06 ; Line 7 ;@COMP DEFB $06,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 8 DEFB $06,$7D,$06 ; Line 8 ;@COMP DEFB $06,$00,$2E,$33,$00,$39,$2D,$2A,$00,$28,$31,$26,$38,$38,$2E,$28,$00,$25,$3D,$25,$00,$2C,$26,$32,$2A,$00,$2A,$26,$28,$2D,$00,$06 ; Line 9 DEFB $F0,$C0,$28,$31,$26,$38,$38,$2E,$28,$00,$25,$3D,$25,$FF,$37,$2A,$F6,$06 ; Line 9 ;@COMP DEFB $06,$00,$37,$34,$3C,$1A,$00,$28,$34,$31,$3A,$32,$33,$00,$26,$33,$29,$00,$1F,$3D,$1F,$00,$27,$31,$34,$28,$30,$00,$00,$00,$00,$06 ; Line 10 DEFB $06,$00,$FF,$06,$1A,$D0,$FD,$1F,$3D,$1F,$D4,$62,$06 ; Line 10 ;@COMP DEFB $06,$00,$32,$3A,$38,$39,$00,$28,$34,$33,$39,$26,$2E,$33,$00,$26,$31,$31,$00,$39,$2D,$2A,$00,$33,$3A,$32,$27,$2A,$37,$38,$00,$06 ; Line 11 DEFB $06,$FE,$68,$FC,$FF,$00,$FF,$17,$FF,$26 ; Line 11 ;@COMP DEFB $06,$00,$1D,$00,$39,$34,$00,$25,$00,$3C,$2E,$39,$2D,$00,$33,$34,$00,$29,$3A,$35,$31,$2E,$28,$26,$39,$2A,$38,$00,$00,$00,$00,$06 ; Line 12 DEFB $06,$00,$1D,$C2,$25,$FE,$6C,$62,$06 ; Line 12 ;@COMP DEFB $06,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 13 DEFB $06,$7D,$06 ; Line 13 ;@COMP DEFB $06,$00,$2E,$33,$00,$39,$2D,$2A,$00,$22,$3D,$22,$00,$2C,$26,$32,$2A,$1A,$00,$2A,$26,$28,$2D,$00,$37,$34,$3C,$1A,$00,$00,$00,$06 ; Line 14 DEFB $F0,$C0,$22,$3D,$22,$FF,$37,$2A,$1A,$F6,$FF,$06,$1A,$62,$06 ; Line 14 ;@COMP DEFB $06,$00,$28,$34,$31,$3A,$32,$33,$00,$26,$33,$29,$00,$1F,$3D,$1E,$00,$27,$31,$34,$28,$30,$00,$32,$3A,$38,$39,$00,$00,$00,$00,$06 ; Line 15 DEFB $06,$D0,$FD,$1F,$3D,$1E,$D4,$32,$3A,$38,$39,$63,$06 ; Line 15 ;@COMP DEFB $06,$00,$28,$34,$33,$39,$26,$2E,$33,$00,$26,$31,$31,$00,$39,$2D,$2A,$00,$33,$3A,$32,$27,$2A,$37,$38,$00,$1D,$00,$39,$34,$00,$06 ; Line 16 DEFB $FF,$3B,$34,$33,$39,$26,$2E,$33,$00,$FC,$FF,$00,$FF,$17,$38,$00,$1D,$C2,$06 ; Line 16 ;@COMP DEFB $06,$00,$22,$00,$3C,$2E,$39,$2D,$00,$33,$34,$00,$29,$3A,$35,$31,$2E,$28,$26,$39,$2A,$38,$1B,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 17 DEFB $06,$00,$22,$FF,$6C,$1B,$67,$06 ; Line 17 ;@COMP DEFB $06,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 18 DEFB $06,$7D,$06 ; Line 18 ;@COMP DEFB $06,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 19 DEFB $06,$7D,$06 ; Line 19 ;@COMP DEFB $06,$00,$33,$2A,$3D,$39,$0E,$00,$38,$2A,$39,$3A,$35,$00,$27,$34,$26,$37,$29,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 20 DEFB $E3,$FF,$15,$C3,$6A,$06 ; Line 20 ;@COMP DEFB $06,$00,$35,$37,$2A,$3B,$0E,$00,$2E,$33,$39,$37,$34,$29,$3A,$28,$39,$2E,$34,$33,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 21 DEFB $DA,$FF,$56,$37,$34,$29,$3A,$28,$DE,$69,$06 ; Line 21 ;@COMP DEFB $06,$00,$B8,$39,$26,$37,$39,$00,$B3,$2A,$3D,$39,$00,$B5,$37,$2A,$3B,$00,$B6,$3A,$2E,$39,$00,$BF,$00,$35,$37,$2E,$33,$39,$00,$06 ; Line 22 DEFB $FF,$24 ; Line 22 ;@COMP DEFB $06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06 ; Line 23 DEFB $5F,$06 ; Line 23 ; "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%" Line 0 ; "% OPTIONS MENU: %" Line 1 ; "% %" Line 2 ; "% HERE YOU ARE ABLE TO SELECT %" Line 3 ; "% FROM THE SUDOKU VARIANTS %" Line 4 ; "% THAT ARE SUPPORTED BY THE %" Line 5 ; "% GAME, AND TO START THE GAME %" Line 6 ; "% GOING. %" Line 7 ; "% %" Line 8 ; "% IN THE CLASSIC 9X9 GAME EACH %" Line 9 ; "% ROW, COLUMN AND 3X3 BLOCK %" Line 10 ; "% MUST CONTAIN ALL THE NUMBERS %" Line 11 ; "% 1 TO 9 WITH NO DUPLICATES %" Line 12 ; "% %" Line 13 ; "% IN THE 6X6 GAME, EACH ROW, %" Line 14 ; "% COLUMN AND 3X2 BLOCK MUST %" Line 15 ; "% CONTAIN ALL THE NUMBERS 1 TO %" Line 16 ; "% 6 WITH NO DUPLICATES. %" Line 17 ; "% %" Line 18 ; "% %" Line 19 ; "% NEXT: SETUP BOARD %" Line 20 ; "% PREV: INTRODUCTION %" Line 21 ; "% sTART nEXT pREV qUIT z PRINT %" Line 22 ; "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%" Line 23 sInstructionScreen2: ; Column 00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 ;@COMP DEFB $06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06 ; Line 0 DEFB $5F,$06 ; Line 0 ;@COMP DEFB $06,$00,$38,$2A,$39,$3A,$35,$00,$27,$34,$26,$37,$29,$0E,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 1 DEFB $06,$00,$FF,$15,$FF,$03,$0E,$70,$06 ; Line 1 ;@COMP DEFB $06,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 2 DEFB $06,$7D,$06 ; Line 2 ;@COMP DEFB $06,$00,$28,$37,$2A,$26,$39,$2A,$00,$26,$00,$33,$2A,$3C,$00,$35,$3A,$3F,$3F,$31,$2A,$00,$34,$37,$00,$2A,$33,$39,$2A,$37,$00,$06 ; Line 3 DEFB $FF,$3B,$37,$2A,$26,$39,$2A,$00,$26,$00,$33,$2A,$3C,$D9,$34,$37,$00,$2A,$33,$FE,$59,$06 ; Line 3 ;@COMP DEFB $06,$00,$34,$33,$2A,$00,$2B,$37,$34,$32,$00,$26,$00,$27,$34,$34,$30,$1B,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 4 DEFB $06,$00,$CD,$FE,$3E,$27,$34,$34,$30,$1B,$6C,$06 ; Line 4 ;@COMP DEFB $06,$00,$32,$34,$3B,$2A,$00,$39,$2D,$2A,$00,$28,$3A,$37,$38,$34,$37,$00,$26,$37,$34,$3A,$33,$29,$00,$39,$2D,$2A,$00,$00,$00,$06 ; Line 5 DEFB $06,$FE,$48,$FE,$74,$C0,$61,$06 ; Line 5 ;@COMP DEFB $06,$00,$27,$34,$26,$37,$29,$00,$3A,$38,$2E,$33,$2C,$00,$39,$2D,$2A,$00,$B6,$1A,$A6,$1A,$B4,$00,$26,$33,$29,$00,$B5,$00,$00,$06 ; Line 6 DEFB $06,$C3,$F3,$C0,$B6,$1A,$A6,$1A,$B4,$CB,$B5,$61,$06 ; Line 6 ;@COMP DEFB $06,$00,$30,$2A,$3E,$38,$1B,$00,$00,$3B,$26,$31,$2E,$29,$00,$34,$35,$39,$2E,$34,$33,$38,$00,$26,$37,$2A,$00,$00,$00,$00,$00,$06 ; Line 7 DEFB $06,$FF,$38,$38,$1B,$61,$FF,$27,$C4,$DB,$63,$06 ; Line 7 ;@COMP DEFB $06,$00,$38,$2D,$34,$3C,$33,$00,$2B,$34,$37,$00,$2A,$26,$28,$2D,$00,$28,$2A,$31,$31,$1B,$00,$35,$37,$2A,$38,$38,$00,$00,$00,$06 ; Line 8 DEFB $06,$FF,$39,$33,$FF,$0C,$F6,$FF,$07,$1B,$D8,$61,$06 ; Line 8 ;@COMP DEFB $06,$00,$9D,$16,$A5,$00,$39,$34,$00,$38,$2A,$39,$00,$39,$2D,$2A,$00,$28,$2A,$31,$31,$00,$3B,$26,$31,$3A,$2A,$1B,$00,$00,$00,$06 ; Line 9 DEFB $FE,$71,$FF,$5A,$39,$00,$C0,$C7,$FF,$83,$1B,$62,$06 ; Line 9 ;@COMP DEFB $06,$00,$3E,$34,$3A,$00,$28,$26,$33,$00,$35,$37,$2E,$33,$39,$00,$26,$00,$28,$34,$35,$3E,$00,$34,$2B,$00,$39,$2D,$2A,$00,$00,$06 ; Line 10 DEFB $06,$00,$DF,$35,$37,$FE,$56,$26,$00,$28,$34,$35,$3E,$FE,$49,$C0,$00,$06 ; Line 10 ;@COMP DEFB $06,$00,$27,$34,$26,$37,$29,$00,$26,$39,$00,$26,$33,$3E,$00,$39,$2E,$32,$2A,$00,$3A,$38,$2E,$33,$2C,$00,$BF,$1B,$00,$00,$00,$06 ; Line 11 DEFB $06,$C3,$26,$39,$00,$26,$33,$3E,$00,$FE,$81,$F3,$BF,$1B,$62,$06 ; Line 11 ;@COMP DEFB $06,$00,$2E,$2B,$00,$3E,$34,$3A,$00,$32,$26,$30,$2A,$00,$26,$00,$32,$2E,$38,$39,$26,$30,$2A,$00,$3E,$34,$3A,$00,$28,$26,$33,$06 ; Line 12 DEFB $FF,$4F,$3A,$00,$32,$FE,$54,$26,$00,$32,$2E,$38,$39,$FE,$54,$FF,$1F,$06 ; Line 12 ;@COMP DEFB $06,$00,$BA,$33,$29,$34,$00,$34,$37,$00,$A8,$31,$2A,$26,$37,$1B,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 13 DEFB $06,$FE,$4D,$34,$37,$FF,$4B,$1B,$6E,$06 ; Line 13 ;@COMP DEFB $06,$00,$3A,$38,$2A,$00,$39,$2D,$2A,$00,$AE,$38,$00,$3A,$33,$2E,$36,$3A,$2A,$00,$2B,$3A,$33,$28,$39,$2E,$34,$33,$00,$00,$00,$06 ; Line 14 DEFB $FE,$70,$C0,$FE,$5F,$2B,$3A,$33,$28,$DE,$61,$06 ; Line 14 ;@COMP DEFB $06,$00,$39,$34,$00,$28,$2D,$2A,$28,$30,$00,$3C,$2D,$2A,$39,$2D,$2A,$37,$00,$39,$2D,$2A,$00,$27,$34,$26,$37,$29,$00,$00,$00,$06 ; Line 15 DEFB $06,$FF,$02,$FE,$66,$3C,$2D,$2A,$FF,$00,$37,$00,$FF,$00,$C3,$61,$06 ; Line 15 ;@COMP DEFB $06,$00,$2D,$26,$38,$00,$26,$00,$3A,$33,$2E,$36,$3A,$2A,$00,$38,$34,$31,$3A,$39,$2E,$34,$33,$00,$27,$2A,$2B,$34,$37,$2A,$00,$06 ; Line 16 DEFB $06,$00,$FF,$3F,$F4,$27,$2A,$2B,$34,$37,$2A,$00,$06 ; Line 16 ;@COMP DEFB $06,$00,$35,$31,$26,$3E,$2E,$33,$2C,$1B,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 17 DEFB $06,$00,$35,$31,$26,$3E,$FF,$05,$1B,$74,$06 ; Line 17 ;@COMP DEFB $06,$00,$35,$37,$2A,$38,$38,$00,$B8,$00,$2E,$33,$00,$38,$2A,$39,$3A,$35,$00,$3C,$2D,$2A,$33,$00,$3E,$34,$3A,$00,$00,$00,$00,$06 ; Line 18 DEFB $06,$D8,$B8,$C1,$D5,$FF,$5B,$D1,$62,$06 ; Line 18 ;@COMP DEFB $06,$00,$26,$37,$2A,$00,$37,$2A,$26,$29,$3E,$00,$39,$34,$00,$38,$34,$31,$3B,$2A,$00,$39,$2D,$2A,$00,$27,$34,$26,$37,$29,$1B,$06 ; Line 19 DEFB $FE,$4E,$37,$2A,$26,$29,$3E,$C2,$C8,$FF,$00,$FF,$03,$1B,$06 ; Line 19 ;@COMP DEFB $06,$00,$33,$2A,$3D,$39,$0E,$00,$38,$34,$31,$3B,$2A,$00,$27,$34,$26,$37,$29,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 20 DEFB $E3,$FF,$08,$C3,$6A,$06 ; Line 20 ;@COMP DEFB $06,$00,$35,$37,$2A,$3B,$0E,$00,$38,$2A,$39,$3A,$35,$00,$27,$34,$26,$37,$29,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 21 DEFB $DA,$FF,$15,$C3,$6A,$06 ; Line 21 ;@COMP DEFB $06,$00,$B8,$39,$26,$37,$39,$00,$B3,$2A,$3D,$39,$00,$B5,$37,$2A,$3B,$00,$B6,$3A,$2E,$39,$00,$BF,$00,$35,$37,$2E,$33,$39,$00,$06 ; Line 22 DEFB $FF,$24 ; Line 22 ;@COMP DEFB $06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06 ; Line 23 DEFB $5F,$06 ; Line 23 ; "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%" Line 0 ; "% SETUP BOARD: %" Line 1 ; "% %" Line 2 ; "% CREATE A NEW PUZZLE OR ENTER %" Line 3 ; "% ONE FROM A BOOK. %" Line 4 ; "% MOVE THE CURSOR AROUND THE %" Line 5 ; "% BOARD USING THE q,a,o AND p %" Line 6 ; "% KEYS. VALID OPTIONS ARE %" Line 7 ; "% SHOWN FOR EACH CELL. PRESS %" Line 8 ; "% 1-9 TO SET THE CELL VALUE. %" Line 9 ; "% YOU CAN PRINT A COPY OF THE %" Line 10 ; "% BOARD AT ANY TIME USING z. %" Line 11 ; "% IF YOU MAKE A MISTAKE YOU CAN%" Line 12 ; "% uNDO OR cLEAR. %" Line 13 ; "% USE THE iS UNIQUE FUNCTION %" Line 14 ; "% TO CHECK WHETHER THE BOARD %" Line 15 ; "% HAS A UNIQUE SOLUTION BEFORE %" Line 16 ; "% PLAYING. %" Line 17 ; "% PRESS s IN SETUP WHEN YOU %" Line 18 ; "% ARE READY TO SOLVE THE BOARD.%" Line 19 ; "% NEXT: SOLVE BOARD %" Line 20 ; "% PREV: SETUP BOARD %" Line 21 ; "% sTART nEXT pREV qUIT z PRINT %" Line 22 ; "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%" Line 23 sInstructionScreen3: ; Column 00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 ;@COMP DEFB $06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06 ; Line 0 DEFB $5F,$06 ; Line 0 ;@COMP DEFB $06,$00,$38,$34,$31,$3B,$2A,$00,$27,$34,$26,$37,$29,$0E,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 1 DEFB $06,$00,$FF,$08,$FF,$03,$0E,$70,$06 ; Line 1 ;@COMP DEFB $06,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 2 DEFB $06,$7D,$06 ; Line 2 ;@COMP DEFB $06,$00,$38,$34,$31,$3B,$2A,$00,$39,$2D,$2A,$00,$27,$34,$26,$37,$29,$00,$27,$3E,$00,$2B,$2E,$31,$31,$2E,$33,$2C,$00,$2E,$33,$06 ; Line 3 DEFB $06,$00,$C8,$FF,$00,$C3,$27,$3E,$00,$FF,$1D,$C5,$2E,$33,$06 ; Line 3 ;@COMP DEFB $06,$00,$2A,$32,$35,$39,$3E,$00,$28,$2A,$31,$31,$38,$1B,$00,$32,$34,$3B,$2A,$00,$39,$2D,$2A,$00,$28,$3A,$37,$38,$34,$37,$00,$06 ; Line 4 DEFB $06,$00,$FF,$76,$FF,$2C,$1B,$FE,$48,$06 ; Line 4 ;@COMP DEFB $06,$00,$26,$37,$34,$3A,$33,$29,$00,$3A,$38,$2E,$33,$2C,$00,$B6,$1A,$A6,$1A,$B4,$00,$26,$33,$29,$00,$B5,$1B,$00,$00,$00,$00,$06 ; Line 5 DEFB $06,$00,$FE,$74,$F3,$B6,$1A,$A6,$1A,$B4,$CB,$B5,$1B,$63,$06 ; Line 5 ;@COMP DEFB $06,$00,$2B,$2E,$31,$31,$00,$2E,$33,$00,$3B,$26,$31,$3A,$2A,$38,$00,$27,$3E,$00,$35,$37,$2A,$38,$38,$2E,$33,$2C,$00,$00,$00,$06 ; Line 6 DEFB $06,$00,$DD,$2E,$33,$00,$FF,$83,$38,$FF,$35,$FF,$18,$C5,$61,$06 ; Line 6 ;@COMP DEFB $06,$00,$9D,$16,$A5,$1B,$00,$3E,$34,$3A,$00,$28,$26,$33,$00,$A8,$31,$2A,$26,$37,$00,$26,$33,$29,$00,$BA,$33,$29,$34,$00,$00,$06 ; Line 7 DEFB $FF,$71,$1B,$00,$DF,$A8,$31,$2A,$26,$37,$FF,$0B,$FE,$4D,$00,$06 ; Line 7 ;@COMP DEFB $06,$00,$28,$2A,$31,$31,$38,$1A,$00,$27,$3A,$39,$00,$33,$34,$39,$00,$39,$2D,$34,$38,$2A,$00,$39,$2D,$26,$39,$00,$00,$00,$00,$06 ; Line 8 DEFB $06,$FF,$2C,$1A,$00,$27,$3A,$39,$ED,$39,$2D,$34,$38,$2A,$00,$C9,$62,$06 ; Line 8 ;@COMP DEFB $06,$00,$3C,$2A,$37,$2A,$00,$2B,$2E,$31,$31,$2A,$29,$00,$29,$3A,$37,$2E,$33,$2C,$00,$38,$2A,$39,$3A,$35,$1B,$00,$00,$00,$00,$06 ; Line 9 DEFB $06,$00,$3C,$2A,$37,$2A,$00,$FF,$1D,$2A,$29,$00,$29,$3A,$37,$C5,$FF,$15,$1B,$63,$06 ; Line 9 ;@COMP DEFB $06,$00,$3E,$34,$3A,$00,$28,$26,$33,$00,$35,$2A,$33,$28,$2E,$31,$00,$2E,$33,$00,$34,$35,$39,$2E,$34,$33,$38,$00,$27,$3E,$00,$06 ; Line 10 DEFB $06,$00,$DF,$CE,$2E,$33,$C4,$27,$3E,$00,$06 ; Line 10 ;@COMP DEFB $06,$00,$35,$37,$2A,$38,$38,$2E,$33,$2C,$00,$B9,$00,$30,$2A,$3E,$1B,$00,$00,$39,$2D,$2A,$00,$34,$35,$39,$2E,$34,$33,$38,$00,$06 ; Line 11 DEFB $06,$FF,$18,$C5,$B9,$FF,$38,$1B,$61,$FF,$00,$C4,$06 ; Line 11 ;@COMP DEFB $06,$00,$35,$2A,$33,$28,$2E,$31,$31,$2A,$29,$00,$26,$37,$2A,$00,$38,$2D,$34,$3C,$33,$00,$2B,$34,$37,$00,$2A,$32,$35,$39,$3E,$06 ; Line 12 DEFB $06,$00,$FF,$0E,$FE,$40,$FF,$1B,$FF,$39,$33,$CC,$FF,$76,$06 ; Line 12 ;@COMP DEFB $06,$00,$28,$2A,$31,$31,$38,$1B,$00,$00,$2E,$2B,$00,$3E,$34,$3A,$00,$39,$37,$3E,$00,$39,$34,$00,$35,$31,$26,$28,$2A,$00,$00,$06 ; Line 13 DEFB $06,$FF,$2C,$1B,$61,$2E,$2B,$D1,$39,$37,$3E,$C2,$FE,$42,$00,$06 ; Line 13 ;@COMP DEFB $06,$00,$26,$00,$33,$3A,$32,$27,$2A,$37,$00,$39,$2D,$26,$39,$00,$3C,$34,$3A,$31,$29,$00,$37,$2A,$38,$3A,$31,$39,$00,$00,$00,$06 ; Line 14 DEFB $FF,$2F,$D7,$C9,$3C,$34,$3A,$31,$29,$00,$37,$2A,$38,$3A,$31,$39,$62,$06 ; Line 14 ;@COMP DEFB $06,$00,$2E,$33,$00,$26,$00,$28,$2A,$31,$31,$00,$2D,$26,$3B,$2E,$33,$2C,$00,$33,$34,$00,$3B,$26,$31,$2E,$29,$00,$00,$00,$00,$06 ; Line 15 DEFB $F0,$26,$00,$C7,$2D,$26,$3B,$C5,$33,$34,$00,$E7,$62,$06 ; Line 15 ;@COMP DEFB $06,$00,$34,$35,$39,$2E,$34,$33,$38,$1A,$00,$26,$00,$32,$2A,$38,$38,$26,$2C,$2A,$00,$2E,$38,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 16 DEFB $06,$FF,$04,$1A,$00,$26,$00,$32,$2A,$38,$38,$26,$2C,$2A,$00,$2E,$38,$67,$06 ; Line 16 ;@COMP DEFB $06,$00,$29,$2E,$38,$35,$31,$26,$3E,$2A,$29,$00,$26,$33,$29,$00,$39,$2D,$2A,$00,$33,$3A,$32,$27,$2A,$37,$00,$2E,$38,$00,$00,$06 ; Line 17 DEFB $06,$00,$29,$2E,$38,$35,$31,$26,$3E,$2A,$29,$CB,$FF,$00,$D7,$2E,$38,$61,$06 ; Line 17 ;@COMP DEFB $06,$00,$33,$34,$39,$00,$35,$31,$26,$28,$2A,$29,$1B,$00,$00,$3C,$2D,$2A,$33,$00,$26,$31,$31,$00,$28,$2A,$31,$31,$38,$00,$00,$06 ; Line 18 DEFB $06,$ED,$FF,$42,$29,$1B,$61,$FE,$5B,$FF,$3C,$EC,$00,$06 ; Line 18 ;@COMP DEFB $06,$00,$26,$37,$2A,$00,$2B,$2E,$31,$31,$2A,$29,$00,$39,$2D,$2A,$00,$35,$3A,$3F,$3F,$31,$2A,$00,$2E,$38,$00,$29,$34,$33,$2A,$06 ; Line 19 DEFB $FE,$4E,$FF,$1D,$2A,$29,$00,$FF,$00,$D9,$2E,$38,$00,$29,$FF,$0D,$06 ; Line 19 ;@COMP DEFB $06,$00,$33,$2A,$3D,$39,$0E,$00,$2D,$2E,$33,$39,$38,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 20 DEFB $E3,$FF,$13,$38,$71,$06 ; Line 20 ;@COMP DEFB $06,$00,$35,$37,$2A,$3B,$0E,$00,$38,$2A,$39,$3A,$35,$00,$27,$34,$26,$37,$29,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 21 DEFB $DA,$FF,$15,$C3,$6A,$06 ; Line 21 ;@COMP DEFB $06,$00,$B8,$39,$26,$37,$39,$00,$B3,$2A,$3D,$39,$00,$B5,$37,$2A,$3B,$00,$B6,$3A,$2E,$39,$00,$BF,$00,$35,$37,$2E,$33,$39,$00,$06 ; Line 22 DEFB $FF,$24 ; Line 22 ;@COMP DEFB $06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06 ; Line 23 DEFB $5F,$06 ; Line 23 ; "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%" Line 0 ; "% SOLVE BOARD: %" Line 1 ; "% %" Line 2 ; "% SOLVE THE BOARD BY FILLING IN%" Line 3 ; "% EMPTY CELLS. MOVE THE CURSOR %" Line 4 ; "% AROUND USING q,a,o AND p. %" Line 5 ; "% FILL IN VALUES BY PRESSING %" Line 6 ; "% 1-9. YOU CAN cLEAR AND uNDO %" Line 7 ; "% CELLS, BUT NOT THOSE THAT %" Line 8 ; "% WERE FILLED DURING SETUP. %" Line 9 ; "% YOU CAN PENCIL IN OPTIONS BY %" Line 10 ; "% PRESSING t KEY. THE OPTIONS %" Line 11 ; "% PENCILLED ARE SHOWN FOR EMPTY%" Line 12 ; "% CELLS. IF YOU TRY TO PLACE %" Line 13 ; "% A NUMBER THAT WOULD RESULT %" Line 14 ; "% IN A CELL HAVING NO VALID %" Line 15 ; "% OPTIONS, A MESSAGE IS %" Line 16 ; "% DISPLAYED AND THE NUMBER IS %" Line 17 ; "% NOT PLACED. WHEN ALL CELLS %" Line 18 ; "% ARE FILLED THE PUZZLE IS DONE%" Line 19 ; "% NEXT: HINTS %" Line 20 ; "% PREV: SETUP BOARD %" Line 21 ; "% sTART nEXT pREV qUIT z PRINT %" Line 22 ; "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%" Line 23 sInstructionScreen4: ; Column 00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 ;@COMP DEFB $06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06 ; Line 0 DEFB $5F,$06 ; Line 0 ;@COMP DEFB $06,$00,$2D,$2E,$33,$39,$38,$0E,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 1 DEFB $06,$00,$FF,$13,$38,$0E,$76,$06 ; Line 1 ;@COMP DEFB $06,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 2 DEFB $06,$7D,$06 ; Line 2 ;@COMP DEFB $06,$00,$2E,$2B,$00,$3E,$34,$3A,$00,$2C,$2A,$39,$00,$38,$39,$3A,$28,$30,$1A,$00,$39,$2D,$2A,$33,$00,$2E,$39,$00,$2E,$38,$00,$06 ; Line 3 DEFB $FF,$4F,$FE,$82,$FF,$00,$33,$FE,$46,$2E,$FF,$26 ; Line 3 ;@COMP DEFB $06,$00,$35,$34,$38,$38,$2E,$27,$31,$2A,$00,$39,$34,$00,$2C,$2A,$39,$00,$39,$2D,$2A,$00,$3F,$3D,$24,$1D,$00,$39,$34,$00,$00,$06 ; Line 4 DEFB $06,$FF,$4A,$2A,$C2,$FE,$77,$C0,$3F,$3D,$24,$1D,$C2,$00,$06 ; Line 4 ;@COMP DEFB $06,$00,$2C,$2E,$3B,$2A,$00,$3E,$34,$3A,$00,$26,$00,$2D,$2E,$33,$39,$1B,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 5 DEFB $06,$00,$2C,$2E,$3B,$2A,$D1,$26,$00,$FF,$13,$1B,$6C,$06 ; Line 5 ;@COMP DEFB $06,$00,$39,$2D,$2E,$38,$00,$35,$37,$34,$2C,$37,$26,$32,$00,$2E,$33,$28,$31,$3A,$29,$2A,$38,$00,$38,$34,$32,$2A,$00,$00,$00,$06 ; Line 6 DEFB $06,$00,$39,$FE,$55,$35,$37,$34,$2C,$37,$26,$32,$FF,$01,$28,$31,$3A,$29,$2A,$38,$FF,$2E,$32,$2A,$62,$06 ; Line 6 ;@COMP DEFB $06,$00,$38,$34,$35,$2D,$2E,$38,$39,$2E,$28,$26,$39,$2A,$29,$00,$31,$34,$2C,$2E,$28,$00,$39,$34,$00,$38,$34,$31,$3B,$2A,$00,$06 ; Line 7 DEFB $06,$FF,$2E,$35,$FF,$55,$39,$2E,$28,$26,$39,$2A,$29,$00,$31,$34,$2C,$2E,$28,$C2,$C8,$06 ; Line 7 ;@COMP DEFB $06,$00,$38,$3A,$29,$34,$30,$3A,$00,$35,$3A,$3F,$3F,$31,$2A,$38,$1A,$00,$26,$31,$39,$2D,$34,$3A,$2C,$2D,$00,$00,$00,$00,$00,$06 ; Line 8 DEFB $06,$FF,$6A,$FF,$19,$38,$1A,$00,$26,$31,$39,$2D,$34,$3A,$2C,$2D,$64,$06 ; Line 8 ;@COMP DEFB $06,$00,$38,$34,$32,$2A,$39,$2E,$32,$2A,$38,$00,$39,$37,$2E,$26,$31,$00,$26,$33,$29,$00,$2A,$37,$37,$34,$37,$00,$2E,$38,$00,$06 ; Line 9 DEFB $06,$FF,$2E,$32,$2A,$FF,$81,$38,$00,$39,$37,$2E,$26,$31,$CB,$2A,$37,$37,$34,$37,$00,$2E,$FF,$26 ; Line 9 ;@COMP DEFB $06,$00,$3A,$38,$2A,$29,$1B,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 10 DEFB $FF,$70,$29,$1B,$77,$06 ; Line 10 ;@COMP DEFB $06,$00,$39,$2D,$2A,$00,$38,$2E,$32,$35,$31,$2A,$38,$39,$00,$2B,$34,$37,$32,$00,$34,$2B,$00,$26,$00,$2D,$2E,$33,$39,$00,$00,$06 ; Line 11 DEFB $06,$00,$C0,$38,$2E,$32,$35,$31,$2A,$38,$39,$FF,$0C,$32,$FE,$49,$26,$00,$D3,$00,$06 ; Line 11 ;@COMP DEFB $06,$00,$2E,$38,$00,$39,$34,$00,$B8,$2D,$34,$3C,$00,$39,$2D,$2A,$00,$26,$28,$39,$3A,$26,$31,$00,$34,$35,$39,$2E,$34,$33,$38,$06 ; Line 12 DEFB $06,$00,$2E,$38,$C2,$B8,$2D,$34,$3C,$00,$FF,$00,$FF,$44,$FF,$04,$06 ; Line 12 ;@COMP DEFB $06,$00,$2B,$34,$37,$00,$26,$00,$28,$2A,$31,$31,$1A,$00,$39,$34,$00,$28,$34,$32,$35,$26,$37,$2A,$00,$39,$2D,$2A,$32,$00,$00,$06 ; Line 13 DEFB $06,$CC,$26,$00,$FF,$07,$1A,$C2,$28,$34,$32,$35,$DB,$FF,$00,$32,$61,$06 ; Line 13 ;@COMP DEFB $06,$00,$3C,$2E,$39,$2D,$00,$39,$2D,$2A,$00,$34,$33,$2A,$38,$00,$3E,$34,$3A,$00,$2D,$26,$3B,$2A,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 14 DEFB $06,$00,$FE,$5C,$C0,$FF,$0D,$38,$D1,$FE,$79,$65,$06 ; Line 14 ;@COMP DEFB $06,$00,$35,$2A,$33,$28,$2E,$31,$31,$2A,$29,$00,$2E,$33,$1B,$00,$00,$35,$37,$2A,$38,$38,$2E,$33,$2C,$00,$B8,$00,$00,$00,$00,$06 ; Line 15 DEFB $06,$00,$FF,$0E,$FF,$40,$FF,$01,$1B,$00,$FF,$18,$C5,$B8,$63,$06 ; Line 15 ;@COMP DEFB $06,$00,$26,$2C,$26,$2E,$33,$00,$37,$2A,$3B,$2A,$37,$39,$38,$00,$27,$26,$28,$30,$00,$39,$34,$00,$38,$2D,$34,$3C,$2E,$33,$2C,$06 ; Line 16 DEFB $06,$FE,$64,$37,$2A,$3B,$2A,$37,$39,$38,$00,$27,$26,$28,$30,$FF,$02,$FF,$39,$FF,$05,$06 ; Line 16 ;@COMP DEFB $06,$00,$3E,$34,$3A,$37,$00,$35,$2A,$33,$28,$2E,$31,$31,$2A,$29,$00,$34,$35,$39,$2E,$34,$33,$38,$1B,$00,$3E,$34,$3A,$00,$00,$06 ; Line 17 DEFB $06,$FF,$11,$37,$00,$FF,$0E,$FF,$40,$FF,$04,$1B,$D1,$00,$06 ; Line 17 ;@COMP DEFB $06,$00,$28,$26,$33,$00,$28,$2D,$2A,$28,$30,$00,$2E,$2B,$00,$39,$2D,$2A,$37,$2A,$00,$2E,$38,$00,$38,$39,$2E,$31,$31,$00,$00,$06 ; Line 18 DEFB $FF,$3B,$26,$33,$FE,$66,$2E,$2B,$00,$F2,$2E,$38,$00,$38,$39,$2E,$31,$31,$61,$06 ; Line 18 ;@COMP DEFB $06,$00,$26,$00,$3A,$33,$2E,$36,$3A,$2A,$00,$38,$34,$31,$3A,$39,$2E,$34,$33,$00,$3C,$2E,$39,$2D,$00,$AE,$1B,$00,$00,$00,$00,$06 ; Line 19 DEFB $06,$F4,$FE,$5C,$AE,$1B,$63,$06 ; Line 19 ;@COMP DEFB $06,$00,$33,$2A,$3D,$39,$0E,$00,$32,$34,$37,$2A,$00,$2D,$2E,$33,$39,$38,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 20 DEFB $E3,$FE,$41,$FF,$13,$38,$6C,$06 ; Line 20 ;@COMP DEFB $06,$00,$35,$37,$2A,$3B,$0E,$00,$38,$34,$31,$3B,$2A,$00,$27,$34,$26,$37,$29,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 21 DEFB $DA,$FF,$08,$C3,$6A,$06 ; Line 21 ;@COMP DEFB $06,$00,$B8,$39,$26,$37,$39,$00,$B3,$2A,$3D,$39,$00,$B5,$37,$2A,$3B,$00,$B6,$3A,$2E,$39,$00,$BF,$00,$35,$37,$2E,$33,$39,$00,$06 ; Line 22 DEFB $FF,$24 ; Line 22 ;@COMP DEFB $06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06 ; Line 23 DEFB $5F,$06 ; Line 23 ; "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%" Line 0 ; "% HINTS: %" Line 1 ; "% %" Line 2 ; "% IF YOU GET STUCK, THEN IT IS %" Line 3 ; "% POSSIBLE TO GET THE ZX81 TO %" Line 4 ; "% GIVE YOU A HINT. %" Line 5 ; "% THIS PROGRAM INCLUDES SOME %" Line 6 ; "% SOPHISTICATED LOGIC TO SOLVE %" Line 7 ; "% SUDOKU PUZZLES, ALTHOUGH %" Line 8 ; "% SOMETIMES TRIAL AND ERROR IS %" Line 9 ; "% USED. %" Line 10 ; "% THE SIMPLEST FORM OF A HINT %" Line 11 ; "% IS TO sHOW THE ACTUAL OPTIONS%" Line 12 ; "% FOR A CELL, TO COMPARE THEM %" Line 13 ; "% WITH THE ONES YOU HAVE %" Line 14 ; "% PENCILLED IN. PRESSING s %" Line 15 ; "% AGAIN REVERTS BACK TO SHOWING%" Line 16 ; "% YOUR PENCILLED OPTIONS. YOU %" Line 17 ; "% CAN CHECK IF THERE IS STILL %" Line 18 ; "% A UNIQUE SOLUTION WITH i. %" Line 19 ; "% NEXT: MORE HINTS %" Line 20 ; "% PREV: SOLVE BOARD %" Line 21 ; "% sTART nEXT pREV qUIT z PRINT %" Line 22 ; "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%" Line 23 sInstructionScreen5: ; Column 00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 ;@COMP DEFB $06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06 ; Line 0 DEFB $5F,$06 ; Line 0 ;@COMP DEFB $06,$00,$32,$34,$37,$2A,$00,$2D,$2E,$33,$39,$38,$0E,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 1 DEFB $06,$00,$FE,$41,$FF,$13,$38,$0E,$71,$06 ; Line 1 ;@COMP DEFB $06,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 2 DEFB $06,$7D,$06 ; Line 2 ;@COMP DEFB $06,$00,$3E,$34,$3A,$00,$28,$26,$33,$00,$26,$38,$30,$00,$2B,$34,$37,$00,$26,$00,$2D,$2E,$33,$39,$00,$34,$33,$00,$00,$00,$00,$06 ; Line 3 DEFB $06,$00,$DF,$26,$38,$30,$CC,$26,$00,$D3,$34,$33,$63,$06 ; Line 3 ;@COMP DEFB $06,$00,$39,$2D,$2A,$00,$33,$2A,$3D,$39,$00,$32,$34,$3B,$2A,$00,$3A,$38,$2E,$33,$2C,$00,$AD,$1A,$00,$38,$34,$31,$3B,$2A,$00,$06 ; Line 4 DEFB $06,$00,$C0,$FE,$7A,$F1,$F3,$AD,$1A,$00,$C8,$06 ; Line 4 ;@COMP DEFB $06,$00,$34,$B3,$2A,$00,$32,$34,$3B,$2A,$00,$34,$37,$00,$38,$34,$31,$3B,$2A,$00,$26,$B1,$31,$1B,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 5 DEFB $06,$00,$FE,$7B,$F1,$34,$37,$00,$C8,$26,$B1,$31,$1B,$66,$06 ; Line 5 ;@COMP DEFB $06,$00,$39,$2D,$2A,$00,$3F,$3D,$24,$1D,$00,$38,$39,$26,$37,$39,$38,$00,$27,$3E,$00,$31,$34,$34,$30,$2E,$33,$2C,$00,$00,$00,$06 ; Line 6 DEFB $FE,$50,$FF,$7F,$38,$F5,$FF,$57,$C5,$61,$06 ; Line 6 ;@COMP DEFB $06,$00,$2B,$34,$37,$00,$26,$00,$33,$3A,$32,$27,$2A,$37,$00,$39,$2D,$26,$39,$00,$28,$26,$33,$00,$27,$2A,$00,$00,$00,$00,$00,$06 ; Line 7 DEFB $06,$CC,$26,$D7,$FF,$09,$FE,$65,$63,$06 ; Line 7 ;@COMP DEFB $06,$00,$35,$31,$26,$28,$2A,$29,$1B,$00,$39,$2D,$2A,$37,$2A,$00,$26,$37,$2A,$00,$39,$3C,$34,$00,$3C,$26,$3E,$38,$00,$00,$00,$06 ; Line 8 DEFB $06,$00,$FF,$42,$29,$1B,$00,$F2,$DB,$39,$3C,$34,$00,$3C,$26,$3E,$38,$62,$06 ; Line 8 ;@COMP DEFB $06,$00,$39,$2D,$2E,$38,$00,$28,$26,$33,$00,$27,$2A,$00,$29,$34,$33,$2A,$0E,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 9 DEFB $06,$00,$39,$FF,$55,$FE,$65,$29,$FF,$0D,$0E,$6B,$06 ; Line 9 ;@COMP DEFB $06,$00,$A8,$AA,$B1,$B1,$00,$BC,$AE,$B9,$AD,$00,$B4,$B3,$AA,$00,$B4,$B5,$B9,$AE,$B4,$B3,$0E,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 10 DEFB $06,$00,$A8,$AA,$B1,$B1,$FE,$6F,$66,$06 ; Line 10 ;@COMP DEFB $06,$00,$00,$00,$34,$33,$31,$3E,$00,$35,$34,$38,$38,$2E,$27,$31,$2A,$00,$34,$35,$39,$2E,$34,$33,$00,$1D,$00,$00,$00,$00,$00,$06 ; Line 11 DEFB $06,$62,$FF,$25,$FF,$4A,$2A,$CA,$1D,$64,$06 ; Line 11 ;@COMP DEFB $06,$00,$32,$2A,$26,$33,$38,$00,$39,$2D,$26,$39,$00,$26,$00,$28,$2A,$31,$31,$00,$34,$33,$31,$3E,$00,$2D,$26,$38,$00,$00,$00,$06 ; Line 12 DEFB $E2,$C9,$26,$00,$C7,$E5,$FE,$3F,$61,$06 ; Line 12 ;@COMP DEFB $06,$00,$26,$00,$38,$2E,$33,$2C,$31,$2A,$00,$3B,$26,$31,$2E,$29,$00,$34,$35,$39,$2E,$34,$33,$1B,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 13 DEFB $EF,$38,$FF,$05,$31,$2A,$00,$FF,$27,$FF,$0A,$1B,$66,$06 ; Line 13 ;@COMP DEFB $06,$00,$AC,$B7,$B4,$BA,$B5,$00,$BC,$AE,$B9,$AD,$00,$B4,$B3,$AA,$00,$B4,$B5,$B9,$AE,$B4,$B3,$0E,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 14 DEFB $06,$FF,$6D,$FE,$6F,$65,$06 ; Line 14 ;@COMP DEFB $06,$00,$00,$00,$34,$33,$2A,$00,$34,$35,$39,$2E,$34,$33,$00,$1D,$00,$2E,$33,$00,$37,$34,$3C,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 15 DEFB $06,$62,$FF,$0D,$CA,$1D,$C1,$C6,$66,$06 ; Line 15 ;@COMP DEFB $06,$00,$32,$2A,$26,$33,$38,$00,$39,$2D,$26,$39,$00,$39,$2D,$2A,$00,$34,$35,$39,$2E,$34,$33,$00,$34,$33,$31,$3E,$00,$00,$00,$06 ; Line 16 DEFB $E2,$C9,$FF,$00,$CA,$E5,$61,$06 ; Line 16 ;@COMP DEFB $06,$00,$26,$35,$35,$2A,$26,$37,$38,$00,$34,$33,$28,$2A,$00,$2E,$33,$00,$39,$2D,$2A,$00,$2C,$2E,$3B,$2A,$33,$00,$00,$00,$00,$06 ; Line 17 DEFB $06,$00,$FF,$73,$FF,$7D,$28,$2A,$C1,$C0,$FE,$78,$62,$06 ; Line 17 ;@COMP DEFB $06,$00,$37,$34,$3C,$00,$10,$34,$37,$00,$28,$34,$31,$3A,$32,$33,$00,$34,$37,$00,$27,$31,$34,$28,$30,$11,$1B,$00,$00,$00,$00,$06 ; Line 18 DEFB $06,$00,$C6,$10,$34,$37,$D0,$34,$37,$FF,$14,$11,$1B,$63,$06 ; Line 18 ;@COMP DEFB $06,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 19 DEFB $06,$7D,$06 ; Line 19 ;@COMP DEFB $06,$00,$33,$2A,$3D,$39,$0E,$00,$26,$29,$3B,$26,$33,$28,$2A,$29,$00,$2D,$2E,$33,$39,$38,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 20 DEFB $FF,$23,$EA,$67,$06 ; Line 20 ;@COMP DEFB $06,$00,$35,$37,$2A,$3B,$0E,$00,$2D,$2E,$33,$39,$38,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 21 DEFB $DA,$FF,$13,$38,$71,$06 ; Line 21 ;@COMP DEFB $06,$00,$B8,$39,$26,$37,$39,$00,$B3,$2A,$3D,$39,$00,$B5,$37,$2A,$3B,$00,$B6,$3A,$2E,$39,$00,$BF,$00,$35,$37,$2E,$33,$39,$00,$06 ; Line 22 DEFB $FF,$24 ; Line 22 ;@COMP DEFB $06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06 ; Line 23 DEFB $5F,$06 ; Line 23 ; "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%" Line 0 ; "% MORE HINTS: %" Line 1 ; "% %" Line 2 ; "% YOU CAN ASK FOR A HINT ON %" Line 3 ; "% THE NEXT MOVE USING h, SOLVE %" Line 4 ; "% OnE MOVE OR SOLVE AlL. %" Line 5 ; "% THE ZX81 STARTS BY LOOKING %" Line 6 ; "% FOR A NUMBER THAT CAN BE %" Line 7 ; "% PLACED. THERE ARE TWO WAYS %" Line 8 ; "% THIS CAN BE DONE: %" Line 9 ; "% cell with one option: %" Line 10 ; "% ONLY POSSIBLE OPTION 1 %" Line 11 ; "% MEANS THAT A CELL ONLY HAS %" Line 12 ; "% A SINGLE VALID OPTION. %" Line 13 ; "% group with one option: %" Line 14 ; "% ONE OPTION 1 IN ROW %" Line 15 ; "% MEANS THAT THE OPTION ONLY %" Line 16 ; "% APPEARS ONCE IN THE GIVEN %" Line 17 ; "% ROW (OR COLUMN OR BLOCK). %" Line 18 ; "% %" Line 19 ; "% NEXT: ADVANCED HINTS %" Line 20 ; "% PREV: HINTS %" Line 21 ; "% sTART nEXT pREV qUIT z PRINT %" Line 22 ; "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%" Line 23 sInstructionScreen6: ; Column 00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 ;@COMP DEFB $06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06 ; Line 0 DEFB $5F,$06 ; Line 0 ;@COMP DEFB $06,$00,$26,$29,$3B,$26,$33,$28,$2A,$29,$00,$2D,$2E,$33,$39,$38,$0E,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 1 DEFB $06,$FF,$2A,$0E,$6D,$06 ; Line 1 ;@COMP DEFB $06,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 2 DEFB $06,$7D,$06 ; Line 2 ;@COMP DEFB $06,$00,$26,$2B,$39,$2A,$37,$00,$29,$34,$2E,$33,$2C,$00,$26,$31,$31,$00,$39,$2D,$2A,$00,$26,$27,$34,$3B,$2A,$00,$00,$00,$00,$06 ; Line 3 DEFB $FF,$2F,$2B,$FE,$59,$29,$34,$C5,$FC,$C0,$26,$27,$34,$3B,$2A,$63,$06 ; Line 3 ;@COMP DEFB $06,$00,$39,$2D,$2A,$00,$3F,$3D,$24,$1D,$00,$39,$2D,$2A,$33,$00,$31,$34,$34,$30,$38,$00,$2B,$34,$37,$00,$00,$00,$00,$00,$00,$06 ; Line 4 DEFB $FE,$50,$FF,$00,$33,$00,$FF,$57,$38,$CC,$64,$06 ; Line 4 ;@COMP DEFB $06,$00,$34,$35,$39,$2E,$34,$33,$38,$00,$39,$2D,$26,$39,$00,$28,$26,$33,$00,$27,$2A,$00,$37,$2A,$32,$34,$3B,$2A,$29,$1B,$00,$06 ; Line 5 DEFB $06,$C4,$FF,$09,$FF,$2B,$1B,$00,$06 ; Line 5 ;@COMP DEFB $06,$00,$B5,$AA,$B3,$A8,$AE,$B1,$B1,$AA,$A9,$00,$B4,$B5,$B9,$AE,$B4,$B3,$B8,$0E,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 6 DEFB $06,$00,$B5,$AA,$B3,$A8,$AE,$B1,$B1,$AA,$A9,$00,$B4,$B5,$FE,$86,$69,$06 ; Line 6 ;@COMP DEFB $06,$00,$00,$00,$35,$2A,$33,$28,$2E,$31,$00,$1D,$00,$33,$34,$39,$00,$26,$3B,$26,$2E,$31,$26,$27,$31,$2A,$00,$00,$00,$00,$00,$06 ; Line 7 DEFB $06,$62,$CE,$1D,$FF,$2D,$E1,$63,$06 ; Line 7 ;@COMP DEFB $06,$00,$32,$2A,$26,$33,$38,$00,$39,$2D,$2A,$00,$35,$2A,$33,$28,$2E,$31,$31,$2A,$29,$00,$34,$35,$39,$2E,$34,$33,$00,$00,$00,$06 ; Line 8 DEFB $E2,$C0,$FF,$0E,$FF,$40,$CA,$61,$06 ; Line 8 ;@COMP DEFB $06,$00,$2E,$38,$00,$33,$34,$39,$00,$26,$28,$39,$3A,$26,$31,$31,$3E,$00,$26,$3B,$26,$2E,$31,$26,$27,$31,$2A,$00,$00,$00,$00,$06 ; Line 9 DEFB $06,$00,$2E,$38,$FF,$2D,$FF,$44,$31,$3E,$E1,$62,$06 ; Line 9 ;@COMP DEFB $06,$00,$26,$33,$29,$00,$28,$26,$33,$00,$27,$2A,$00,$37,$2A,$32,$34,$3B,$2A,$29,$1B,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 10 DEFB $06,$FF,$0B,$FF,$2B,$1B,$69,$06 ; Line 10 ;@COMP DEFB $06,$00,$AE,$B3,$B9,$AA,$B7,$B8,$AA,$A8,$B9,$AE,$B4,$B3,$B8,$0E,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 11 DEFB $06,$00,$AE,$B3,$B9,$AA,$B7,$B8,$AA,$A8,$FE,$86,$6D,$06 ; Line 11 ;@COMP DEFB $06,$00,$00,$00,$34,$35,$39,$2E,$34,$33,$00,$1D,$00,$2E,$33,$00,$27,$31,$34,$28,$30,$18,$37,$34,$3C,$00,$00,$00,$00,$00,$00,$06 ; Line 12 DEFB $06,$61,$CA,$1D,$FF,$01,$FF,$14,$18,$C6,$64,$06 ; Line 12 ;@COMP DEFB $06,$00,$32,$2A,$26,$33,$38,$00,$26,$33,$00,$34,$35,$39,$2E,$34,$33,$00,$26,$35,$35,$2A,$26,$37,$38,$00,$2E,$33,$00,$26,$00,$06 ; Line 13 DEFB $E2,$26,$33,$CA,$FF,$73,$38,$C1,$26,$00,$06 ; Line 13 ;@COMP DEFB $06,$00,$27,$31,$34,$28,$30,$00,$34,$33,$31,$3E,$00,$2E,$33,$00,$34,$33,$2A,$00,$37,$34,$3C,$1A,$00,$26,$33,$29,$00,$00,$00,$06 ; Line 14 DEFB $06,$D4,$E5,$2E,$33,$00,$CD,$FF,$06,$1A,$CB,$61,$06 ; Line 14 ;@COMP DEFB $06,$00,$28,$26,$33,$00,$27,$2A,$00,$37,$2A,$32,$34,$3B,$2A,$29,$00,$2B,$37,$34,$32,$00,$26,$00,$28,$2A,$31,$31,$00,$00,$00,$06 ; Line 15 DEFB $06,$EB,$FE,$3E,$C7,$61,$06 ; Line 15 ;@COMP DEFB $06,$00,$2E,$33,$00,$39,$2D,$2A,$00,$38,$26,$32,$2A,$00,$37,$34,$3C,$00,$34,$3A,$39,$38,$2E,$29,$2A,$00,$39,$2D,$2A,$00,$00,$06 ; Line 16 DEFB $F0,$C0,$38,$26,$32,$2A,$00,$C6,$34,$3A,$39,$38,$2E,$29,$2A,$00,$C0,$00,$06 ; Line 16 ;@COMP DEFB $06,$00,$27,$31,$34,$28,$30,$1B,$00,$39,$2D,$2E,$38,$00,$26,$31,$38,$34,$00,$26,$35,$35,$31,$2E,$2A,$38,$00,$2B,$34,$37,$00,$06 ; Line 17 DEFB $06,$FF,$14,$1B,$FE,$6B,$2B,$34,$37,$00,$06 ; Line 17 ;@COMP DEFB $06,$00,$27,$31,$34,$28,$30,$18,$28,$34,$31,$3A,$32,$33,$1A,$00,$37,$34,$3C,$18,$27,$31,$34,$28,$30,$00,$26,$33,$29,$00,$00,$06 ; Line 18 DEFB $06,$FF,$14,$18,$28,$34,$31,$3A,$32,$33,$1A,$00,$FF,$06,$FE,$52,$FD,$00,$06 ; Line 18 ;@COMP DEFB $06,$00,$28,$34,$31,$3A,$32,$33,$18,$27,$31,$34,$28,$30,$1B,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 19 DEFB $06,$FF,$10,$FF,$52,$1B,$6F,$06 ; Line 19 ;@COMP DEFB $06,$00,$33,$2A,$3D,$39,$0E,$00,$26,$29,$3B,$26,$33,$28,$2A,$29,$00,$2D,$2E,$33,$39,$38,$00,$1E,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 20 DEFB $FF,$23,$EA,$1E,$66,$06 ; Line 20 ;@COMP DEFB $06,$00,$35,$37,$2A,$3B,$0E,$00,$32,$34,$37,$2A,$00,$2D,$2E,$33,$39,$38,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 21 DEFB $DA,$FE,$41,$FF,$13,$38,$6C,$06 ; Line 21 ;@COMP DEFB $06,$00,$B8,$39,$26,$37,$39,$00,$B3,$2A,$3D,$39,$00,$B5,$37,$2A,$3B,$00,$B6,$3A,$2E,$39,$00,$BF,$00,$35,$37,$2E,$33,$39,$00,$06 ; Line 22 DEFB $FF,$24 ; Line 22 ;@COMP DEFB $06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06 ; Line 23 DEFB $5F,$06 ; Line 23 ; "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%" Line 0 ; "% ADVANCED HINTS: %" Line 1 ; "% %" Line 2 ; "% AFTER DOING ALL THE ABOVE %" Line 3 ; "% THE ZX81 THEN LOOKS FOR %" Line 4 ; "% OPTIONS THAT CAN BE REMOVED. %" Line 5 ; "% pencilled options: %" Line 6 ; "% PENCIL 1 NOT AVAILABLE %" Line 7 ; "% MEANS THE PENCILLED OPTION %" Line 8 ; "% IS NOT ACTUALLY AVAILABLE %" Line 9 ; "% AND CAN BE REMOVED. %" Line 10 ; "% intersections: %" Line 11 ; "% OPTION 1 IN BLOCK/ROW %" Line 12 ; "% MEANS AN OPTION APPEARS IN A %" Line 13 ; "% BLOCK ONLY IN ONE ROW, AND %" Line 14 ; "% CAN BE REMOVED FROM A CELL %" Line 15 ; "% IN THE SAME ROW OUTSIDE THE %" Line 16 ; "% BLOCK. THIS ALSO APPLIES FOR %" Line 17 ; "% BLOCK/COLUMN, ROW/BLOCK AND %" Line 18 ; "% COLUMN/BLOCK. %" Line 19 ; "% NEXT: ADVANCED HINTS 2 %" Line 20 ; "% PREV: MORE HINTS %" Line 21 ; "% sTART nEXT pREV qUIT z PRINT %" Line 22 ; "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%" Line 23 sInstructionScreen7: ; Column 00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 ;@COMP DEFB $06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06 ; Line 0 DEFB $5F,$06 ; Line 0 ;@COMP DEFB $06,$00,$26,$29,$3B,$26,$33,$28,$2A,$29,$00,$2D,$2E,$33,$39,$38,$00,$1E,$0E,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 1 DEFB $06,$EA,$1E,$0E,$6B,$06 ; Line 1 ;@COMP DEFB $06,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 2 DEFB $06,$7D,$06 ; Line 2 ;@COMP DEFB $06,$00,$A8,$B1,$B4,$B8,$AA,$A9,$00,$AC,$B7,$B4,$BA,$B5,$B8,$0E,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 3 DEFB $06,$00,$A8,$B1,$B4,$B8,$AA,$A9,$FF,$6D,$B8,$0E,$6E,$06 ; Line 3 ;@COMP DEFB $06,$00,$00,$00,$34,$35,$00,$1E,$00,$2E,$33,$00,$2C,$37,$35,$00,$1E,$1F,$20,$00,$2E,$33,$00,$37,$34,$3C,$00,$00,$00,$00,$00,$06 ; Line 4 DEFB $06,$62,$34,$35,$00,$1E,$C1,$2C,$37,$35,$00,$1E,$1F,$20,$C1,$C6,$63,$06 ; Line 4 ;@COMP DEFB $06,$00,$32,$2A,$26,$33,$38,$00,$39,$2D,$2A,$37,$2A,$00,$26,$37,$2A,$00,$1F,$00,$28,$2A,$31,$31,$38,$00,$2E,$33,$00,$00,$00,$06 ; Line 5 DEFB $E2,$F2,$DB,$1F,$EC,$2E,$33,$62,$06 ; Line 5 ;@COMP DEFB $06,$00,$39,$2D,$2A,$00,$37,$34,$3C,$00,$39,$2D,$26,$39,$00,$32,$3A,$38,$39,$00,$28,$34,$33,$39,$26,$2E,$33,$00,$39,$2D,$2A,$06 ; Line 6 DEFB $06,$00,$C0,$C6,$FF,$09,$FE,$68,$FF,$00,$06 ; Line 6 ;@COMP DEFB $06,$00,$1F,$00,$34,$35,$39,$2E,$34,$33,$38,$1A,$00,$38,$34,$00,$39,$2D,$2A,$00,$2C,$2E,$3B,$2A,$33,$00,$34,$35,$39,$1B,$00,$06 ; Line 7 DEFB $06,$00,$1F,$FF,$04,$1A,$EE,$C0,$FE,$78,$34,$35,$39,$1B,$00,$06 ; Line 7 ;@COMP DEFB $06,$00,$28,$26,$33,$00,$27,$2A,$00,$37,$2A,$32,$34,$3B,$2A,$29,$00,$2B,$37,$34,$32,$00,$26,$33,$34,$39,$2D,$2A,$37,$00,$00,$06 ; Line 8 DEFB $06,$EB,$FF,$3E,$33,$34,$FF,$00,$37,$61,$06 ; Line 8 ;@COMP DEFB $06,$00,$28,$2A,$31,$31,$00,$2E,$33,$00,$39,$2D,$26,$39,$00,$37,$34,$3C,$10,$18,$28,$34,$31,$18,$27,$31,$34,$28,$30,$11,$00,$06 ; Line 9 DEFB $06,$00,$C7,$2E,$33,$00,$C9,$FF,$06,$10,$18,$28,$34,$31,$FF,$52,$11,$00,$06 ; Line 9 ;@COMP DEFB $06,$00,$BD,$16,$BC,$AE,$B3,$AC,$B8,$0E,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 10 DEFB $06,$00,$BD,$16,$BC,$AE,$B3,$AC,$B8,$0E,$74,$06 ; Line 10 ;@COMP DEFB $06,$00,$00,$00,$1D,$00,$2E,$33,$00,$3D,$3C,$2C,$00,$1D,$1E,$1A,$1F,$20,$00,$2E,$33,$00,$37,$34,$3C,$00,$00,$00,$00,$00,$00,$06 ; Line 11 DEFB $06,$62,$1D,$C1,$FE,$5D,$1D,$1E,$1A,$1F,$20,$C1,$C6,$64,$06 ; Line 11 ;@COMP DEFB $06,$00,$32,$2A,$26,$33,$38,$00,$39,$2D,$26,$39,$00,$2E,$33,$00,$37,$34,$3C,$38,$00,$1D,$00,$26,$33,$29,$00,$1E,$1A,$00,$00,$06 ; Line 12 DEFB $E2,$C9,$2E,$33,$00,$FF,$06,$38,$00,$1D,$CB,$1E,$1A,$61,$06 ; Line 12 ;@COMP DEFB $06,$00,$34,$35,$39,$2E,$34,$33,$00,$1D,$00,$34,$33,$31,$3E,$00,$34,$28,$28,$3A,$37,$38,$00,$2E,$33,$00,$00,$00,$00,$00,$00,$06 ; Line 13 DEFB $06,$CA,$1D,$00,$E5,$34,$28,$28,$3A,$37,$38,$C1,$64,$06 ; Line 13 ;@COMP DEFB $06,$00,$28,$34,$31,$3A,$32,$33,$38,$00,$1F,$00,$26,$33,$29,$00,$20,$1A,$00,$3C,$2D,$2E,$28,$2D,$00,$32,$2A,$26,$33,$38,$00,$06 ; Line 14 DEFB $06,$FF,$10,$38,$00,$1F,$CB,$20,$1A,$00,$3C,$2D,$2E,$28,$2D,$00,$32,$2A,$26,$33,$FF,$26 ; Line 14 ;@COMP DEFB $06,$00,$39,$2D,$26,$39,$00,$34,$35,$39,$2E,$34,$33,$00,$1D,$00,$28,$26,$33,$00,$27,$2A,$00,$37,$2A,$32,$34,$3B,$2A,$29,$00,$06 ; Line 15 DEFB $06,$00,$FF,$09,$CA,$1D,$EB,$06 ; Line 15 ;@COMP DEFB $06,$00,$2B,$37,$34,$32,$00,$26,$33,$3E,$00,$28,$2A,$31,$31,$00,$2E,$33,$00,$34,$33,$2A,$00,$34,$2B,$00,$39,$2D,$2A,$00,$00,$06 ; Line 16 DEFB $06,$00,$FF,$3E,$33,$3E,$00,$C7,$2E,$33,$00,$CD,$34,$2B,$00,$C0,$00,$06 ; Line 16 ;@COMP DEFB $06,$00,$39,$3C,$34,$00,$28,$34,$31,$3A,$32,$33,$38,$1B,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 17 DEFB $06,$00,$39,$3C,$34,$FF,$10,$38,$1B,$70,$06 ; Line 17 ;@COMP DEFB $06,$00,$39,$2D,$2E,$38,$00,$26,$31,$38,$34,$00,$26,$35,$35,$31,$2E,$2A,$38,$00,$39,$34,$00,$28,$34,$31,$3A,$32,$33,$38,$00,$06 ; Line 18 DEFB $06,$FE,$6B,$39,$34,$FF,$10,$FF,$26 ; Line 18 ;@COMP DEFB $06,$00,$00,$00,$1E,$00,$2E,$33,$00,$3D,$3C,$2C,$00,$21,$22,$1A,$23,$24,$00,$2E,$33,$00,$28,$34,$31,$3A,$32,$33,$00,$00,$00,$06 ; Line 19 DEFB $06,$62,$1E,$C1,$FE,$5D,$21,$22,$1A,$23,$24,$FF,$01,$D0,$61,$06 ; Line 19 ;@COMP DEFB $06,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 20 DEFB $06,$7D,$06 ; Line 20 ;@COMP DEFB $06,$00,$35,$37,$2A,$3B,$0E,$00,$26,$29,$3B,$26,$33,$28,$2A,$29,$00,$2D,$2E,$33,$39,$38,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06 ; Line 21 DEFB $FF,$1A,$EA,$67,$06 ; Line 21 ;@COMP DEFB $06,$00,$B8,$39,$26,$37,$39,$00,$00,$00,$00,$00,$00,$B5,$37,$2A,$3B,$00,$B6,$3A,$2E,$39,$00,$BF,$00,$35,$37,$2E,$33,$39,$00,$06 ; Line 22 DEFB $FE,$51,$64,$B5,$37,$2A,$3B,$FF,$4C,$FA,$06 ; Line 22 ;@COMP DEFB $06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06,$06 ; Line 23 DEFB $5F,$06 ; Line 23 ; "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%" Line 0 ; "% ADVANCED HINTS 2: %" Line 1 ; "% %" Line 2 ; "% closed groups: %" Line 3 ; "% OP 2 IN GRP 234 IN ROW %" Line 4 ; "% MEANS THERE ARE 3 CELLS IN %" Line 5 ; "% THE ROW THAT MUST CONTAIN THE%" Line 6 ; "% 3 OPTIONS, SO THE GIVEN OPT. %" Line 7 ; "% CAN BE REMOVED FROM ANOTHER %" Line 8 ; "% CELL IN THAT ROW(/COL/BLOCK) %" Line 9 ; "% x-wings: %" Line 10 ; "% 1 IN XWG 12,34 IN ROW %" Line 11 ; "% MEANS THAT IN ROWS 1 AND 2, %" Line 12 ; "% OPTION 1 ONLY OCCURS IN %" Line 13 ; "% COLUMNS 3 AND 4, WHICH MEANS %" Line 14 ; "% THAT OPTION 1 CAN BE REMOVED %" Line 15 ; "% FROM ANY CELL IN ONE OF THE %" Line 16 ; "% TWO COLUMNS. %" Line 17 ; "% THIS ALSO APPLIES TO COLUMNS %" Line 18 ; "% 2 IN XWG 56,78 IN COLUMN %" Line 19 ; "% %" Line 20 ; "% PREV: ADVANCED HINTS %" Line 21 ; "% sTART pREV qUIT z PRINT %" Line 22 ; "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%" Line 23 sInstructionScreens: DEFW sInstructionScreen0 DEFW sInstructionScreen1 DEFW sInstructionScreen2 DEFW sInstructionScreen3 DEFW sInstructionScreen4 DEFW sInstructionScreen5 DEFW sInstructionScreen6 DEFW sInstructionScreen7 sInstructionNumScreens EQU ($-sInstructionScreens)/2 sDictionary: ;==================================== ; Dictionary for screen compression. ;==================================== ; Insert the compression dictionary here.: DEFB $04, $39,$2D,$2A ; entry 0 occurrences = 47 DEFB $04, $00,$2E,$33 ; entry 1 occurrences = 18 DEFB $04, $00,$39,$34 ; entry 2 occurrences = 18 DEFB $07, $00,$27,$34,$26,$37,$29 ; entry 3 occurrences = 17 DEFB $09, $00,$34,$35,$39,$2E,$34,$33,$38 ; entry 4 occurrences = 15 DEFB $04, $2E,$33,$2C ; entry 5 occurrences = 15 DEFB $04, $37,$34,$3C ; entry 6 occurrences = 15 DEFB $05, $28,$2A,$31,$31 ; entry 7 occurrences = 13 DEFB $06, $38,$34,$31,$3B,$2A ; entry 8 occurrences = 13 DEFB $05, $39,$2D,$26,$39 ; entry 9 occurrences = 13 DEFB $08, $00,$34,$35,$39,$2E,$34,$33 ; entry 10 occurrences = 12 DEFB $05, $00,$26,$33,$29 ; entry 11 occurrences = 11 DEFB $05, $00,$2B,$34,$37 ; entry 12 occurrences = 10 DEFB $04, $34,$33,$2A ; entry 13 occurrences = 10 DEFB $07, $35,$2A,$33,$28,$2E,$31 ; entry 14 occurrences = 10 DEFB $11, $00,$0E,$00,$0E,$00,$88,$00,$0E,$00,$0E,$00,$88,$00,$0E,$00,$0E ; entry 15 occurrences = 9 DEFB $08, $00,$28,$34,$31,$3A,$32,$33 ; entry 16 occurrences = 9 DEFB $05, $00,$3E,$34,$3A ; entry 17 occurrences = 9 DEFB $0F, $06,$00,$07,$07,$07,$88,$07,$07,$07,$88,$07,$07,$07,$05 ; entry 18 occurrences = 9 DEFB $05, $2D,$2E,$33,$39 ; entry 19 occurrences = 9 DEFB $07, $00,$27,$31,$34,$28,$30 ; entry 20 occurrences = 8 DEFB $06, $38,$2A,$39,$3A,$35 ; entry 21 occurrences = 8 DEFB $08, $88,$88,$88,$88,$88,$88,$05 ; entry 22 occurrences = 8 DEFB $08, $00,$33,$3A,$32,$27,$2A,$37 ; entry 23 occurrences = 7 DEFB $07, $00,$35,$37,$2A,$38,$38 ; entry 24 occurrences = 7 DEFB $08, $00,$35,$3A,$3F,$3F,$31,$2A ; entry 25 occurrences = 7 DEFB $08, $06,$00,$35,$37,$2A,$3B,$0E ; entry 26 occurrences = 7 DEFB $04, $26,$37,$2A ; entry 27 occurrences = 7 DEFB $08, $26,$39,$00,$37,$1A,$28,$0E ; entry 28 occurrences = 7 DEFB $05, $2B,$2E,$31,$31 ; entry 29 occurrences = 7 DEFB $05, $39,$2E,$34,$33 ; entry 30 occurrences = 7 DEFB $08, $3E,$34,$3A,$00,$28,$26,$33 ; entry 31 occurrences = 7 DEFB $0B, $00,$0E,$00,$0E,$00,$88,$00,$0E,$00,$0E ; entry 32 occurrences = 6 DEFB $0B, $00,$26,$3B,$26,$2E,$31,$26,$27,$31,$2A ; entry 33 occurrences = 6 DEFB $08, $06,$00,$32,$2A,$26,$33,$38 ; entry 34 occurrences = 6 DEFB $08, $06,$00,$33,$2A,$3D,$39,$0E ; entry 35 occurrences = 6 DEFB $21, $06,$00,$B8,$39,$26,$37,$39,$00,$B3,$2A,$3D,$39,$00,$B5,$37,$2A,$3B,$00,$B6,$3A,$2E,$39,$00,$BF,$00,$35,$37,$2E,$33,$39,$00,$06 ; entry 36 occurrences = 6 DEFB $05, $34,$33,$31,$3E ; entry 37 occurrences = 6 DEFB $04, $38,$00,$06 ; entry 38 occurrences = 6 DEFB $06, $3B,$26,$31,$2E,$29 ; entry 39 occurrences = 6 DEFB $16, $85,$88,$16,$15,$16,$15,$16,$88,$16,$15,$16,$15,$16,$88,$16,$15,$16,$15,$16,$88,$05 ; entry 40 occurrences = 6 DEFB $0F, $00,$00,$00,$07,$07,$07,$88,$07,$07,$07,$05,$00,$00,$06 ; entry 41 occurrences = 5 DEFB $10, $00,$26,$29,$3B,$26,$33,$28,$2A,$29,$00,$2D,$2E,$33,$39,$38 ; entry 42 occurrences = 5 DEFB $10, $00,$28,$26,$33,$00,$27,$2A,$00,$37,$2A,$32,$34,$3B,$2A,$29 ; entry 43 occurrences = 5 DEFB $07, $00,$28,$2A,$31,$31,$38 ; entry 44 occurrences = 5 DEFB $05, $00,$33,$34,$39 ; entry 45 occurrences = 5 DEFB $04, $00,$38,$34 ; entry 46 occurrences = 5 DEFB $04, $06,$00,$26 ; entry 47 occurrences = 5 DEFB $05, $06,$00,$2E,$33 ; entry 48 occurrences = 5 DEFB $05, $32,$34,$3B,$2A ; entry 49 occurrences = 5 DEFB $06, $39,$2D,$2A,$37,$2A ; entry 50 occurrences = 5 DEFB $06, $3A,$38,$2E,$33,$2C ; entry 51 occurrences = 5 DEFB $13, $00,$26,$00,$3A,$33,$2E,$36,$3A,$2A,$00,$38,$34,$31,$3A,$39,$2E,$34,$33 ; entry 52 occurrences = 4 DEFB $04, $00,$27,$3E ; entry 53 occurrences = 4 DEFB $06, $00,$2A,$26,$28,$2D ; entry 54 occurrences = 4 DEFB $05, $00,$2C,$26,$32 ; entry 55 occurrences = 4 DEFB $05, $00,$30,$2A,$3E ; entry 56 occurrences = 4 DEFB $06, $00,$38,$2D,$34,$3C ; entry 57 occurrences = 4 DEFB $09, $00,$BF,$00,$35,$37,$2E,$33,$39 ; entry 58 occurrences = 4 DEFB $04, $06,$00,$28 ; entry 59 occurrences = 4 DEFB $04, $26,$31,$31 ; entry 60 occurrences = 4 DEFB $04, $26,$33,$29 ; entry 61 occurrences = 4 DEFB $07, $2B,$37,$34,$32,$00,$26 ; entry 62 occurrences = 4 DEFB $04, $2D,$26,$38 ; entry 63 occurrences = 4 DEFB $04, $31,$2A,$29 ; entry 64 occurrences = 4 DEFB $05, $32,$34,$37,$2A ; entry 65 occurrences = 4 DEFB $06, $35,$31,$26,$28,$2A ; entry 66 occurrences = 4 DEFB $13, $00,$00,$00,$85,$88,$16,$15,$16,$15,$16,$88,$16,$15,$16,$15,$16,$88,$05 ; entry 67 occurrences = 3 DEFB $08, $00,$26,$28,$39,$3A,$26,$31 ; entry 68 occurrences = 3 DEFB $06, $00,$29,$34,$3C,$33 ; entry 69 occurrences = 3 DEFB $04, $00,$2E,$39 ; entry 70 occurrences = 3 DEFB $06, $00,$31,$2A,$2B,$39 ; entry 71 occurrences = 3 DEFB $11, $00,$32,$34,$3B,$2A,$00,$39,$2D,$2A,$00,$28,$3A,$37,$38,$34,$37 ; entry 72 occurrences = 3 DEFB $04, $00,$34,$2B ; entry 73 occurrences = 3 DEFB $09, $00,$35,$34,$38,$38,$2E,$27,$31 ; entry 74 occurrences = 3 DEFB $07, $00,$A8,$31,$2A,$26,$37 ; entry 75 occurrences = 3 DEFB $06, $00,$B6,$3A,$2E,$39 ; entry 76 occurrences = 3 DEFB $06, $00,$BA,$33,$29,$34 ; entry 77 occurrences = 3 DEFB $06, $06,$00,$26,$37,$2A ; entry 78 occurrences = 3 DEFB $08, $06,$00,$2E,$2B,$00,$3E,$34 ; entry 79 occurrences = 3 DEFB $0B, $06,$00,$39,$2D,$2A,$00,$3F,$3D,$24,$1D ; entry 80 occurrences = 3 DEFB $08, $06,$00,$B8,$39,$26,$37,$39 ; entry 81 occurrences = 3 DEFB $07, $18,$27,$31,$34,$28,$30 ; entry 82 occurrences = 3 DEFB $05, $1A,$00,$34,$37 ; entry 83 occurrences = 3 DEFB $04, $26,$30,$2A ; entry 84 occurrences = 3 DEFB $04, $2D,$2E,$38 ; entry 85 occurrences = 3 DEFB $04, $2E,$33,$39 ; entry 86 occurrences = 3 DEFB $05, $31,$34,$34,$30 ; entry 87 occurrences = 3 DEFB $0C, $32,$34,$3B,$2A,$38,$00,$31,$2A,$2B,$39,$0E ; entry 88 occurrences = 3 DEFB $04, $39,$2A,$37 ; entry 89 occurrences = 3 DEFB $06, $39,$34,$00,$38,$2A ; entry 90 occurrences = 3 DEFB $05, $3C,$2D,$2A,$33 ; entry 91 occurrences = 3 DEFB $05, $3C,$2E,$39,$2D ; entry 92 occurrences = 3 DEFB $04, $3D,$3C,$2C ; entry 93 occurrences = 3 DEFB $09, $AC,$2A,$33,$2A,$37,$26,$39,$2A ; entry 94 occurrences = 3 DEFB $0A, $AE,$38,$00,$3A,$33,$2E,$36,$3A,$2A ; entry 95 occurrences = 3 DEFB $0B, $B8,$39,$26,$37,$39,$00,$2C,$26,$32,$2A ; entry 96 occurrences = 3 DEFB $13, $00,$00,$00,$85,$88,$9D,$88,$9E,$88,$9F,$88,$A0,$88,$A1,$88,$A2,$88,$05 ; entry 97 occurrences = 2 DEFB $1F, $00,$00,$2D,$39,$39,$35,$0E,$18,$18,$3C,$3C,$3C,$1B,$3F,$3D,$24,$1D,$38,$39,$3A,$2B,$2B,$1B,$34,$37,$2C,$1B,$3A,$30,$18 ; entry 98 occurrences = 2 DEFB $20, $00,$10,$28,$11,$00,$38,$2E,$32,$34,$33,$00,$2D,$34,$31,$29,$38,$3C,$34,$37,$39,$2D,$00,$1E,$1C,$1C,$22,$1A,$1E,$1C,$1C,$23 ; entry 99 occurrences = 2 DEFB $07, $00,$26,$2C,$26,$2E,$33 ; entry 100 occurrences = 2 DEFB $08, $00,$28,$26,$33,$00,$27,$2A ; entry 101 occurrences = 2 DEFB $07, $00,$28,$2D,$2A,$28,$30 ; entry 102 occurrences = 2 DEFB $11, $00,$2E,$33,$00,$2B,$2E,$3D,$2A,$29,$00,$3B,$26,$31,$3A,$2A,$38 ; entry 103 occurrences = 2 DEFB $0E, $00,$32,$3A,$38,$39,$00,$28,$34,$33,$39,$26,$2E,$33 ; entry 104 occurrences = 2 DEFB $04, $00,$33,$34 ; entry 105 occurrences = 2 DEFB $08, $00,$38,$3A,$29,$34,$30,$3A ; entry 106 occurrences = 2 DEFB $13, $00,$39,$2D,$2E,$38,$00,$26,$31,$38,$34,$00,$26,$35,$35,$31,$2E,$2A,$38 ; entry 107 occurrences = 2 DEFB $14, $00,$3C,$2E,$39,$2D,$00,$33,$34,$00,$29,$3A,$35,$31,$2E,$28,$26,$39,$2A,$38 ; entry 108 occurrences = 2 DEFB $07, $00,$AC,$B7,$B4,$BA,$B5 ; entry 109 occurrences = 2 DEFB $06, $00,$B1,$34,$26,$29 ; entry 110 occurrences = 2 DEFB $12, $00,$BC,$AE,$B9,$AD,$00,$B4,$B3,$AA,$00,$B4,$B5,$B9,$AE,$B4,$B3,$0E ; entry 111 occurrences = 2 DEFB $06, $06,$00,$3A,$38,$2A ; entry 112 occurrences = 2 DEFB $06, $06,$00,$9D,$16,$A5 ; entry 113 occurrences = 2 DEFB $05, $26,$27,$31,$2A ; entry 114 occurrences = 2 DEFB $07, $26,$35,$35,$2A,$26,$37 ; entry 115 occurrences = 2 DEFB $07, $26,$37,$34,$3A,$33,$29 ; entry 116 occurrences = 2 DEFB $11, $29,$2E,$2B,$2B,$2E,$28,$3A,$31,$39,$3E,$00,$31,$2A,$3B,$2A,$31 ; entry 117 occurrences = 2 DEFB $06, $2A,$32,$35,$39,$3E ; entry 118 occurrences = 2 DEFB $04, $2C,$2A,$39 ; entry 119 occurrences = 2 DEFB $06, $2C,$2E,$3B,$2A,$33 ; entry 120 occurrences = 2 DEFB $05, $2D,$26,$3B,$2A ; entry 121 occurrences = 2 DEFB $05, $33,$2A,$3D,$39 ; entry 122 occurrences = 2 DEFB $04, $34,$B3,$2A ; entry 123 occurrences = 2 DEFB $04, $35,$00,$3D ; entry 124 occurrences = 2 DEFB $05, $38,$00,$34,$33 ; entry 125 occurrences = 2 DEFB $08, $38,$2A,$39,$00,$3B,$26,$31 ; entry 126 occurrences = 2 DEFB $06, $38,$39,$26,$37,$39 ; entry 127 occurrences = 2 DEFB $06, $38,$39,$37,$3A,$28 ; entry 128 occurrences = 2 DEFB $05, $39,$2E,$32,$2A ; entry 129 occurrences = 2 DEFB $0D, $3A,$00,$2C,$2A,$39,$00,$38,$39,$3A,$28,$30,$1A ; entry 130 occurrences = 2 DEFB $06, $3B,$26,$31,$3A,$2A ; entry 131 occurrences = 2 DEFB $04, $9D,$00,$16 ; entry 132 occurrences = 2 DEFB $08, $B5,$00,$37,$2E,$2C,$2D,$39 ; entry 133 occurrences = 2 DEFB $07, $B9,$AE,$B4,$B3,$B8,$0E ; entry 134 occurrences = 2 ;============================================================ ; Test code follows ;============================================================ ;; Validate coordinates in BC. ;TestValidateCoords: .MODULE TVC ; PUSH AF ; LD A,(vBoardSize) ; CP B ; JR C,_failed ; CP C ; JR C,_failed ; POP AF ; RET ;_failed PUSH HL ; PUSH DE ; PUSH BC ; LD HL,_sMessage ; CALL DisplayMessage ; CALL FlashMessage ; Flash the message line until key pressed ; POP BC ; POP DE ; POP HL ; POP AF ; RET ; ;_sMessage DEFB $2E,$33,$3B,$26,$31,$2E,$29,$00,$28,$34,$34,$37,$29,$2E,$33,$26,$39,$2A,$38,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00 ; ; "INVALID COORDINATES " ; ;; Validate board address in E. ;TestValidateBA: .MODULE TVBA ; PUSH AF ; LD A,(vBoardSizeSquared) ; CP E ; JR C,_failed ; POP AF ; RET ;_failed PUSH HL ; PUSH DE ; PUSH BC ; LD HL,_sMessage ; CALL DisplayMessage ; CALL FlashMessage ; Flash the message line until key pressed ; POP BC ; POP DE ; POP HL ; POP AF ; RET ; ;_sMessage DEFB $2E,$33,$3B,$26,$31,$2E,$29,$00,$27,$34,$26,$37,$29,$00,$26,$29,$29,$37,$2A,$38,$38,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00 ; ; "INVALID BOARD ADDRESS " ; ;; Dump board data to the screen. ; ;SetupGameDumpCountData: ; LD HL,vBlockOptionCounts ; Dump block option counts ; JP DumpBoardData ; ; RET merged with CALL ; ;SetupGameDumpOptions: ; XOR A ; Dump data for option 1 ; JP DumpOptionData ; ; RET merged with CALL ; ;; Address of data in HL ;; Assumes a boardSize * boardSize array of data ;DumpBoardData: .MODULE DBD ; LD DE,(D_FILE) ; Work out screen address ; EX DE,HL ; LD BC,1+(4*33)+2 ; Row 4, column 2 ; ADD HL,BC ; EX DE,HL ; LD A,(vBoardSize) ; LD B,A ; ;_loop1 LD A,(vBoardSize) ; LD C,A ; ;_loop2 LD A,(HL) ; ADD A,$1C ; Map from 1-9 to '1'-'9'; ; LD (DE),A ; Display digit ; INC DE ; XOR A ; LD (DE),A ; Display space ; INC DE ; INC HL ; DEC C ; JR NZ,_loop2 ; ; PUSH HL ; EX DE,HL ; LD DE,33*2-(9*2) ; Move to start of next line plus 1 ; ADD HL,DE ; EX DE,HL ; POP HL ; DJNZ _loop1 ; RET ; ;; Dump option data to the screen. ;; Could generalize this with the previous routine with start address, offset, increment values as input. ;; Option number in A ;DumpOptionData: .MODULE DOD ; LD HL,(D_FILE) ; Work out screen address ; LD BC,1+(4*33)+2 ; Row 4, column 2 ; ADD HL,BC ; EX DE,HL ; LD HL,vOptions ; LD C,A ; LD B,0 ; ADD HL,BC ; Get address of option in first cell ; LD A,(vBoardSize) ; LD B,A ; ;_loop1 LD A,(vBoardSize) ; LD C,A ; ;_loop2 LD A,(HL) ; AND PENCILLED_MASK ; Ignore pencil marks ; ADD A,$1C ; Map from 1-9 to '1'-'9'; ; LD (DE),A ; Display digit ; INC DE ; XOR A ; LD (DE),A ; Display space ; INC DE ; INC HL ; INC HL ; INC HL ; INC HL ; INC HL ; INC HL ; INC HL ; INC HL ; INC HL ; HL += 9 to get to next option address ; DEC C ; JR NZ,_loop2 ; ; PUSH HL ; EX DE,HL ; LD DE,33*2-(9*2) ; Move to start of next line plus 1 ; ADD HL,DE ; EX DE,HL ; POP HL ; DJNZ _loop1 ; RET ; =========================================================== ; That's it. End of user program ; =========================================================== DEFB $76 ; Newline Line1End: Line2: DEFB $00,$02 ; Line 2 DEFW Line2End-Line2Text Line2Text: DEFB $F9,$D4 ; RAND USR DEFB $1D,$22,$21,$1D,$20 ; 16514 DEFB $7E ; Number DEFB $8F,$01,$04,$00,$00 ; Numeric encoding DEFB $76 ; Newline Line2End: ; Display file. Set this up with a splash screen. Display: DEFB $76 ; Newline DEFB $07,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$84,$76 ; Line 0 DEFB $05,$06,$86,$85,$00,$05,$07,$86,$85,$03,$01,$07,$86,$00,$00,$00,$00,$00,$00,$00,$00,$00,$81,$05,$00,$00,$00,$00,$00,$00,$00,$85,$76 ; Line 1 DEFB $05,$86,$04,$85,$00,$05,$82,$06,$85,$83,$00,$82,$06,$00,$00,$00,$00,$00,$00,$00,$00,$85,$03,$00,$00,$00,$00,$00,$85,$05,$00,$85,$76 ; Line 2 DEFB $05,$04,$85,$85,$00,$05,$05,$00,$85,$00,$00,$05,$86,$00,$00,$00,$00,$00,$00,$00,$00,$80,$00,$00,$00,$00,$81,$05,$00,$82,$00,$85,$76 ; Line 3 DEFB $05,$02,$01,$00,$03,$00,$01,$00,$02,$03,$01,$01,$02,$00,$00,$83,$00,$00,$00,$00,$00,$80,$00,$87,$04,$02,$85,$05,$00,$80,$00,$85,$76 ; Line 4 DEFB $05,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$85,$07,$00,$00,$00,$00,$00,$85,$83,$05,$80,$00,$85,$05,$00,$80,$87,$85,$76 ; Line 5 DEFB $05,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$87,$07,$00,$00,$00,$00,$00,$00,$85,$07,$87,$07,$00,$00,$80,$87,$84,$07,$85,$76 ; Line 6 DEFB $05,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$85,$05,$00,$00,$87,$03,$80,$04,$85,$80,$84,$04,$00,$00,$84,$07,$00,$00,$85,$76 ; Line 7 DEFB $05,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$82,$00,$00,$07,$00,$02,$82,$00,$80,$00,$84,$04,$00,$00,$00,$04,$00,$85,$76 ; Line 8 DEFB $05,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$87,$80,$00,$00,$05,$00,$00,$80,$00,$85,$05,$00,$84,$04,$00,$85,$05,$00,$85,$76 ; Line 9 DEFB $05,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$87,$05,$85,$05,$00,$80,$00,$00,$07,$00,$02,$00,$00,$00,$03,$80,$07,$00,$00,$85,$76 ; Line 10 DEFB $05,$00,$00,$87,$04,$00,$00,$00,$00,$81,$04,$00,$81,$00,$02,$80,$00,$02,$82,$06,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$85,$76 ; Line 11 DEFB $05,$00,$85,$03,$80,$00,$87,$81,$00,$85,$05,$00,$80,$00,$00,$84,$05,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$85,$76 ; Line 12 DEFB $05,$00,$05,$00,$85,$05,$06,$84,$04,$85,$05,$00,$84,$04,$83,$07,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$85,$76 ; Line 13 DEFB $05,$00,$82,$00,$00,$00,$00,$85,$05,$85,$05,$87,$00,$03,$01,$00,$00,$00,$08,$08,$08,$08,$04,$00,$00,$00,$08,$08,$04,$00,$00,$85,$76 ; Line 14 DEFB $05,$00,$84,$82,$83,$00,$00,$85,$05,$06,$80,$01,$00,$00,$00,$00,$00,$08,$07,$03,$03,$03,$08,$04,$00,$08,$07,$08,$05,$00,$00,$85,$76 ; Line 15 DEFB $05,$00,$00,$02,$84,$82,$00,$85,$80,$01,$00,$00,$00,$00,$00,$00,$00,$02,$08,$08,$08,$08,$07,$01,$00,$02,$01,$08,$05,$00,$00,$85,$76 ; Line 16 DEFB $05,$00,$00,$00,$00,$84,$05,$00,$01,$00,$00,$00,$00,$00,$00,$00,$00,$08,$07,$03,$03,$03,$08,$04,$00,$00,$00,$08,$05,$00,$00,$85,$76 ; Line 17 DEFB $05,$00,$00,$00,$00,$81,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$08,$05,$00,$00,$00,$08,$05,$00,$00,$00,$08,$05,$00,$00,$85,$76 ; Line 18 DEFB $05,$00,$80,$04,$87,$01,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$02,$08,$08,$08,$08,$07,$01,$00,$08,$08,$08,$08,$08,$04,$85,$76 ; Line 19 DEFB $05,$00,$02,$03,$01,$00,$00,$00,$3B,$1E,$1B,$1C,$2C,$00,$00,$00,$00,$00,$02,$03,$03,$03,$01,$00,$00,$02,$03,$03,$03,$03,$01,$85,$76 ; Line 20 DEFB $07,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$84,$76 ; Line 21 DEFB $05,$00,$00,$00,$00,$00,$00,$00,$00,$35,$37,$2A,$38,$38,$00,$26,$33,$3E,$00,$30,$2A,$3E,$00,$00,$00,$00,$00,$00,$00,$00,$00,$85,$76 ; Line 22 DEFB $82,$83,$83,$83,$83,$83,$83,$83,$83,$83,$83,$83,$83,$83,$83,$83,$83,$83,$83,$83,$83,$83,$83,$83,$83,$83,$83,$83,$83,$83,$83,$81,$76 ; Line 23 ; Variables area (empty) Variables: VariablesEnd: DEFB $80 BasicEnd: #END