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

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

src/Xanthous/Game.hs

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

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

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

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