difficulty menu, in-game quit menu
This commit is contained in:
parent
304dde1177
commit
dd6cfe85cd
83
swine.jrt
83
swine.jrt
|
|
@ -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!
|
||||
|
|
@ -136,7 +138,8 @@ var theme
|
|||
( 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
|
||||
4 ' draw-title defmenu title-menu
|
||||
' start s" Start Game" 0 defitem
|
||||
' theme-menu s" Themes" 1 defitem
|
||||
' leave s" Quit" 2 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 ;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue