Don't render moving entities that aren't visible

When the character walks away from or around the corner from entities
that move such that they're no longer visible, stop rendering them.
Still render static entities like walls, doors, and items though. This
prevents entities walking into a "revealed position" after the
character's left being visible despite not being in a line of sight any
more.
This commit is contained in:
Griffin Smith 2020-01-03 12:04:08 -05:00
parent 14997bc1a3
commit 5c5aa14a3d
5 changed files with 49 additions and 26 deletions

View file

@ -90,10 +90,13 @@ newtype GormlakBrain = GormlakBrain Creature
instance Brain GormlakBrain where
step ticks = fmap coerce . stepGormlak ticks . coerce
entityCanMove = const True
--------------------------------------------------------------------------------
instance Brain Creature where step = brainVia GormlakBrain
instance Brain Creature where
step = brainVia GormlakBrain
entityCanMove = const True
instance Entity Creature where
blocksVision _ = False

View file

@ -14,6 +14,7 @@ module Xanthous.Game
, character
, characterPosition
, updateCharacterVision
, characterVisiblePositions
-- * Messages
, MessageHistory(..)

View file

@ -20,6 +20,7 @@ import Xanthous.Game
, entities
, revealedPositions
, characterPosition
, characterVisiblePositions
, character
, MessageHistory(..)
, messageHistory
@ -62,10 +63,12 @@ drawPromptState (WaitingPrompt msg (Prompt _ pt ps pri _)) =
drawEntities
:: (Position -> Bool)
-- ^ Can we render a given position?
-- ^ Is a given position directly visible to the character?
-> (Position -> Bool)
-- ^ Has a given position *ever* been seen by the character?
-> EntityMap SomeEntity -- ^ all entities
-> Widget Name
drawEntities canRenderPos allEnts
drawEntities isVisible isRevealed allEnts
= vBox rows
where
entityPositions = EntityMap.positions allEnts
@ -74,23 +77,27 @@ drawEntities canRenderPos allEnts
rows = mkRow <$> [0..maxY]
mkRow rowY = hBox $ renderEntityAt . flip Position rowY <$> [0..maxX]
renderEntityAt pos
| canRenderPos pos
= let entitiesAtPosition = allEnts ^. atPosition pos
immobileEntitiesAtPosition =
filter (not . entityCanMove) entitiesAtPosition
in renderTopEntity pos
$ if | isVisible pos -> entitiesAtPosition
| isRevealed pos -> immobileEntitiesAtPosition
| otherwise -> mempty
renderTopEntity pos ents
= let neighbors = EntityMap.neighbors pos allEnts
in maybe (str " ") (drawWithNeighbors neighbors)
$ maximumByOf
(atPosition pos . folded)
(compare `on` drawPriority)
allEnts
| otherwise = str " "
$ maximumBy (compare `on` drawPriority)
<$> fromNullable ents
drawMap :: GameState -> Widget Name
drawMap game
= viewport Resource.MapViewport Both
. cursorPosition game
$ drawEntities
(\pos ->
(game ^. debugState . allRevealed)
|| (pos `member` (game ^. revealedPositions)))
(\pos -> (game ^. debugState . allRevealed)
|| (pos `member` (game ^. revealedPositions)))
(`member` characterVisiblePositions game)
-- FIXME: this will break down as soon as creatures can walk around on their
-- own, since we don't want to render things walking around when the
-- character can't see them
@ -99,17 +106,11 @@ drawMap game
bullet :: Char
bullet = '•'
drawPanel :: GameState -> Panel -> Widget Name
drawPanel game panel
= border
. hLimit 35
. viewport (Resource.Panel panel) Vertical
$ case panel of
InventoryPanel ->
drawWielded (game ^. character . inventory . wielded)
<=> drawBackpack (game ^. character . inventory . backpack)
drawInventoryPanel :: GameState -> Widget Name
drawInventoryPanel game
= drawWielded (game ^. character . inventory . wielded)
<=> drawBackpack (game ^. character . inventory . backpack)
where
drawWielded :: Wielded -> Widget Name
drawWielded (Hands Nothing Nothing) = emptyWidget
drawWielded (DoubleHanded i) =
txtWrap $ "You are holding " <> description i <> " in both hands"
@ -132,6 +133,16 @@ drawPanel game panel
(txtWrap . ((bullet <| " ") <>) . description)
backpackItems)
drawPanel :: GameState -> Panel -> Widget Name
drawPanel game panel
= border
. hLimit 35
. viewport (Resource.Panel panel) Vertical
. case panel of
InventoryPanel -> drawInventoryPanel
$ game
drawCharacterInfo :: Character -> Widget Name
drawCharacterInfo ch = txt " " <+> charName <+> charHitpoints
where

View file

@ -5,6 +5,7 @@ module Xanthous.Game.Lenses
, character
, characterPosition
, updateCharacterVision
, characterVisiblePositions
, getInitialState
, initialStateFromSeed
@ -84,12 +85,16 @@ characterPosition = positionedCharacter . position
visionRadius :: Word
visionRadius = 12 -- TODO make this dynamic
-- | Update the revealed entities at the character's position based on their vision
-- | Update the revealed entities at the character's position based on their
-- vision
updateCharacterVision :: GameState -> GameState
updateCharacterVision game =
updateCharacterVision game
= game & revealedPositions <>~ characterVisiblePositions game
characterVisiblePositions :: GameState -> Set Position
characterVisiblePositions game =
let charPos = game ^. characterPosition
visible = visiblePositions charPos visionRadius $ game ^. entities
in game & revealedPositions <>~ visible
in visiblePositions charPos visionRadius $ game ^. entities
data Collision
= Stop

View file

@ -287,6 +287,8 @@ instance
class Brain a where
step :: Ticks -> Positioned a -> AppM (Positioned a)
entityCanMove :: a -> Bool
entityCanMove = const False
newtype Brainless a = Brainless a
@ -429,6 +431,7 @@ instance Eq GameState where
, gs ^. messageHistory
, gs ^. sentWelcome
, gs ^. activePanel
, gs ^. debugState
)
--------------------------------------------------------------------------------