about summary refs log tree commit diff
path: root/src/Xanthous/App.hs
diff options
context:
space:
mode:
authorGriffin Smith <root@gws.fyi>2019-08-31T17·17-0400
committerGriffin Smith <root@gws.fyi>2019-08-31T17·18-0400
commit4ef19aa35a6d63a8d9f7b6a7a11ac82c2a525783 (patch)
tree00a0109cca42bbdda93fa117142d381501c1bf00 /src/Xanthous/App.hs
parent6eba471e2426e7e4e7d5c935e3ce973e13fd6b24 (diff)
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.
Diffstat (limited to 'src/Xanthous/App.hs')
-rw-r--r--src/Xanthous/App.hs16
1 files changed, 15 insertions, 1 deletions
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