From 5c5aa14a3dcb5c172eaf8d2236b41020c8e92051 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Fri, 3 Jan 2020 12:04:08 -0500 Subject: 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. --- src/Xanthous/AI/Gormlak.hs | 5 ++++- src/Xanthous/Game.hs | 1 + src/Xanthous/Game/Draw.hs | 53 +++++++++++++++++++++++++++------------------ src/Xanthous/Game/Lenses.hs | 13 +++++++---- src/Xanthous/Game/State.hs | 3 +++ 5 files changed, 49 insertions(+), 26 deletions(-) diff --git a/src/Xanthous/AI/Gormlak.hs b/src/Xanthous/AI/Gormlak.hs index 8b30bc2c9de0..3e950f67f364 100644 --- a/src/Xanthous/AI/Gormlak.hs +++ b/src/Xanthous/AI/Gormlak.hs @@ -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 diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs index 14b8230218ab..094858618dbf 100644 --- a/src/Xanthous/Game.hs +++ b/src/Xanthous/Game.hs @@ -14,6 +14,7 @@ module Xanthous.Game , character , characterPosition , updateCharacterVision + , characterVisiblePositions -- * Messages , MessageHistory(..) diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index d98b48c02742..8a86101d9915 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -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 diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs index 853f758385b1..4a080f85f017 100644 --- a/src/Xanthous/Game/Lenses.hs +++ b/src/Xanthous/Game/Lenses.hs @@ -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 diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs index 0ba7b2744a80..853d0b6922d1 100644 --- a/src/Xanthous/Game/State.hs +++ b/src/Xanthous/Game/State.hs @@ -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 ) -------------------------------------------------------------------------------- -- cgit 1.4.1