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