SpindleyQ/dialer
1
1
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

difficulty menu, in-game quit menu

Browse source
This commit is contained in:
Jeremy Penner 2023-09-27 19:40:50 -04:00
parent 304dde1177
commit dd6cfe85cd
2 changed files with 57 additions and 34 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

BIN
swine.com
View file

Binary file not shown.

83
swine.jrt
View file

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