You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
203 lines
3.4 KiB
203 lines
3.4 KiB
\ 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
|
|
|