From 4ef19aa35a6d63a8d9f7b6a7a11ac82c2a525783 Mon Sep 17 00:00:00 2001
From: Griffin Smith <root@gws.fyi>
Date: Sat, 31 Aug 2019 13:17:27 -0400
Subject: 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.
---
 src/Xanthous/App.hs | 16 +++++++++++++++-
 1 file changed, 15 insertions(+), 1 deletion(-)

(limited to 'src/Xanthous/App.hs')

diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs
index 5c0383c38e19..bf5ec68abb0d 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
-- 
cgit 1.4.1