diff --git a/swine.com b/swine.com index 366ff19..a9aaf5d 100755 Binary files a/swine.com and b/swine.com differ diff --git a/swine.jrt b/swine.jrt index 5a1710e..98d4023 100755 --- a/swine.jrt +++ b/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! @@ -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 ;