From 133c2e370ae519670251a8b2236bc633431a166f Mon Sep 17 00:00:00 2001
From: Jeremy Penner <jeremy@sporktania.com>
Date: Sat, 23 Sep 2023 11:51:42 -0400
Subject: [PATCH] better board drawing, more minesweeper

---
 mines.com | Bin 0 -> 3521 bytes
 mines.jrt |  49 +++++++++++++++++++++++++++++++++++++++----------
 text.jrt  |   7 +++++++
 3 files changed, 46 insertions(+), 10 deletions(-)
 create mode 100755 mines.com

diff --git a/mines.com b/mines.com
new file mode 100755
index 0000000000000000000000000000000000000000..59d1e21d6cee7210de325dcddca649c2796e7085
GIT binary patch
literal 3521
zcmeHJjc-&{7Juj7_c6SAZ;BXW!~_ee)3LCoXj_&|O2{;2*Bz^+tY*q!H`x%a5<-^L
zF<TWzXf{ko%LaC3vlBm}Mq_3>>9T_zSc=6~R7#}<kuDOa%I?CTBxH%uRob`b-1}Z>
z`4cuvIk~^{yXV|{?z!ilH^maJfdQ%bloP-1#J}HuNgvv|O4+%JCFAP$5B0!Zhd9KX
z^13=_S$A^4DGvetDM|=HsjFM#a<xzk$+%KqUssp>QgAV7Xh_8sfoq|zE_IhvK5dg)
z=DBWz?nYsg0x|4@?njeH1bhXW&*|L)cDvNuuot3&IRMc{={N|{*qX*QQW-_1dG(q`
z{4dPDLcLK2`7I>R)i}>E!T*Qs&`c;gLj_%gax2R{*rN<Dyp!RnOBv>(zFtf$VGRwA
zd!QdPCq5<EFtP$fSZdW&s^xmJWh%Mqx}aKcT^N&rJjJ3bC2C`_=shl*V9}pRwiDTF
z-$?v2;-x39{m|GXSBBrS9%zOLjs+m(IEv!b?2|`vYI-FYX3;tQZRd-ZoYT1R^0BtF
z#jl;O2@X6rT0HGs5^(F0;xT6eA=(bk`J%1Am~#w{>R8*p;=4`+PO%|In|<Ss<6^8p
zlZ9^7HNsrR8b-X-<sahB(UaqnUrYFc#E<jns7wDEq02tUV{S?Pmd84cKT6wOge(6c
zmDjit3%W)b!qaB^d2FX4vNOPA(H#<gN+vFS25~g#PMk*@ZX~5u2$&Lq^_<T5Z@!N8
zB6<Se4Mad!Z^4rvveZCSQ|5M!98{oBkrjN8n&-;!T(M&<RzFDu@^HV}%M)NJ5AtP*
znqjpX&1tUPV`}G$YBk5!y81@7IR`F|Kmv^529<(9q!X%z5`0ziWl@kJ;3z7JhN7bw
zC_a=qC?<*@#X_-B0w^UIQ%Y^eh%PH3Ud2-)CfY&82;~g!F+CH4M)bM^MalcMXqRqi
zoxzvX)QaWm{t@F!X8O1hSfsV{O?*<#h}!V9H-%QEO{zQCI<}rK(kKZLAU&wv%*@oQ
zv{pt|o=>NiywWl=0KTG3`?IgVP0bXqIg2r(Boc0K>75-bnP#@@Wtw~kr?hDEx%oG*
zHTo3<%Cym<d#dlXV`x=+vsLDWk6u+CczVLya7G5obV@8>`sjqqA;cv!B@$Yu%acnE
zFAuZj*{ydiCudpap+;}f$wvC%MGFs4t3t1tYyN=q9uv~jFsLVBSjoc2I1Vbb&O^wa
zLG1vtU*h;z!RGXn8qFTnC&ZZ3_qjTaayKkAd<h+#m`$J<XHI?o361aPd;dmb|7RyZ
zrt$BG`VP{V+xOmn8V8Pibd1Ks$48FR_`&FjAsRm%JN;<{f?5IQ83`=q&1_tsZ^X5*
z*m==3S7A_OR80#+y=-A&Ee{v;3PzQ5L1ZVWEnsqu0zSAjj2K(kQ9Q#%EbCI`q((Td
z)u3k<vPKU!$d#fhw_!H^WxQ@=;exSE>_h%*jRN{nL>FPq*o=HF-l@-*(p6t_VDyX1
zvpdd@6e=ew2b0LiHWc(N?H``+HRCcL^U=M8U;#dyxuO*)|Nr+toPk<wwo<6UmYMB5
zgtCK$ed|P}5kvjY)5E^aj5zvSQ+?;58cKNq$ZMQkMb=};ikPdoP6!fMPb*PMQD~>I
znTHPEX@>X^OGD1=Gz)N;SA+aM>pt?%Fx^M%X4s$1G#oH#zpyV4mF775d}~(2Mf7Q9
zS@_(PKO&Z(b>7^<^0-bKuDWd4lsl2X%07T!;c7wuHMj#km-y*bN$&;tZng-iVe|YF
z-$1QQV&XmIaji4F2-AE4S}_}~tO7B;MEa=e{xrPdf6?ELQNQSy9k3b*CE$1dd&SJ`
zQ=awbp~-v;qv^m;n|I!W7&X}~F?;d8dU+Yj3G=d<7dw^AF;&pH;)}q`nBY8I^-}{p
zu2PFxXeFRhS%*h2w|YdIkuCEz^|+dVy^7R!3aw<8_7_*n16^Ahp0t+Z3R&1-fknaW
z672KVVk-+<t)B|619$Hd{2#1Gkl$l%w1#kPvM=DLl&*O*+k_3e0HD!jOO58`?0QTU
zak9Ni8;|>iXt{B%PwX|%pw%wxbp2`2?4M(M{LY$>ZS$XEe$lM?yX`Q}-)2`#&;MlB
ze7)U-^VRl!)AJL09$v5}^j2KI2}_GgY_%=drZZ*Kb84S8YF)Czz6P6YsL)=re`IIj
zS-S^p+baVq{VuZ#pUq+MS)>B(GEd=peRcwW0q?fG(jauB<at1P%11M4SHo`mFlM;P
zOu#$#z5d;H2j0sh?!CvRXYmQ{y4!9S4gJP%FIkG!GoI4JVqJN!1#w@Rc$N<YyduuR
z!hk&SV}X*u?Ex8|d{$|AI&iDtvhYmc&H&xr`!;3gS%K-P@3DUq_+{Wp%z*dwce&@6
UT)A55OJHM2U^}95+)w;}0WX4_#sB~S

literal 0
HcmV?d00001

diff --git a/mines.jrt b/mines.jrt
index bf3f822..4e5ab58 100755
--- a/mines.jrt
+++ b/mines.jrt
@@ -58,26 +58,39 @@ array board maxw maxh * allot
   minecount ! boardh ! boardw !
   reset-board populate-board analyze-board ;
 
+array countcolors white b, lblue b, lgreen b, red b, blue b, 
+  brown b, cyan b, black b, gray b,
+
 : draw-neighbours ( b -- )
-  NEIGHBOUR-MASK & [ key 0 lit ] + draw-char ;
-: draw-flag ( -- ) [ key ! lit ] draw-char ;
-: draw-mine ( -- ) 0x0f draw-char ;
-: draw-block ( -- ) 0xb1 draw-char ;
+  NEIGHBOUR-MASK & dup countcolors + b@ fg! 
+  dup if [ key 0 lit ] + else drop [ key   lit ] then draw-char ;
+: draw-flag ( -- ) red fg! 0xb2 draw-char ;
+: draw-mine ( -- ) black fg! 0x0f draw-char ;
+: draw-block ( -- ) black fg! 0xb1 draw-char ;
 : draw-revealed ( b -- )
   dup FMINE & if draw-mine drop else draw-neighbours then ;
 : draw-hidden ( b -- )
   FFLAG & if draw-flag else draw-block then ;
 : draw-square ( p -- )
-  b@ dup FREVEALED & if draw-revealed else draw-hidden then ;
+  b@ dup FREVEALED & if draw-revealed else draw-hidden then white fg! ;
 
 : pos>screen ( x y -- x y )
   swap pagew boardw @ - 2/ +
   swap pageh boardh @ - 2/ + ;
 
+: boardx! ( -- ) pagew boardw @ 2* 1+ - 2/ textx! ;
+: boardy! ( -- ) pageh boardh @ 2* 1+ - 2/ texty! ;
+: next-row ( -- ) nextline boardx! ;
+
+: draw-board-top tl boardw @ begin .- 1- dup while dT repeat tr drop next-row ;
+: draw-board-bottom bl boardw @ begin .- 1- dup while uT repeat br drop next-row ;
+: draw-rowborder rT boardw @ begin .- 1- dup while .+ repeat lT drop next-row ;
+: draw-row ( p -- p )
+  .| begin dup draw-square .| 1+ dup square-pos drop not until next-row ;
 : draw-board ( -- )
-  board begin dup board-lim < while 
-    dup square-pos pos>screen textxy!
-    dup draw-square 1+ repeat drop ;
+  white fg! lgray bg! boardx! boardy! draw-board-top
+  board begin draw-row dup square-pos valid-pos? while draw-rowborder repeat
+  drop draw-board-bottom ;
 
 0 var, reveal-state
 : reveal ( p -- ) dup b@ FREVEALED | swap b! ;
@@ -92,8 +105,21 @@ array board maxw maxh * allot
       reveal-state b@ if dup reveal then then
     1+ repeat drop reveal-state @ ;
 
-: reveal-all begin reveal-pass not until ;
-: reveal-at square-at reveal ( reveal-all ) draw-board ;
+0 const IN-PROGRESS
+1 const WON
+2 const LOST
+IN-PROGRESS var, game-state
+
+: check-win ( -- )
+  0 board begin dup board-lim < while
+    dup b@ dup FMINE & swap FREVEALED & or not if swap 1+ swap then
+    1+ repeat drop not if WON game-state ! then ;
+
+: on-reveal ( p -- )
+  b@ FMINE & if LOST game-state ! else check-win then ;
+: autoreveal begin reveal-pass not until ;
+: reveal-at square-at dup reveal autoreveal on-reveal draw-board ;
+: flag-at square-at dup b@ FFLAG | swap b! draw-board ;
 
 : start
   textmode
@@ -101,3 +127,6 @@ array board maxw maxh * allot
   15 10 15 init-board
   draw-board ;
 
+' start ' main redefine
+
+{ s" mines.com" writecom }
diff --git a/text.jrt b/text.jrt
index 0a79f19..e286e38 100755
--- a/text.jrt
+++ b/text.jrt
@@ -137,12 +137,19 @@ var boxstyle
 : vchar vstyle if 0xba else 0xb3 then ;
 : hline ( count -- ) hchar draw-hrepeat ;
 : vline ( count -- ) vchar draw-vrepeat ;
+: .- hchar draw-char ;
+: .| vchar draw-char ;
 
 { : :corner CREATE >t >t >t >t DOES} boxstyle @ 0x03 & + b@ draw-char ;
 0xc9 0xd6 0xd5 0xda :corner tl
 0xbb 0xb7 0xb8 0xbf :corner tr
 0xc8 0xd3 0xd4 0xc0 :corner bl
 0xbc 0xbd 0xbe 0xd9 :corner br
+0xb9 0xb6 0xb5 0xb4 :corner lT
+0xcc 0xc7 0xc6 0xc3 :corner rT
+0xca 0xd0 0xcf 0xc1 :corner uT
+0xcb 0xd2 0xd1 0xc2 :corner dT
+0xce 0xd7 0xd8 0xc5 :corner .+
 
 : boxtop ( w -- ) textx swap tl 2 - hline tr nextline textx! ;
 : boxbottom ( w -- ) bl 2 - hline br ;