From 66dcbbdbd76c328d430fecf231b419311ea64f55 Mon Sep 17 00:00:00 2001 From: Jeremy Penner Date: Sun, 24 Sep 2023 18:32:02 -0400 Subject: [PATCH] minesweeper autoreveal, code cleanup --- keys.jrt | 2 +- mines.com | Bin 3985 -> 4327 bytes mines.jrt | 122 +++++++++++++++++++++++++++++++++++------------------- 3 files changed, 81 insertions(+), 43 deletions(-) diff --git a/keys.jrt b/keys.jrt index ecf62f0..615b01b 100755 --- a/keys.jrt +++ b/keys.jrt @@ -27,7 +27,7 @@ 0x39 const %space 0x3a const %capslock 0x3b const %f1 -: %f %f1 + ; +: %func %f1 1- + ; 0x47 const %home 0x49 const %pgup 0x4f const %end diff --git a/mines.com b/mines.com index bf79fb2c4974e65910d13d9d91ae4b3ad5140f0f..4f9444563a09de21838f7d2087e14c23a2eaec7d 100755 GIT binary patch delta 1809 zcmYjSU1%It6rS(i-OcR$-I-Dw8)IxyG#1)MA5@GR}+c;h)MHEbIkUJ7$L=5k(x_fKC`EKfnIdJahUmJewzjkr9VWHvs0b-sV z8#uT4zzOrAvlnXGG|u94^X=h@s_kpC$YXKwMcIue)HT7c#{|q-49})j>zp+t|DkbI zSm~VTMi$H*6}jcPl^zhxofKv8dV~xfm1Xd*Tf!x@#LNvhTI)m0jxZ|Q>}~R@DBytI zW|uJ|Gq|d~_nGW#QuLX;e^TtW3pi}EUn?D9!Ma6z#_bFsW@IRe_}HG(QRm6J*B%iO z`6=K`g^lCz?oru65eYp=usw!^UaFwG#4p%Hp-ji3bQ;L9=M0yub>U4LR9c8uv4p}3 zWE1{%>I?~9)-VrYtYEncCsyI)GM;zX9Ur}P=jb!{ zxl?F#i+Dr(Tcl6yMjvu+Rl+coMhVX_Je38XNrdOz2nB>+xOp@fIXaLra*)Rc<8+cU zTTi@O!S@nY6}*-3sS1w3Dl6cI`yK5q;!pQ|m-n&~3i!`GMd>WM=QYQvvMdU?!@Ep; zwfC3X=yr!>UWQDvCDOkmSf5GqJ^LrqOHBX}5YE`u$dNkH?nm zcRt0kE#LzWf|Ym3o5B=na35KOS*)wdqmITiRr~dp`w4HM(NdW=6Mlro3zhlpR0Mdp zQz1F6p+4Y#xZts~EFFMy_jr4~k31`V-s5!^eNvtFiujkpeo0nMFq%M5(F9o^f|MGl zYBeKQg!i~=r>?kSa{t|@V!1^mH;%MhMI_Y%o>w(wRmK&wh?kdbO2k|zJ6D$}E-HV# zmFB)4Bs(k3c}6Hvgiw@1n=cU7UQUz<$CpHetb*uK?b0MDA$SBg{rp^{d$8kM$UjkfriRsHptA0cF2u!_oB9ku$-de~p;=^`vY zu5gR*=_LPD55rCk+Ch?usxsr#w^yDb!LQJCa3;%uvULmgeUa8J>Wlz3~o|owrS>-pp!bB z=TGVR{@_4H|C=ziT~qG_8A_Swn*w$^64V7pXttA9%gE5PmJabGv9J4_kF7(l9Li6@ g@7@W2b5O*$gxI1fF>dCu*2u%5QD>B#v7j6O1Ep8=TL1t6 delta 1474 zcmY*YZ-`V?6rbO{Z)TtK-o1C|--pz3H^S{pHWKES#;tHBXV*0`5SbW)`6l^cY%nN; zCn?etM6xaOVF*DKEYNZmsf0pyos6h?6)bF7?INNZ7=1{_D4FS;`)1r?IP=c=opaCs zb7SP#x{uRRyqcOBmd`pS-snkp zZp@8H^kk)w^=nt%;?nk>tGr+uasQ zb`YY7&GcnkMwF~z9EY-aDvRMPOc~u|h=$C2WAdtKVxO1yI#`fJT(vQdxcqWf9C6v_ ztk~r>@v_I!yKab^$=meiq*nyQf(%3p?|7F{2}r$6<`r*Rgyg7+vkdd2WE6_|)#68_ z$=$D>78!bajcoYGx=jLN+R~)>+Kc!VE)WsV_<$Q=0lf+aFbizZK_Hl(Ccc745Q~-Z z1%=-2m$23U)a8&x;@Yx~ZT@v{t53;ux_4`Q*AJn+Jw8N3PRK#E6+cRMIoYP!wB-`f zTi)rw+vjr_vnuHzA!BYC&ryFveCSu{{k#*RiFv<{Osq_}pLq&-LjW{i=@;=jm#mAC01R(s+Bo4gjER{Ukhw-USv zO|%s3sAm)pIwMY5iwB14NE7WCI%DPa#BU(V_vJ0bKS8v+FW*Uo*re_x0`jS8X?Ve; zj(l-R7Xs%uXIj0lLe+J9ij8>B#`GUl_oMnU7AZ`$1O;ApJAU5Gf_IZ#?bUVkdO6*; zl@`I=$|8KE`CPb@9QFgv`UUE(_Ud?EU-xplAp=%WyER|L0ScJYyiZxgvY>yFg{1Jj zaw~rSwtl0LcI>3q*a)}uV0l~khFoz}*IdwZ6qVZ>-BT08=5vd+@Q~T@rDoMjnvK^R z=K0DC`eBpoOWUdNWh$KVu&I>rdg3(oZrn8FLAhU5MLs@h`NL{z)@%p{yTTyv2pjS@ zy5X3hOuuvG@E^s)Bz3W#Oon diff --git a/mines.jrt b/mines.jrt index 821d466..757253e 100755 --- a/mines.jrt +++ b/mines.jrt @@ -6,8 +6,9 @@ import random.jrt : b!+ ( v p -- ) dup b@ rot 2dup valid-pos? if rot 2dup valid-pos? if square-at swap execute else drop drop drop then ; +: do-neighbour-squares ( x y cp -- ) >r over 1- over 1- r@ do-at over 1- over r@ do-at over 1- over 1+ r@ do-at @@ -51,14 +54,20 @@ array board maxw maxh * allot over 1+ over r@ do-at swap 1+ swap 1+ t >t >t >t >t >t DOES} theme ! ; +( cursor grid block mine flag bg ) + blue white black black red lgray deftheme win31 + white yellow black black yellow red deftheme hotdog + +win31 + +: draw-neighbour-count ( b -- ) + NEIGHBOUR-MASK & dup col-count 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-flag ( -- ) col-flag 0x0d draw-char ; +: draw-mine ( -- ) col-mine 0x0f draw-char ; +: draw-block ( -- ) col-block 0xb1 draw-char ; : draw-revealed ( b -- ) - dup FMINE & if draw-mine drop else draw-neighbours then ; + dup FMINE & if draw-mine drop else draw-neighbour-count 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 white fg! ; + b@ dup FREVEALED & if draw-revealed else draw-hidden then col-grid ; : pos>screen ( x y -- x y ) swap pagew boardw @ - 2/ + @@ -96,50 +123,61 @@ array countcolors white b, lblue b, lgreen b, red b, blue b, : draw-row ( p -- p ) .| begin dup draw-square .| 1+ dup square-pos drop not until next-row ; : draw-board ( -- ) - white fg! lgray bg! boardx! boardy! draw-board-top + col-grid col-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 -- ) FREVEALED swap b!| ; -: reveal-square? ( x y -- ) - square-at b@ FREVEALED = if -1 reveal-state ! then ; -: reveal-pass ( -- f ) - 0 reveal-state ! - board begin dup board-lim < while - dup b@ FREVEALED & not if - 0 reveal-state b! - dup square-pos ' reveal-square? do-at-neighbours - reveal-state b@ if dup reveal then then - 1+ repeat drop reveal-state @ ; - 0 const IN-PROGRESS 1 const WON 2 const LOST 3 const QUIT IN-PROGRESS bvar, 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 b! then ; +: lose LOST game-state b! + board begin dup board-lim < while FREVEALED over b!| 1+ repeat drop ; -: on-reveal ( p -- ) - b@ FMINE & if LOST game-state b! else check-win then ; -: autoreveal begin reveal-pass not until ; -: reveal-at square-at dup reveal autoreveal on-reveal ; -: flag-at square-at FFLAG swap b!^ ; +: reveal ( p -- ) dup flag? not if + dup mine? if lose then FREVEALED swap b!| + else drop then ; + +: visibly-empty? dup revealed? swap squarecount not and ; +: backtrack-square ( p -- p ) boardw @ - 1- dup board < if drop board then ; +: backtrack? ( p -- f ) + dup revealed? over 1+ revealed? and swap 2 + revealed? and not ; +: autoreveal-backtrack ( p -- p ) + dup visibly-empty? over backtrack-square backtrack? and + if backtrack-square 1- then ; +: autoreveal ( -- ) + board begin dup board-lim < while + dup revealed? not if + dup square-pos ' visibly-empty? count-neighbours + if dup reveal autoreveal-backtrack then then + 1+ repeat drop ; + +: check-win ( -- ) + game-state b@ IN-PROGRESS = if + 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 b! then then ; + + +: reveal-unflagged-neighbours? ( p -- ) + dup square-pos count-surrounding-flags over squarecount = + if square-pos ' reveal do-neighbour-squares else drop then ; +: reveal-at square-at dup revealed? + if reveal-unflagged-neighbours? else reveal then autoreveal check-win ; +: flag-at square-at dup revealed? not if FFLAG swap b!^ else drop then ; 0 bvar, cursx 0 bvar, cursy : draw-cursor ( -- ) - 1 boxstyle! blue fg! + 1 boxstyle! col-curs cursx b@ 2* boardx + textx! cursy b@ 2* boardy + texty! textx tl .- tr nextline textx! textx .| dup 2 + textx! .| nextline textx! bl .- br - 0 boxstyle! white fg! ; + 0 boxstyle! ; : move-cursor ( dx dy -- ) cursy b@ + swap cursx b@ + swap 2dup valid-pos? @@ -157,7 +195,7 @@ IN-PROGRESS bvar, game-state dup %f = if curs@ flag-at then dup %enter = swap %space = or if curs@ reveal-at then ; -: play +: play IN-PROGRESS game-state b! begin game-state b@ IN-PROGRESS = while draw-board draw-cursor await-command repeat draw-board ;