require random.fs require minOO.fs object class cell var puzzle cell var status cell var fields-uncovered cell var mines-uncovered cell var descX cell var descY ( o -- ) method init ( nx ny o -- n ) method getField ( nx ny o -- n ) method getStatus ( nx ny o -- ) method uncover ( nx ny o -- ) method flag ( nx o -- n ) method getDescX ( ny o -- n ) method getDescY ( o -- n ) method isGameOver ( gameOver: 0 = game running, 1 = game won, 2 = game lost ) ( field: 0-8, 9 = mine ) ( status: 0 = none, 1 = flagged, 2 = uncovered ) end-class SugakuPuzzle \ definitions for game state 0 Constant game-running 1 Constant game-won 2 Constant game-lost \ definitions for status 0 Constant stat-none 1 Constant stat-flagged 2 Constant stat-uncovered \ definitions for fields 9 Constant f-mine \ definitions for puzzle 7 Constant puzzle-size 12 Constant puzzle-mines 3 Constant puzzle-uncovered \ random numbers here seed ! \ helper 3dup : 3dup ( x y z -- x y z x y z ) dup 2over rot ; \ helper function for calculating the number in a field : getNum { cur i -- n } 8 \ left i puzzle-size mod 0 = IF 3 - ELSE cur puzzle-size 1 + cells - @ f-mine = IF 1 - ENDIF cur 1 cells - @ f-mine = IF 1 - ENDIF cur puzzle-size 1 - cells + @ f-mine = IF 1 - ENDIF ENDIF \ middle top + bottom cur puzzle-size cells - @ f-mine = IF 1 - ENDIF cur puzzle-size cells + @ f-mine = IF 1 - ENDIF \ right i puzzle-size mod puzzle-size 1 - = IF 3 - ELSE cur puzzle-size 1 - cells - @ f-mine = IF 1 - ENDIF cur 1 cells + @ f-mine = IF 1 - ENDIF cur puzzle-size 1 + cells + @ f-mine = IF 1 - ENDIF ENDIF ; \ helper setStatus : setStatus ( status o nx ny -- ) puzzle-size * + 1 cells * swap puzzle @ + 1 + c! ; \ helper initUncover : initUncover ( addr n -- ) 0 u+do dup puzzle-size puzzle-size * random 1 cells * + dup c@ 9 <> IF 1 + stat-uncovered swap c! ELSE drop r> 1 - >r ENDIF loop drop ; \ define init :noname ( o -- ) \ reserve puzzle variable dup puzzle here puzzle-size puzzle-size * puzzle-size 2 * 2 + + cells allot swap ! \ set puzzle 0 dup puzzle @ puzzle-size puzzle-size * puzzle-size 2 * 2 + + 0 u+do dup \ make the padding fields mines i puzzle-size 1 + < i puzzle-size puzzle-size * puzzle-size 1 + + >= or IF 9 swap ! ELSE 0 swap ! ENDIF 1 cells + loop drop \ increase puzzle offset by puzzle-size+1 cells dup puzzle dup @ puzzle-size 1 + cells + swap ! \ set mines dup puzzle @ puzzle-mines 0 u+do dup BEGIN puzzle-size random puzzle-size * puzzle-size random + cells + dup @ WHILE drop dup REPEAT f-mine swap ! loop drop \ set numbers dup puzzle @ dup puzzle-size puzzle-size * 0 u+do dup @ 0 = IF dup i getNum over ! ENDIF 1 cells + loop 2drop \ create descriptions dup descX here puzzle-size cells allot swap ! dup descY here puzzle-size cells allot swap ! dup descX @ over descY @ puzzle-size 2 * 0 u+do dup puzzle-size swap ! 1 cells + swap loop 2drop dup puzzle @ puzzle-size puzzle-size * 0 u+do dup @ 9 = IF over descX @ i 7 mod cells + dup @ 1 - swap ! over descY @ i 7 / cells + dup @ 1 - swap ! ENDIF 1 cells + loop drop \ set status to 0 dup 0 swap status ! \ set mines-uncovered to 0 dup 0 swap mines-uncovered ! \ set fields-uncovered to 0 dup 0 swap mines-uncovered ! puzzle @ puzzle-uncovered initUncover ; SugakuPuzzle defines init \ define getField :noname ( nx ny o -- n ) puzzle @ -rot puzzle-size * + cells + c@ ; SugakuPuzzle defines getField \ define getStatus :noname ( nx ny o -- n ) puzzle @ -rot puzzle-size * + cells + 1 + c@ ; SugakuPuzzle defines getStatus \ define getDescX :noname ( nx o -- n ) descX @ swap cells + @ ; SugakuPuzzle defines getDescX \ define getDescY :noname ( ny o -- n ) descY @ swap cells + @ ; SugakuPuzzle defines getDescY \ define flag :noname { nx ny o -- } \ check and set field status nx ny o getStatus CASE stat-none OF stat-flagged o nx ny setStatus ENDOF stat-flagged OF stat-none o nx ny setStatus ENDOF ENDCASE ; SugakuPuzzle defines flag \ define uncover :noname { nx ny o -- } \ check and set field status nx ny o getStatus stat-none = IF stat-uncovered o nx ny setStatus \ check if mine nx ny o getField 9 = IF \ if field is mine o mines-uncovered @ 0 = IF \ if mines-uncovered == 0 1 o mines-uncovered ! ELSE game-lost o status ! \ game is lost ENDIF ELSE o fields-uncovered @ 1 + o fields-uncovered ! \ increase fields-uncovered ENDIF ENDIF \ check if game is won o fields-uncovered @ puzzle-size puzzle-size * puzzle-mines - puzzle-uncovered - = IF game-won o status ! ENDIF ; SugakuPuzzle defines uncover :noname ( o -- f ) status @ ; SugakuPuzzle defines isGameOver