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.
This commit is contained in:
Griffin Smith 2019-08-31 13:17:27 -04:00
parent 6eba471e24
commit 4ef19aa35a
21 changed files with 719 additions and 32 deletions

View file

@ -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?"
drawMap :: GameState -> Widget Name
drawMap _game
= viewport MapViewport Both
$ vBox mapRows
drawEntities :: (Draw a, Show a) => EntityMap a -> Widget Name
drawEntities em@(fromNullable . positions -> Just entityPositions)
= vBox rows
where
-- TODO
firstRow = [str "@"] <> replicate 79 (str " ")
mapRows = firstRow <> (replicate 20 . hBox . replicate 80 $ str " ")
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
= viewport MapViewport Both
. 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)