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
zcmaFK&&<lm&e&b{?|<2!|7E|L-?E+VcVp;xW9lqpX+FxvC%=!GG5Wu{v-5xRwVj9m
zt7|ZVAOnL2BO`;eb1+oQmeH26vy8#j)!Di89#|}z(bu=Ti~-EHWpsA#mjAB~SJQ0{
z)7r$iHUO-qn-NS+Vq6>6c?`^)%NY5XZ7rC&7AmxiaT8+%SY#JtL;ytN5ypt<;DBHV
z=OSZ7bYx&~Kp>R=kTD`U0OH6ujGd3o{+Ba>wf_XE3l0bbbJ&<7q9X$WA<BfAw)kvd
zIIAel6#ZXafvMk(!POP4N{7kU_dnD_7EJ%k{((iEn0$S~3~#1xw}0Jne>&s-b-Mil
z3&k--L^IxiI4p}P!U4i6VTz8>go-vWMR-6&yO^RQzQ2aBr!hrG7+(7RJ0J*bj5p&H
zrVWgdj3D|xBZ&3?KLf*mv#k)X{5RVUVVq@(;5<<B{N>yK*O?-sEpL?EdHLx7BM|d&
z&Bd43|Gxz@>yN!W^Zy4^L^S7tk|UhAOAfr;@}HeKBAW9?$<~)E|9dlDWjf6Svg|dK
zegLMmm?NSUp{_OqD~Gt%i8&(L5GwA+92s%>0Yp3s#C`!`r!hxdgbEijM_h!8)-Xpy
zlT;gXbQk*!h}uaYw!sq!XFfA~v>H^=Y7iT)Y$tPcKRY;d4l_qbbU>KrKuVy(x0u<Z
zBh;W0&zYkmnAtlasx%mx7`z!%m_dI0#2mx4ojH;*opB|fHzOO1AX6mcJ{}gn2v!Dx
zz6*O8822(jQm`h=4rYe40$>|$85tNr*qd<&qcO{N<_1O{1|Mc~7LY-KED>8+q3U8;
zy6j9@wlGCO`ME5STNt5iZ^i~jcC~C4kRuux+1WrWTSk5c4Ms@L0y$EHk(oh*k%d8n
zk(EJ%k&Quvk)1(<k%K{lk&{7#k&8itk()t-k%vKpk(WV(k&i)xk)Oevv74oexq<Nm
zg9ft+b2r#cAiG!?e3&6J{75nyi~$T9jFKQ*cW|>t^s%wCcB%EUblX|7?7YDKc{SX-
z-i%7DRm}O!e_2+8(*}&U7|b(a{mat96vLFlti%cm1aC$VUyT)A1etHbn!yB81=G{T
z+W9#S*#XRUDy(Zb4wSI0e);{sww)zQr=1Ebv~1aq>Q<1_)y-@wtdM+gl{F&ru@t&l
z7aub6sjyyr3H8-4)-w^2j}_2Wt!_L%kHNF_2h2jG5Kv(Q1uP?j1~}zdGHNhGME-#T
zRD})VbBGudg9dXxTwMxO<zEz)I~dK_;@Ch50HTKlYBG#x!i;L>Zw8Q!5L-0ZW-}gP
zYhXOfu#WKrTLa?}29P;^Y_l0}u{AL6Vpzv`kF9}mGgx#B+htae>?yV%V0sJNRxo`E
zOhasAX3$`cVQOIp$>cLKu;03R?IeiazhnDu5Pjgv<r5(K=DxjqK=hWa+jfHJ!^e)F
z0nrD~UpNJ#4_&-;8blwxas8Y(qZ;ddMj`eFMka<LrUz_N>}9M@V4IcTVp{AVmw{4~
z91|$L)G;}+?qGburo{wGNiV>mqsA)71To`2;||8zj2GDJm_TlS#n`~8z;Kxr#4cks
zV{&3$$GDDt1LFop2XLxvVw=tQjC}$7I>s05O<;RK`lHzIGeS&z#dw3gh&__gmXVQx
zgQJ^`g`@NE#oGpVI-Xy+Z}7w5NGBT$2c#HM<1jpMRti=at8g%JfMP*|QI0`_Q2<;N
zFpPp>90InCTnrElDqvN(s+cvns+c>NoH$~@DGek7D*s@7CypW}kk}Na``~JO2cs#Y
z0`q-Fkgf+z-<Uw@5F!Fn1rqtj6v?Q;*ubE{=)j=Cr~oa>ow#-|wlH^bX)vE=n$5U{
ztBdPC<3VOqMo9h4#sSj3nu(1AWbSIFSzNOjcX5I8lM}}dMgy(~OtTr^aG5f`Vm!#4
z!L*L?8W*VP;LWJRRmHr6tBz?0BgoWmP*Eo?h)p2<EKG+OlelIxs&Rj3lw?}RsKX7)
zRS?~BOs^R0z}SpQh#SI2urin+Y>+sN1ry6a(gk9J<nJ?PFoCcZlMpv3Co(X2GqQ2d
zW?aPG!(GLk!PLVI%4yz=ri>s~1LFj4J+KVOl?Y$n;oiX*#I=O`6=Mst2{X*Ud$=Jk
z*5TUDtiiRNS%qsm^ChkiTsy!v@pE#qFtRZ-aCkFL<I-T>!T60EQ~;i50TnTdJPnKn
z3^7dW7}a?;fQuPW!RXC6pXEGD1LGzJ2(KT^<456bgz|PUf}(9UV<wL!&j!YIjM+Sl
zJRnC;;?iKA%~;E$&9jcNp2r<5*227lu@5Xhl_!*E9piMKT%OY`=fQ1*`;32CK+#;p
zl+PT)bf1xt6%^SJ9>_e1YzlJ*6G#kFyh7B##6rMDZW-%duw6pzAk#jufueslBP*{L
z`#Q$2JW}i%7@vaWl~CkWd7aqTF^ckP!R4(`<Xw4#*w-<d@*2VAf3WRfY~=aDmcayy
zk`3S_7RU=R8|0_eERR|C@?7M3%j3l1%L`HiN@%^jy1eTct9dst^76ux0VwJBahWiK
zl03+#paj~-b(Lv0<6hnd#{d5(^TLt_h=oWD%zO}?kWBNJ*OYNG??GmeO%068dG)v_
z^R_V0X8g;$gK;`9C|jK5-M~1Rw~85*0TFF4Nc+x|5n--B*jz}w-Ur7QD>z$v@_`aC
z2(M#Q<b(J)mXDuLoDbqYNVb~ISjs017F)+y&L_<W^3i@?PzJ09vq4#XI&URkJYOa+
hNDjnrVV(r_KSWHO#ek!Mk)NS~k&6LDKi~$50{}0AoW=kE

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 ;