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.

3 files changed, 44 insertions, 25 deletions

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
     )
 
 --------------------------------------------------------------------------------