parent
079d9d2fe9
commit
23c9956080
1 changed files with 203 additions and 0 deletions
@ -0,0 +1,203 @@ |
||||
\ 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 |
Loading…
Reference in new issue