From 304dde117704de90645289d19b1e708e37fe87fc Mon Sep 17 00:00:00 2001 From: Jeremy Penner Date: Tue, 26 Sep 2023 22:40:22 -0400 Subject: [PATCH] code cleanup, multiple menus (theme selector) --- swine.com | Bin 4662 -> 4926 bytes swine.jrt | 272 ++++++++++++++++++++++++++++++------------------------ 2 files changed, 153 insertions(+), 119 deletions(-) diff --git a/swine.com b/swine.com index ca90f54c7491ef0318f897d7d3dd25a02408608c..366ff19ed25d0f915856b0f75b7082b4400a5f23 100755 GIT binary patch delta 2439 zcmY*bd2AF_7@zOW>~`mTb5soi%|bYeTvenBTCqwia+IS8vZfIV6$?Tu3&bE{z=Rq= zFiqL4NsSF52#V3N^@2pS=%yirj@1x>s8Iq&jzExF{voN~_huJrcHivpeeb*8cg=n| z;`pfcBAJyGcEshsl$MmqN13Xvo|PM+7L>clR$FC7y~Y}$42sIYD25Ivwj5gGvB*os zph@B4QZ4M)n&pGI+Sn8|iToj@jV15yr>Hv^aUEuTK<5D@;4!%mNa{8-5#=fSTLN{E z->C)ADy#Z5`2x$pL|xVU;H;d03qpHSjC7q~O)-)`!S2&DFj*(PQ`7)H({7{8N<9I< z&dNT^!hF3;SUrr~lk^k|P)`P4&rw4=B;6`=w1}t}p%FqvZVnA*=ipB*1K;YMS|604 z;%v*i+5`SaI!gSsTJ_g2T<%k=h7$gj?gn=DnG|MIE z>NKMUMjFRr~4M*@cK)4PA=+f7nI4*7_Bv^0v88{sZ6o-oPx#b}OwA=G zl>?y4>jNr*A)*4mG4mJG69^Ev_aDds#!mXS!D(Mu) zr@;Ez%z|nKMzy)aB-!wURF1Yd#_0-1Zj41P76Vr`1){PPD~8XlS}3)emL}e~5P1Sy?zF^p#rOXsQW5whEMp z#063;Q?ht1P*()7(+YgZ!0%QXN-$MfxQGhU5SNZd$enpeH*+|F_*xFXg7`=dhtbYJ zocE$^7KZa5ERv;O%)q1kZ*-@WOPpxrDrF@Dv$?^uP{l`Zf1O~LBUDvyV#DuXO(HTekbaq(jG0Wn2S7Aw$7@wHu5dJoljB!;B-!7Wr+PF z-bk~%;5(s_qG+OaNrh*JJU62dly>KtJpSClw$zEh}FY2lGu7AlHY}uw$JvPWtv2E^nu;R4%js2 z!x?oB1y9=~n&${dIj|0!MtcTy=bYUwXTfyBwj+royCHldOm#Qj>BTfpbn-s`q?}Ps z<*_~;Bs*zj0t|JBR5C4SXZ4^tiJ_3iLPB2cm;2n$sh4)lf;ov4D=hmSeCoj zowM>)Tv=G@=I=o~#81f@hJ82ST0333)|0~Z_g%VH0?OO~rU}X?ZVmP|?Zb;7cN5r} z{rzRGpTB!Il4=CY2AAUWt6T4KD*%c{A0+TO1QYlVQvVgBDh-1$4>8OG4vc6G)JCx_ zkP?yhMz3S_56)$2tL?_ZEYQD*01EJb1oo`=sd8Bflrz3^5N3Ky=DrYLJhw{fbv1Fk z+WQKRPh#c|LcKVhJ-2!x9#h#3RV%IGHcjm9-W`6^dBe@Z21KJgN(>FYLbPq*Dw0yh z8js4edhzpB74bP074s?4aJM(2@M~{up{Jtc ly7lqrmaVCi7QR}yrY4vpy}$Q)pZE7X z@AL0oX!&}@nI_J%4QHGA4f*WabU$qCRR{UoxJH8;$)JnRjr5e)MwbpyZ70+6&RHHJx^hwFlUAWdAC*g%@@Ut%}Z z08$$9s+kB5t220Kot6h+liXt=Jf@8ctNo}gYsXoHJOON~NfSGCdzeq7MMPPI*Aj^6 z*BV;Jeu4l^y{`?SJ8O{mMCF3I)a%oL9cRF{u{!chTax2jLneG<;Yil`$V{jd2V^vvf`&&py?CFlzWT;yX3`4dO3rI07oN z0QMU>yccJjEP`aV)_Z z)bI-M&>|n2aBW{SC$6+0ZpF2^wtoTfv$%HE_V-c|95wExJR}`e$3;85Y7$ui6X5GN zjX#a$rkd$6>6~i*J#(WO!a+3qlv#pyklF!1Sv&Bo2Uw{em?P#SpD(;i<~0@ARGQlF z3%o_l5tbV@-VJ2!)B?C_j-pl!Q|SWqpFWLTs;8VT{hb+ za(z3RBV!}xFt3@v_ zf&bW)(4UI*tUb&R@-d^#HY=+Ho-itg)7C~CDpOLR?_{ohVz06%c@|d)pCMiHbkbR6 zSN1zgyzlG}#RDQ(pC-4j**?t8<)P1xV1tnSZuej}(|(iK&)Ip*%-kGFazbJ`dGwC< zflVBbI-lD*?zZ4*40-%)#C$!C(!a!GE5f3P|9X*toz6b9)&9y3p&b#$qg_6e_F=K) zgO007D(Y(;3dPRdFK^E^Z_DL&g8kV9D+=7*fh4y(}%oFONG@10Xl2vsM* zza%x3&;V{b=adM(b*K)0bdqqigN#+5g(i2m^SGO31-R>su-Hj{^&~ffWvt3Gav48M zu(Nm1o4w61?b-L5)N$bT-r7)abqBfRqK?OCx|2x~Q80G7Ih-q9ZrznD@`Nnm*}GyO z_^=$`r%HR3l}aAF>2HTR;v^b<5m&eCu|5Sb)gkn`_3WLJZ^;p|&{Q-O9~@-h$nb`9 z#p&DYChw)+Vqio^y>iuUb*oqczaUB7xiY&bblr4QI)betllSrc^*oyml;vr3Bgt}O bLk~>5l+yrO8rsC&kKH@&UN?l*4JG&=nb=2z diff --git a/swine.jrt b/swine.jrt index a526537..5a1710e 100755 --- a/swine.jrt +++ b/swine.jrt @@ -8,6 +8,17 @@ import random.jrt : b!^ ( f p -- ) dup b@ t >t >t >t >t >t DOES} theme ! ; -( cursor grid block mine flag bg ) - blue white black magenta red lgray deftheme win31 - white yellow black lmagenta 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 ( -- ) col-flag 0x0d draw-char ; -: draw-mine ( -- ) col-mine 0xec draw-char ; -: draw-block ( -- ) col-block 0xb1 draw-char ; -: draw-revealed ( b -- ) - 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 col-grid ; - -: pos>screen ( x y -- x y ) - swap pagew boardw @ - 2/ + - swap pageh boardh @ - 2/ + ; -: boardx ( -- x ) pagew boardw @ 2* 1+ - 2/ ; -: boardy ( -- y ) pageh boardh @ 2* 1+ - 2/ ; -: boardx! ( -- ) boardx textx! ; -: boardy! ( -- ) boardy texty! ; -: next-row ( -- ) nextline boardx! ; - -: draw-border ( end mid -- ) - boardw @ begin .- 1- dup while over execute repeat drop drop execute next-row ; -: draw-board-top tl ' tr ' dT draw-border ; -: draw-board-bottom bl ' br ' uT draw-border ; -: draw-rowborder rT ' lT ' .+ draw-border ; -: draw-row ( p -- p ) - .| begin dup draw-square .| 1+ dup square-pos drop not until next-row ; -: draw-board ( -- ) - 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 const IN-PROGRESS -1 const WON -2 const LOST -3 const QUIT -IN-PROGRESS bvar, game-state - : lose LOST game-state b! board begin dup board-lim < while FREVEALED over b!| 1+ repeat drop ; @@ -155,12 +105,11 @@ IN-PROGRESS bvar, game-state 1+ repeat drop ; : check-win ( -- ) - game-state b@ IN-PROGRESS = if + 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 ; @@ -168,6 +117,120 @@ IN-PROGRESS bvar, game-state if reveal-unflagged-neighbours? else reveal then autoreveal check-win ; : flag-at square-at dup revealed? not if FFLAG swap b!^ else drop then ; +( theming ) +array countcolors white b, lblue b, lgreen b, red b, blue b, + brown b, cyan b, black b, gray b, + +var theme +: colvar theme @ + b@ ; +: col-bg 0 colvar bg! ; +: col-flag 1 colvar fg! ; +: col-mine 2 colvar fg! ; +: col-block 3 colvar fg! ; +: col-grid 4 colvar fg! ; +: col-curs 5 colvar fg! ; +: col-count ( c -- ) + countcolors + b@ dup 0 colvar = if drop col-grid else fg! then ; + +{ :timm deftheme CREATE >t >t >t >t >t >t DOES} theme ! ; +( cursor grid block mine flag bg ) + blue white black magenta red lgray deftheme win31 + white yellow black lmagenta yellow red deftheme hotdog + +win31 + +( minesweeper board drawing ) +: draw-neighbour-count ( b -- ) + NEIGHBOUR-MASK & dup col-count + dup if [ key 0 lit ] + else drop [ key lit ] then draw-char ; +: draw-flag ( -- ) col-flag 0x0d draw-char ; +: draw-mine ( -- ) col-mine 0xec draw-char ; +: draw-block ( -- ) col-block 0xb1 draw-char ; +: draw-revealed ( b -- ) + 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 col-grid ; + +: boardx ( -- x ) pagew boardw @ 2* 1+ - 2/ ; +: boardy ( -- y ) pageh boardh @ 2* 1+ - 2/ ; +: boardx! ( -- ) boardx textx! ; +: boardy! ( -- ) boardy texty! ; +: next-row ( -- ) nextline boardx! ; + +: draw-border ( end mid -- ) + boardw @ begin .- 1- dup while over execute repeat drop drop execute next-row ; +: draw-board-top tl ' tr ' dT draw-border ; +: draw-board-bottom bl ' br ' uT draw-border ; +: draw-rowborder rT ' lT ' .+ draw-border ; +: draw-row ( p -- p ) + .| begin dup draw-square .| 1+ dup square-pos drop not until next-row ; +: draw-board ( -- ) + 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 ; + +( general-purpose drawing ) + +: clear [ key lit ] fill-page ; + +: emptych? ( ch -- f ) dup 32 = swap 0 = or ; +: drawdot? ( st -- f ) dup b@ emptych? swap 1+ b@ emptych? or not ; + +: dot 7 draw-char ; +: sp 32 draw-char ; +: spacer ( st -- ) sp drawdot? if dot else sp then sp ; + +: draw-spaced-text ( st -- ) + begin dup b@ dup while draw-char dup spacer 1+ repeat drop drop ; + +( menu subsystem ) +2 cells const menu-optsize +var current-menu +: menu-options current-menu @ cell + 1+ ; +: menu-size current-menu @ cell + b@ ; +: init-menu current-menu @ @ execute ; + +: menu-option ( iopt -- p ) menu-optsize * menu-options + ; + +0 var, menu-selected + +: menu-activate menu-selected @ menu-option cell + @ execute ; +: menu-selected! ( i -- ) + dup 0 >= over menu-size < and if menu-selected ! else drop then ; +: menu-selected+! ( di -- ) menu-selected @ + menu-selected! ; + +: draw-selection ( iopt -- ) + menu-selected @ = if draw-mine else sp then sp ; +: draw-option ( iopt -- ) white fg! menu-option @ draw-text ; +: draw-menu + 33 10 textxy! + textx 0 begin dup menu-size < while + dup draw-selection dup draw-option 1+ nextline over textx! repeat + drop drop ; + +: await-menu + wait-key key>scan + dup %esc = if leave then + dup %up = if -1 menu-selected+! then + dup %down = if 1 menu-selected+! then + %enter = if menu-activate init-menu then ; + +: run-menu + enter init-menu + begin draw-menu await-menu in-progress? not until + enter ; + +{ :timm defmenu ( itemcount cpinit -- ) + CREATE target current-menu !t w>t dup >t menu-optsize * ALLOT DOES} + menu-selected @ >r current-menu @ >r + current-menu ! 0 menu-selected! run-menu + rot !t cell + !t ; } + +( minesweeper game UI ) 0 bvar, cursx 0 bvar, cursy : draw-cursor ( -- ) @@ -184,10 +247,11 @@ IN-PROGRESS bvar, game-state if cursy b! cursx b! else drop drop then ; : curs@ cursx b@ cursy b@ ; + 0x21 const %f : await-command wait-key key>scan - dup %esc = if QUIT game-state b! then + dup %esc = if leave then dup %left = if -1 0 move-cursor then dup %right = if 1 0 move-cursor then dup %up = if 0 -1 move-cursor then @@ -195,71 +259,41 @@ IN-PROGRESS bvar, game-state dup %f = if curs@ flag-at then dup %enter = swap %space = or if curs@ reveal-at then ; -: play IN-PROGRESS game-state b! - begin game-state b@ IN-PROGRESS = while - draw-board draw-cursor await-command repeat draw-board ; +: result-message + 25 8 textxy! 0 hstyle! 1 vstyle! + 30 5 filled draw-box + 27 10 textxy! draw-spaced-text + wait-key drop ; -: start - textmode - reseed! - 20 12 30 init-board - play ; +: display-result + game-state b@ + dup WON = if cyan bg! yellow fg! s" YOU WON" result-message then + LOST = if brown bg! lred fg! s" YOU LOST" result-message then ; -' start ' main redefine +: play enter col-bg clear + begin in-progress? while draw-board draw-cursor await-command repeat + draw-board display-result enter ; + +: start 20 12 30 init-board play ; ( title menu ) array title-text t", SWINE MEEPER" -: emptych? ( ch -- f ) dup 32 = swap 0 = or ; -: drawdot? ( st -- f ) dup b@ emptych? swap 1+ b@ emptych? or not ; - -: dot 7 draw-char ; -: sp 32 draw-char ; -: spacer ( st -- ) sp drawdot? if dot else sp then sp ; - -: draw-spaced-text ( st -- ) - begin dup b@ dup while draw-char dup spacer 1+ repeat drop drop ; - -2 cells const menu-optsize -2 const menu-size -array menu-options menu-optsize menu-size * allot - -: menu-option ( iopt -- p ) menu-optsize * menu-options + ; -: defmenu ( cp name iopt -- ) menu-option dup >rot ! cell + ! ; - -' start s" Start Game" 0 defmenu -' terminate s" Quit" 1 defmenu - -0 var, menu-selected - -: menu-activate menu-selected @ menu-option cell + @ execute ; - -: draw-selection ( iopt -- ) - menu-selected @ = if draw-mine else sp then sp ; -: draw-option ( iopt -- ) white fg! menu-option @ draw-text ; -: draw-menu - 33 10 textxy! - textx 0 begin dup menu-size < while - dup draw-selection dup draw-option 1+ nextline over textx! repeat - drop drop ; +3 :noname col-bg clear ; defmenu theme-menu +' win31 s" Classic 3.1" 0 defitem +' hotdog s" Hot Dog Stand" 1 defitem +' leave s" Done" 2 defitem : draw-title - blue bg! yellow fg! 32 fill-page - 17 3 textxy! title-text draw-spaced-text - draw-menu ; + blue bg! yellow fg! clear + 17 3 textxy! title-text draw-spaced-text ; -: menu-selected! ( i -- ) - dup 0 >= over menu-size < and if menu-selected ! else drop then ; -: menu-selected+! ( di -- ) menu-selected @ + menu-selected! ; +3 ' draw-title defmenu title-menu +' start s" Start Game" 0 defitem +' theme-menu s" Themes" 1 defitem +' leave s" Quit" 2 defitem -: await-menu - wait-key key>scan - dup %esc = if terminate then - dup %up = if -1 menu-selected+! then - dup %down = if 1 menu-selected+! then - %enter = if menu-activate then ; - -: title draw-title begin await-menu draw-menu again ; +: title textmode reseed! hidecursor title-menu textmode ; ' title ' main redefine