Add entities, and allow walking around

Add support for entities via a port of the EntityMap type, and implement
command support starting at basic hjkl.
This commit is contained in:
Griffin Smith 2019-08-31 13:17:27 -04:00
parent 6eba471e24
commit 4ef19aa35a
21 changed files with 719 additions and 32 deletions

View file

@ -4,10 +4,13 @@ import Xanthous.Prelude
import Brick hiding (App)
import qualified Brick
import Graphics.Vty.Attributes (defAttr)
import Graphics.Vty.Input.Events (Event(EvResize, EvKey))
import Xanthous.Game
import Xanthous.Game.Draw (drawGame)
import Xanthous.Resource (Name)
import Xanthous.Command
import Xanthous.Data (move)
type App = Brick.App GameState () Name
@ -15,7 +18,18 @@ makeApp :: IO App
makeApp = pure $ Brick.App
{ appDraw = drawGame
, appChooseCursor = const headMay
, appHandleEvent = resizeOrQuit
, appHandleEvent = handleEvent
, appStartEvent = pure
, 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
handleCommand :: Command -> GameState -> EventM Name (Next GameState)
handleCommand Quit = halt
handleCommand (Move dir) = continue . (characterPosition %~ move dir)
handleCommand _ = undefined