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
This commit is contained in:
Griffin Smith 2019-09-01 16:21:45 -04:00
parent 2fd3e4c9ad
commit adb3b74c0c
9 changed files with 155 additions and 39 deletions

View file

@ -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))
| Just command <- commandFromKey k mods
= handleCommand command game
handleEvent game _ = continue game
runAppM :: AppM a -> GameState -> EventM Name a
runAppM appm = fmap fst . runAppT appm
handleCommand :: Command -> GameState -> EventM Name (Next GameState)
startEvent :: AppM ()
startEvent = say ["welcome"]
handleEvent :: BrickEvent Name () -> AppM (Next GameState)
handleEvent (VtyEvent (EvKey k mods))
| Just command <- commandFromKey k mods
= handleCommand command
handleEvent _ = continue
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"