From 23c9956080bc3b4e0ea8a518e41330cfd5531156 Mon Sep 17 00:00:00 2001
From: mian <mian@firemail.cc>
Date: Mon, 26 Sep 2022 11:36:15 +0000
Subject: [PATCH] Upload files to ''

---
 minesweeper.fs | 203 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 203 insertions(+)
 create mode 100644 minesweeper.fs

diff --git a/minesweeper.fs b/minesweeper.fs
new file mode 100644
index 0000000..ba767de
--- /dev/null
+++ b/minesweeper.fs
@@ -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