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:
parent
2fd3e4c9ad
commit
adb3b74c0c
9 changed files with 155 additions and 39 deletions
|
|
@ -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"
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue