diff --git a/app/Main.hs b/app/Main.hs index 79170b9..57822c2 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -5,12 +5,16 @@ import Graphics.Vty ( Vty ) import qualified Graphics.Vty as V import Lens.Micro ( (^.) ) import Data.Maybe ( fromMaybe ) --- import Control.Monad ( void ) + import qualified Labyrinth.UI as UI +import qualified Labyrinth.UI.Widget as UI import Labyrinth.UI ( Name ) -import Labyrinth.UI.Widget + +import qualified Labyrinth.UI.Debug as Debug + import qualified Labyrinth.UI.Modal as Modal import qualified Labyrinth.Store.Event.Modal as Modal + import qualified Labyrinth.UI.Screen.Splash as Splash import qualified Labyrinth.Store.Event.Splash as Splash @@ -21,8 +25,6 @@ import qualified Labyrinth.Store as Store import Labyrinth.Store ( Store , State(..) , Ev - , state - , modal ) main :: IO () @@ -39,13 +41,13 @@ app = App { appDraw = draw } draw :: Store e -> [Widget Name] -draw store = [showModals, maybe drawScreen Modal.draw (Store.nextModal store)] +draw store = + [Debug.draw store, maybe drawScreen Modal.draw (Store.nextModal store)] where - showModals = str $ show (store ^. modal) - drawScreen = appContainer 50 $ case store ^. state of + drawScreen = UI.appContainer 50 $ case store ^. Store.state of Splash s -> Splash.draw s Setup s -> Setup.draw s - _ -> emptyWidget + _ -> txt "Screen not implemented" handleEvent :: Ord e => Store e -> BrickEvent Name e -> EventM Name (Next (Store e)) @@ -53,7 +55,7 @@ handleEvent store ev = handle store ev where handle = if Store.isModalEvent store ev then Modal.handle - else case store ^. state of + else case store ^. Store.state of Splash s -> Splash.handle s Setup s -> Setup.handle s _ -> \_ _ -> halt store @@ -68,7 +70,6 @@ chooseCursor :: Store e -> [CursorLocation Name] -> Maybe (CursorLocation Name) chooseCursor store = fromMaybe (neverShowCursor store) $ if Store.isShowingModal store then Store.nextModal store >>= Modal.chooseCursor - else case store ^. state of - Splash s -> Splash.chooseCursor s - Setup s -> Setup.chooseCursor s - _ -> Nothing + else case store ^. Store.state of + Setup s -> Setup.chooseCursor s + _ -> Nothing diff --git a/labyrinth.cabal b/labyrinth.cabal index c1d2d0c..2a70575 100644 --- a/labyrinth.cabal +++ b/labyrinth.cabal @@ -2,7 +2,7 @@ -- -- see: https://github.com/sol/hpack -- --- hash: c4ecded4a317515194ffec780399ead781fb6980bb83fc4782fe5aa4ec1d9811 +-- hash: 6cbcea1f571593f670a43c58a89b3e50fcc26e29adcc1665118ae3f7c365c410 name: labyrinth version: 0.1.0.0 @@ -30,6 +30,7 @@ library Labyrinth.Game.Players Labyrinth.UI Labyrinth.UI.Modal + Labyrinth.UI.Debug Labyrinth.UI.Screen.Splash Labyrinth.UI.Screen.Setup Labyrinth.UI.Screen.Game diff --git a/lib/Labyrinth/Store.hs b/lib/Labyrinth/Store.hs index b4d553b..07a2fe5 100644 --- a/lib/Labyrinth/Store.hs +++ b/lib/Labyrinth/Store.hs @@ -3,7 +3,7 @@ module Labyrinth.Store , State(..) , Ev , state - , modal + , modals , initial , isModalEvent , isShowingModal @@ -19,10 +19,10 @@ import Labyrinth.UI ( Name ) import qualified Labyrinth.UI.Screen.Splash as Splash initial :: Store e -initial = Store { _state = Splash Splash.initial, _modal = [] } +initial = Store { _state = Splash Splash.initial, _modals = [] } isModalEvent :: Ord e => Store e -> BrickEvent Name e -> Bool isModalEvent store ev = isShowingModal store || Modal.isModalEvent ev isShowingModal :: Store e -> Bool -isShowingModal = not . null . (^. modal) +isShowingModal = not . null . (^. modals) diff --git a/lib/Labyrinth/Store/Event/Modal.hs b/lib/Labyrinth/Store/Event/Modal.hs index f34339b..342e5d4 100644 --- a/lib/Labyrinth/Store/Event/Modal.hs +++ b/lib/Labyrinth/Store/Event/Modal.hs @@ -1,6 +1,8 @@ module Labyrinth.Store.Event.Modal ( handle , isModalEvent + , showModal + , nextModal ) where @@ -17,7 +19,9 @@ import Data.Map.Strict ( Map , (!?) ) import Data.Maybe ( fromMaybe ) -import Labyrinth.UI ( Name ) +import Labyrinth.UI ( Name + , ModalCallback + ) import Labyrinth.UI.Modal ( dialog , onTrue , onFalse @@ -38,13 +42,15 @@ handleInModal :: GlobalEventHandler e handleInModal store ev = maybe (continue store) withModal (nextModal store) where withModal m = case ev of - (VtyEvent (V.EvKey V.KEsc [])) -> (m ^. onFalse) store + (VtyEvent (V.EvKey V.KEsc [])) -> (hideModalAnd $ m ^. onFalse) store (VtyEvent (V.EvKey V.KEnter [])) -> fromMaybe (continue store) $ do sel <- D.dialogSelection (m ^. dialog) - return $ if sel then (m ^. onTrue) store else (m ^. onFalse) store + return $ if sel + then (hideModalAnd $ m ^. onTrue) store + else (hideModalAnd $ m ^. onFalse) store (VtyEvent vtyEv) -> do d <- D.handleDialogEvent vtyEv (m ^. dialog) - continue $ store & modal %~ \case + continue $ store & modals %~ \case [] -> [] (_ : ms) -> (m & dialog .~ d) : ms _ -> continue store @@ -55,8 +61,13 @@ promptToQuit store _ = showModal store $ mkModal (txt "Do you want to quit Labyrinth?") (0, [("Stay", False), ("Quit", True)]) halt - hideModal + continue eventMap :: Ord e => Map (BrickEvent Name e) (GlobalEventHandler e) eventMap = Map.fromList [(VtyEvent (V.EvKey (V.KChar 'q') [V.MCtrl]), promptToQuit)] + +hideModalAnd :: ModalCallback Store e -> ModalCallback Store e +hideModalAnd f store = f $ store & modals %~ \case + [] -> [] + (_ : ms) -> ms \ No newline at end of file diff --git a/lib/Labyrinth/Store/Event/Setup.hs b/lib/Labyrinth/Store/Event/Setup.hs index 2a37281..84ccbf4 100644 --- a/lib/Labyrinth/Store/Event/Setup.hs +++ b/lib/Labyrinth/Store/Event/Setup.hs @@ -46,7 +46,7 @@ play :: RegistrationEventHandler e play s store _ = maybe (continue store) promptToPlay (S.setup s) where promptToPlay (p, ps) = showModal store - $ UI.mkOkModal "start" (UI.nextPlayerPrompt p) (toNewGame p ps) + $ UI.mkOkModal "start" (UI.nextPlayerPrompt p) (continueToNewGame p ps) processInput :: RegistrationEventHandler e processInput s store ev = @@ -59,5 +59,6 @@ edit i s store _ = update :: Store e -> SetupS e -> Store e update store s = store & state .~ Setup s -toNewGame :: Player -> Players -> ModalCallback Store e -toNewGame p ps store = continue $ store & state .~ Plan (G.initial (Game ps p)) +continueToNewGame :: Player -> Players -> ModalCallback Store e +continueToNewGame p ps store = + continue $ store & state .~ Plan (G.initial (Game ps p)) diff --git a/lib/Labyrinth/Store/Internal.hs b/lib/Labyrinth/Store/Internal.hs index 2289430..a805465 100644 --- a/lib/Labyrinth/Store/Internal.hs +++ b/lib/Labyrinth/Store/Internal.hs @@ -4,9 +4,8 @@ module Labyrinth.Store.Internal , Ev , EventHandler , state - , modal + , modals , showModal - , hideModal , nextModal ) where @@ -36,19 +35,14 @@ data State e = Splash SplashS data Store e = Store { _state :: State e - , _modal :: [Modal Store e] + , _modals :: [Modal Store e] } deriving (Show) makeLenses ''Store type EventHandler s e = s -> Store e -> BrickEvent Name e -> EventM Name (Next (Store e)) showModal :: Store e -> Modal Store e -> EventM Name (Next (Store e)) -showModal store m = continue $ store & modal %~ (m :) - -hideModal :: Store e -> EventM Name (Next (Store e)) -hideModal store = continue $ store & modal %~ \case - [] -> [] - (_ : ms) -> ms +showModal store m = continue $ store & modals %~ (m :) nextModal :: Store e -> Maybe (Modal Store e) -nextModal = listToMaybe . (^. modal) +nextModal = listToMaybe . (^. modals) diff --git a/lib/Labyrinth/UI/Debug.hs b/lib/Labyrinth/UI/Debug.hs index 63aa140..7f518df 100644 --- a/lib/Labyrinth/UI/Debug.hs +++ b/lib/Labyrinth/UI/Debug.hs @@ -6,14 +6,16 @@ where import Brick import Lens.Micro ( (^.) ) import qualified Labyrinth.Store as S -import Labyrinth.Store ( Store, State(..) ) +import Labyrinth.Store ( Store + , State(..) + ) draw :: Store e -> Widget n draw store = vBox [state, modals] - where - state = txt $ case (store ^. S.state) of - Splash _ -> "State: Splash" - Setup _ -> "State: Setup" - Plan _ -> "State: Plan" - _ -> "State: not implemented" - modals = str $ show $ store ^. S.modal + where + state = txt . ("State: " <>) $ case store ^. S.state of + Splash _ -> "Splash" + Setup _ -> "Setup" + Plan _ -> "Plan" + _ -> "not implemented" + modals = str $ show $ store ^. S.modals diff --git a/lib/Labyrinth/UI/Modal.hs b/lib/Labyrinth/UI/Modal.hs index cb16188..f4b067e 100644 --- a/lib/Labyrinth/UI/Modal.hs +++ b/lib/Labyrinth/UI/Modal.hs @@ -60,4 +60,4 @@ mkModal desc body options onT onF = Modal } mkOkModal :: String -> Widget Name -> ModalCallback s e -> Modal s e -mkOkModal desc body onOk = mkModal desc body (0, [("OK", True)]) onOk onOk +mkOkModal desc body onOk = mkModal desc body (0, [("OK", True)]) onOk continue diff --git a/lib/Labyrinth/UI/Screen/Splash.hs b/lib/Labyrinth/UI/Screen/Splash.hs index c2f0023..ee3e500 100644 --- a/lib/Labyrinth/UI/Screen/Splash.hs +++ b/lib/Labyrinth/UI/Screen/Splash.hs @@ -2,7 +2,6 @@ module Labyrinth.UI.Screen.Splash ( draw , SplashS , initial - , chooseCursor ) where @@ -30,7 +29,3 @@ draw _ = initial :: SplashS initial = SplashS - -chooseCursor - :: SplashS -> Maybe ([CursorLocation Name] -> Maybe (CursorLocation Name)) -chooseCursor _ = Nothing diff --git a/package.yaml b/package.yaml index 3105fb5..d8681c0 100644 --- a/package.yaml +++ b/package.yaml @@ -33,6 +33,7 @@ library: - Labyrinth.Game.Players - Labyrinth.UI - Labyrinth.UI.Modal + - Labyrinth.UI.Debug - Labyrinth.UI.Screen.Splash - Labyrinth.UI.Screen.Setup - Labyrinth.UI.Screen.Game