require Puzzle.fs

SugakuPuzzle new Constant sPuzzle \ stores puzzle data
sPuzzle init

variable curX \ cursor X pos
variable curY \ cursor Y pos
0 curX !
0 curY !

: intToChar ( n - c )
\ converts an integer into its corresponding emittable char representation
48 +
;

: toScreenCoord ( nx ny -- nx ny )
\ converts logical to screen coordinates
4 * swap 4 * swap
;

: drawBorder ( nx ny -- )
\ draws the border of a game cell
toScreenCoord
2dup at-xy 9556 xEmit
2dup 1+ at-xy 9553 xEmit
2dup 2 + at-xy 9562 xEmit
2dup swap 1+ swap at-xy 9552 xEmit
2dup swap 2 + swap at-xy 9559 xEmit
2dup swap 2 + swap 1+ at-xy 9553 xEmit
2dup swap 2 + swap 2 + at-xy 9565 xEmit
swap 1+ swap 2 + at-xy 9552 xEmit
;

: drawContent ( nx ny nc -- )
\ draws the content of a game cell
-rot toScreenCoord
1+ swap 1+ swap at-xy emit
;

\ set different styles based on field status
: setDefaultStyle ( -- ) 27 emit ." [0m" ;
: setHintColor ( -- ) 27 emit ." [34m";
: setCursorBackground ( -- ) 27 emit ." [1;43m";
: setMineColor ( -- ) 27 emit ." [1;31m";
: setFlagColor ( -- ) 27 emit ." [1;33m";
: setUncoverColor ( -- ) 27 emit ." [1;32m";

: determineContent ( f s - c )
\ determine content based on field status and flag indicator
case
   stat-none of drop bl endof
   stat-flagged of drop setFlagColor [ char X ] literal endof
   stat-uncovered of dup f-mine = if 
                                    drop setMineColor [ char M ] literal 
                                  else setUncoverColor intToChar endif endof
endCase
;

: setCursorColor ( nx ny -- )
\ sets the cursor color if the coordinates match
curY @ = swap
curX @ = and
if
   setCursorBackground
endif
;

: getCellContent ( nx ny -- c )
\ queries the puzzle object for the content of a cell
\ also sets the correct painting style as a side-effect
 2dup
sPuzzle getField
-rot
sPuzzle getStatus
determineContent
;

: drawGameCell ( nx ny -- )
\ draws a specific game cell
2dup
setCursorColor
2dup
getCellContent >r
1+ swap 1+ swap \ offset x and y by for painting
2dup r>
drawContent
drawBorder
setDefaultStyle \ previous operations changed painting style
;

: drawXHint ( nx -- )
\ draws the hints on the X-axis
dup sPuzzle getDescX >r
1+ 0      \ offset x by 1, set y to zero
2dup r> intToChar
drawContent
drawBorder
;

: drawYHint ( ny -- )
\ draws the hints on the Y-axis
dup sPuzzle getDescY >r
1+ 0 swap     \ offset y by 1, set x to zero
2dup r> intToChar
drawContent
drawBorder
;

: redraw ( -- )
\ re-draws the whole game area
setHintColor
puzzle-size 0 u+do
   i drawXHint
   i drawYHint
loop

setDefaultStyle
puzzle-size 0 u+do
   puzzle-size 0 u+do
      i j drawGameCell
   loop
loop
;

\ state modifiers
: moveYup curY @ 0 > if curY @ 1- curY ! endif ;
: moveYdown curY @ puzzle-size 1- < if curY @ 1+ curY ! endif ;
: moveXleft curX @ 0 > if curX @ 1- curX ! endif ;
: moveXright curX @ puzzle-size 1- < if curX @ 1+ curX ! endif ;
: uncover curX @ curY @ sPuzzle uncover ;
: flag curX @ curY @ sPuzzle flag ;
: stop cr bye ;
: empty ;

: readUserInput ( -- xt )
\ converts user input into an action to execute
ekey ekey>char if
   case
      27 of ['] stop endof
      bl of ['] uncover endof
      '0' of ['] flag endof
      ['] empty swap
   endCase
else ekey>fkey if
   case
      k-up of ['] moveYup endof
      k-down of ['] moveYDown endof
      k-left of ['] moveXleft endof
      k-right of ['] moveXright endof
      ['] empty swap
   endCase
else
   drop \ unknown key event
   ['] empty
endif endif
;

: checkGameOverState ( -- f )
\ check if game is over
sPuzzle isGameOver
case
   game-running of True endof
   game-won of cr cr s" You won!" type cr False endof
   game-lost of cr cr s" You lost!" type cr False endof
endCase
;

: gameLoop ( -- )
\ "feedback" loop that performs the game steps
begin
   redraw
   readUserInput
   checkGameOverState
while
   execute
repeat
;

\ main entry point
page
gameLoop

\ program ends here - paint newline and end interpretation with bye
cr
bye