code cleanup, multiple menus (theme selector)
This commit is contained in:
parent
e98c04584a
commit
304dde1177
272
swine.jrt
272
swine.jrt
|
|
@ -8,6 +8,17 @@ import random.jrt
|
|||
: b!^ ( f p -- ) dup b@ <rot ^ swap b! ;
|
||||
: ~ 0xffff ^ ;
|
||||
|
||||
0 const IN-PROGRESS
|
||||
1 const WON
|
||||
2 const LOST
|
||||
3 const QUIT
|
||||
IN-PROGRESS bvar, game-state
|
||||
|
||||
: leave QUIT game-state b! ;
|
||||
: enter IN-PROGRESS game-state b! ;
|
||||
: in-progress? game-state b@ IN-PROGRESS = ;
|
||||
|
||||
( minesweeper board model )
|
||||
30 const maxw 12 const maxh
|
||||
array board maxw maxh * allot
|
||||
|
||||
|
|
@ -72,67 +83,6 @@ var neighbour-check
|
|||
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,
|
||||
|
||||
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
|
||||
|
||||
: 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
|
||||
<r current-menu ! <r menu-selected! ;
|
||||
|
||||
{ :timm defitem ( cp name iopt -- ) menu-option dup >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
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue