difficulty menu, in-game quit menu

main
Jeremy Penner 2023-09-27 19:40:50 -04:00
parent 304dde1177
commit dd6cfe85cd
2 changed files with 57 additions and 34 deletions

BIN
swine.com

Binary file not shown.

View File

@ -9,22 +9,25 @@ import random.jrt
: ~ 0xffff ^ ;
0 const IN-PROGRESS
1 const WON
2 const LOST
3 const QUIT
1 const CANCEL
2 const WON
3 const LOST
4 const QUIT
IN-PROGRESS bvar, game-state
: leave QUIT game-state b! ;
: leave CANCEL game-state b! ;
: enter IN-PROGRESS game-state b! ;
: in-progress? game-state b@ IN-PROGRESS = ;
: cancelled? game-state b@ CANCEL = ;
: uncancel cancelled? if enter then ;
( minesweeper board model )
30 const maxw 12 const maxh
array board maxw maxh * allot
10 var, boardw
10 var, boardh
15 var, minecount
20 var, boardw
12 var, boardh
30 var, minecount
: board-lim boardw @ boardh @ * board + ;
: square-at ( x y -- p ) boardw @ * + board + ;
@ -79,8 +82,7 @@ var neighbour-check
: count-surrounding-flags ( x y -- n ) ' flag? count-neighbours ;
: init-board ( w h minecount -- )
minecount ! boardh ! boardw !
: init-board ( -- )
reset-board populate-board analyze-board ;
: lose LOST game-state b!
@ -133,10 +135,11 @@ var theme
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
( cursor grid block mine flag bg )
blue white black magenta red lgray deftheme win31
white yellow black lmagenta yellow red deftheme hotdog
yellow lgray cyan lmagenta yellow blue deftheme borland
magenta lgray magenta magenta magenta cyan deftheme cga4
win31
( minesweeper board drawing )
@ -166,7 +169,7 @@ win31
: 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 ( -- )
: draw-board ( -- ) 0 boxstyle!
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 ;
@ -205,7 +208,7 @@ var current-menu
menu-selected @ = if draw-mine else sp then sp ;
: draw-option ( iopt -- ) white fg! menu-option @ draw-text ;
: draw-menu
33 10 textxy!
30 9 textxy!
textx 0 begin dup menu-size < while
dup draw-selection dup draw-option 1+ nextline over textx! repeat
drop drop ;
@ -220,7 +223,7 @@ var current-menu
: run-menu
enter init-menu
begin draw-menu await-menu in-progress? not until
enter ;
uncancel ;
{ :timm defmenu ( itemcount cpinit -- )
CREATE target current-menu !t w>t dup >t menu-optsize * ALLOT DOES}
@ -239,8 +242,7 @@ var current-menu
cursy b@ 2* boardy + texty!
textx tl .- tr nextline textx!
textx .| dup 2 + textx! .| nextline textx!
bl .- br
0 boxstyle! ;
bl .- br ;
: move-cursor ( dx dy -- )
cursy b@ + swap cursx b@ + swap 2dup valid-pos?
@ -259,39 +261,60 @@ var current-menu
dup %f = if curs@ flag-at then
dup %enter = swap %space = or if curs@ reveal-at then ;
: result-message
25 8 textxy! 0 hstyle! 1 vstyle!
30 5 filled draw-box
27 10 textxy! draw-spaced-text
: popupbox ( h -- )
20 8 textxy! 0 hstyle! 1 vstyle!
39 swap filled draw-box ;
: result-message ( st x -- )
5 popupbox ( x ) 10 textxy! draw-spaced-text
wait-key drop ;
: 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 ;
dup WON = if green bg! lcyan fg! s" YOU WON" 26 result-message then
LOST = if red bg! yellow fg! s" YOU LOST" 25 result-message then ;
2 :noname blue bg! lgray fg! 4 popupbox ; defmenu quitmenu
' leave s" Return to game" 0 defitem
:noname QUIT game-state b! ; s" Quit to title" 1 defitem
: confirm-quit cancelled? if quitmenu then ;
: draw-game draw-board draw-cursor ;
: play enter col-bg clear
begin in-progress? while draw-board draw-cursor await-command repeat
begin draw-game await-command confirm-quit in-progress? not until
draw-board display-result enter ;
: start 20 12 30 init-board play ;
: start init-board play ;
( title menu )
array title-text t", SWINE MEEPER"
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
5 :noname col-bg clear ; defmenu theme-menu
' win31 s" 3.11 for Worksties" 0 defitem
' hotdog s" Pork Sausage Stand" 1 defitem
' borland s" Boarland Turbohog" 2 defitem
' cga4 s" Sowlo Jazz" 3 defitem
' leave s" Done" 4 defitem
20 12 30 minecount ! boardh ! boardw !
: config-game ( boardw boardh minecount -- )
minecount ! boardh ! boardw ! leave ;
3 :noname red bg! clear ; defmenu difficulty-menu
:noname 10 10 10 config-game ; s" Easy ( 10x10, 10 swine )" 0 defitem
:noname 20 12 30 config-game ; s" Moderate ( 20x12, 30 swine )" 1 defitem
:noname 30 12 60 config-game ; s" Hard ( 30x12, 60 swine )" 2 defitem
: draw-title
blue bg! yellow fg! clear
17 3 textxy! title-text draw-spaced-text ;
3 ' draw-title defmenu title-menu
' start s" Start Game" 0 defitem
' theme-menu s" Themes" 1 defitem
' leave s" Quit" 2 defitem
4 ' draw-title defmenu title-menu
' start s" Start Game" 0 defitem
' difficulty-menu s" Difficulty" 1 defitem
' theme-menu s" Themes" 2 defitem
' leave s" Quit" 3 defitem
: title textmode reseed! hidecursor title-menu textmode ;