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, 26 insertions, 9 deletions

diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs
index 2d793ba27bd5..79089029ea8d 100644
--- a/src/Xanthous/Game/Draw.hs
+++ b/src/Xanthous/Game/Draw.hs
@@ -1,28 +1,45 @@
+{-# LANGUAGE ViewPatterns #-}
+
 module Xanthous.Game.Draw
   ( drawGame
   ) where
 
 import Xanthous.Prelude
-import Brick
+import Brick hiding (loc)
 import Brick.Widgets.Border
 import Brick.Widgets.Border.Style
 
-import Xanthous.Game (GameState(..))
+import Xanthous.Data (Position(Position), x, y, loc)
+import Xanthous.Data.EntityMap
+import Xanthous.Entities
+import Xanthous.Game (GameState(..), entities, characterPosition)
 import Xanthous.Resource (Name(..))
 
 drawMessages :: GameState -> Widget Name
 drawMessages _ = str "Welcome to Xanthous! It's dangerous out there, why not stay inside?"
 
+drawEntities :: (Draw a, Show a) => EntityMap a -> Widget Name
+drawEntities em@(fromNullable . positions -> Just entityPositions)
+  = vBox rows
+  where
+    maxPosition = maximum entityPositions
+    maxY = maxPosition ^. y
+    maxX = maxPosition ^. x
+    rows = mkRow <$> [0..maxY]
+    mkRow rowY = hBox $ renderEntityAt . flip Position rowY <$> [0..maxX]
+    renderEntityAt pos = maybe (str " ") draw $ em ^? atPosition pos . folded
+drawEntities _ = emptyWidget
+
 drawMap :: GameState -> Widget Name
-drawMap _game
+drawMap game
   = viewport MapViewport Both
-  $ vBox mapRows
-  where
-    -- TODO
-    firstRow = [str "@"] <> replicate 79 (str " ")
-    mapRows = firstRow <> (replicate 20 . hBox . replicate 80 $ str " ")
+  . showCursor Character (game ^. characterPosition . loc)
+  . drawEntities
+  $ game ^. entities
 
 drawGame :: GameState -> [Widget Name]
-drawGame game = pure . withBorderStyle unicode
+drawGame game
+  = pure
+  . withBorderStyle unicode
   $   drawMessages game
   <=> border (drawMap game)