about summary refs log tree commit diff
path: root/src/Xanthous/Game
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/Game
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/Game')
-rw-r--r--src/Xanthous/Game/Draw.hs35
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)