\ A minesweeper clone for the terminal
10 constant nmines
10 constant field-width
10 constant field-height
field-width field-height * constant nplaces

42 constant mine
48 constant empty
256 constant hidden

create mfield nplaces cells allot

variable cursorx
variable cursory
variable digs-left

variable rstate
utime drop 65521 mod rstate !

: rand0 \ -- rn
	rstate @ 33285 * 65521 mod dup rstate !
;

: nr-place	\ -- rn
	rand0 nplaces mod
;

: not	invert ;

: empty-field	\ --
	empty hidden or
	nplaces 0 do
		dup mfield i cells + !
	loop
	drop
;

: put-mine \ np --
	mine hidden or mfield rot cells + ! ;

: vrange \ n nmax -- mnax1 nmin1
	dup 2 + field-height  min
	swap 1- 0 max
;

: hrange \ n nmax -- mnax1 nmin1
	dup 2 + field-width  min
	swap 1- 0 max
;

: mark-mine \ nplace --
	dup field-width /
	vrange do
		dup field-width mod
		hrange do
			mfield j field-width * i + cells + dup @
			hidden not and mine =
			not if 1 swap +! else drop then
		loop
	loop
	drop
;

: check-mine \ np -- f
	 cells mfield + @ hidden not and mine =
;

: mine-field \ --
	empty-field
	nmines
    begin
	nr-place dup
	check-mine
        if   drop
        else dup put-mine mark-mine 1-
        then
	dup 0=
    until
    drop
    nplaces nmines - digs-left !
;

: field-header \ --
	page 2 spaces
	field-width 0
	do space i 10 mod 48 + emit
	loop
	cr
;

: first-col \ i --
       dup field-width mod 0=
       if field-width / 10 mod .
       else drop
       then
;

: space-cursor \ i --
        field-width /mod
        cursory @ = if
        dup cursorx @ = if ." (" else
        dup cursorx @ 1+ = if ." )" else
        space
        then then drop
        else space drop
        then
;

: cr-cursor \ i --
	field-width /mod
	        cursory @ = swap
	        cursorx @ = and
	        if ." )"
            then
            cr
;

: end-line \ i --
         dup 1+ field-width mod 0 =
         if cr-cursor
         else drop
         then
;

: show-field \ freveal --
	   field-header
	   nplaces 0 do
			i first-col
	   		i space-cursor
	   		mfield i cells + @
            over if hidden not and emit
            else dup hidden and
            	if drop ." ." else emit then
            then
            i end-line
 	   loop
       drop
;

: field-adr \ nx ny -- af
		field-width * + cells mfield + ;

: current-adr \ -- af
	cursorx @ cursory @ field-adr ;

: dig \ --
	current-adr @ dup
	hidden and
	if
		hidden not and current-adr !
		-1 digs-left +!
	else	drop
	then
;

: move-up	\ --
	cursory @ 1- 0 max cursory ! ;

: move-left	\ --
	cursorx @ 1- 0 max cursorx ! ;

: move-down	\ --
	cursory @ 1+ field-height 1- min cursory ! ;

: move-right	\ --
	cursorx @ 1+ field-width 1- min cursorx ! ;

: on-mine? \ -- f
    current-adr @ mine = ;

: play	\ --
	." Press any key!"
	key rstate !
	mine-field
	field-width  1- 2 / cursorx !
	field-height 1- 2 / cursory !
	begin
		false show-field
		."   " digs-left @ . ."  places left to dig" cr
		." Use H(left),J(down), K(up), L(right) to move,"
		." D to dig and Q to quit."
		false
		key dup emit
		dup [char] k = if move-up  else
		dup [char] h = if move-left else
		dup [char] j = if move-down else
		dup [char] l = if move-right else
		dup [char] d = if dig else
		dup [char] q = if nip true swap then
		then then then then then drop

		on-mine?
		if	true show-field ." You lose!" cr
			drop true
		else
			digs-left @ 0 =
			if true show-field ." You win!" cr drop true
			then
		then
	until
;

play