about summary refs log tree commit diff
path: root/src/Xanthous/App.hs
diff options
context:
space:
mode:
authorGriffin Smith <root@gws.fyi>2019-09-01T20·21-0400
committerGriffin Smith <root@gws.fyi>2019-09-02T14·52-0400
commitadb3b74c0c3a3bffa0d47f52036fde3623f859f7 (patch)
tree3a2e416ea31f92562ba6eabf0fc4ddf2974b24b7 /src/Xanthous/App.hs
parent2fd3e4c9ad28b77a0d167ceefe879ca80ee1ee04 (diff)
Link up messages to the overall game
Add a "say" function for saying messages within an app monad to the
user, and link everything up to display them and track their history
Diffstat (limited to 'src/Xanthous/App.hs')
-rw-r--r--src/Xanthous/App.hs29
1 files changed, 20 insertions, 9 deletions
diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs
index ae88a746cec6..c543ad468f6d 100644
--- a/src/Xanthous/App.hs
+++ b/src/Xanthous/App.hs
@@ -1,35 +1,46 @@
 module Xanthous.App (makeApp) where
 
 import Xanthous.Prelude
-import Brick hiding (App)
+import Brick hiding (App, halt, continue)
 import qualified Brick
 import Graphics.Vty.Attributes (defAttr)
 import Graphics.Vty.Input.Events (Event(EvKey))
+import Control.Monad.State (get)
 
 import Xanthous.Game
 import Xanthous.Game.Draw (drawGame)
 import Xanthous.Resource (Name)
 import Xanthous.Command
 import Xanthous.Data (move)
+import Xanthous.Monad
 
 type App = Brick.App GameState () Name
+type AppM a = AppT (EventM Name) a
 
 makeApp :: IO App
 makeApp = pure $ Brick.App
   { appDraw = drawGame
   , appChooseCursor = const headMay
-  , appHandleEvent = handleEvent
-  , appStartEvent = pure
+  , appHandleEvent = \state event -> runAppM (handleEvent event) state
+  , appStartEvent = runAppM $ startEvent >> get
   , appAttrMap = const $ attrMap defAttr []
   }
 
-handleEvent :: GameState -> BrickEvent Name () -> EventM Name (Next GameState)
-handleEvent game (VtyEvent (EvKey k mods))
+runAppM :: AppM a -> GameState -> EventM Name a
+runAppM appm = fmap fst . runAppT appm
+
+startEvent :: AppM ()
+startEvent = say ["welcome"]
+
+handleEvent :: BrickEvent Name () -> AppM (Next GameState)
+handleEvent (VtyEvent (EvKey k mods))
   | Just command <- commandFromKey k mods
-  = handleCommand command game
-handleEvent game _ = continue game
+  = handleCommand command
+handleEvent _ = continue
 
-handleCommand :: Command -> GameState -> EventM Name (Next GameState)
+handleCommand :: Command -> AppM (Next GameState)
 handleCommand Quit = halt
-handleCommand (Move dir) = continue . (characterPosition %~ move dir)
+handleCommand (Move dir) = do
+  characterPosition %= move dir
+  continue
 handleCommand _ = error "unimplemented"