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.

1 files changed, 15 insertions, 1 deletions

diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs
index 5c0383c38e..bf5ec68abb 100644
--- a/src/Xanthous/App.hs
+++ b/src/Xanthous/App.hs
@@ -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