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:
parent
6eba471e24
commit
4ef19aa35a
21 changed files with 719 additions and 32 deletions
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue