import text.jrt
import random.jrt

30 const maxw 16 const maxh
array board maxw maxh * allot

10 var, boardw 
10 var, boardh
15 var, minecount

: board-lim boardw @ boardh @ * board + ;
: square-at ( x y -- p ) boardw @ * + board + ;
: square-pos ( p -- x y ) board - boardw @ /mod swap ;

: valid-pos? ( x y -- f ) 
  dup 0 >= swap boardh @ < and 
  swap dup 0 >= swap boardw @ < and and ;

0x80 const FMINE
0x40 const FREVEALED
0x20 const FFLAG
0x0F const NEIGHBOUR-MASK

: place-mine ( x y -- f )
  square-at dup b@ FMINE & not if FMINE swap b! 0 then not ;
: rand-mine ( -- )
  begin rand boardw @ % rand boardh @ % place-mine until ;

: reset-board
  board begin dup board-lim < while 0 over b! 1+ repeat drop ;
: populate-board
  minecount @ begin rand-mine 1- dup not until drop ;
: mine-at? ( x y -- f ) 
  square-at b@ FMINE & ;

: do-at ( x y cp -- )
  >rot 2dup valid-pos? if <rot execute else drop drop drop then ;
: do-at-neighbours ( x y cp -- )
  >r over 1- over 1- r@ do-at
     over 1- over    r@ do-at
     over 1- over 1+ r@ do-at
     over    over 1- r@ do-at
     over    over 1+ r@ do-at
     over 1+ over 1- r@ do-at
     over 1+ over    r@ do-at
     swap 1+ swap 1+ <r do-at ;

0 var, curr-mine-count
: count-mine-at ( x y -- ) 
  mine-at? if curr-mine-count @ 1+ curr-mine-count ! then ;
: analyze-pos ( x y -- n )
  0 curr-mine-count ! ' count-mine-at do-at-neighbours curr-mine-count @ ;
: analyze-board
  board begin dup board-lim < while 
    dup square-pos analyze-pos over b@ | over b! 1+ repeat drop ;

: init-board ( w h minecount -- )
  minecount ! boardh ! boardw !
  reset-board populate-board analyze-board ;

: draw-neighbours ( b -- )
  NEIGHBOUR-MASK & [ key 0 lit ] + draw-char ;
: draw-flag ( -- ) [ key ! lit ] draw-char ;
: draw-mine ( -- ) 0x0f draw-char ;
: draw-block ( -- ) 0xb1 draw-char ;
: draw-revealed ( b -- )
  dup FMINE & if draw-mine drop else draw-neighbours then ;
: draw-hidden ( b -- )
  FFLAG & if draw-flag else draw-block then ;
: draw-square ( p -- )
  b@ dup FREVEALED & if draw-revealed else draw-hidden then ;

: pos>screen ( x y -- x y )
  swap pagew boardw @ - 2/ +
  swap pageh boardh @ - 2/ + ;

: draw-board ( -- )
  board begin dup board-lim < while 
    dup square-pos pos>screen textxy!
    dup draw-square 1+ repeat drop ;

0 var, reveal-state
: reveal ( p -- ) dup b@ FREVEALED | swap b! ;
: reveal-square? ( x y -- ) 
  square-at b@ FREVEALED = if -1 reveal-state ! then ;
: reveal-pass ( -- f )
  0 reveal-state !
  board begin dup board-lim < while
    dup b@ FREVEALED & not if
      0 reveal-state b!
      dup square-pos ' reveal-square? do-at-neighbours 
      reveal-state b@ if dup reveal then then
    1+ repeat drop reveal-state @ ;

: reveal-all begin reveal-pass not until ;
: reveal-at square-at reveal ( reveal-all ) draw-board ;

: start
  textmode
  reseed!
  15 10 15 init-board
  draw-board ;