about summary refs log tree commit diff
path: root/users/glittershark/xanthous/src/Xanthous
diff options
context:
space:
mode:
Diffstat (limited to 'users/glittershark/xanthous/src/Xanthous')
-rw-r--r--users/glittershark/xanthous/src/Xanthous/App.hs2
-rw-r--r--users/glittershark/xanthous/src/Xanthous/Game.hs1
-rw-r--r--users/glittershark/xanthous/src/Xanthous/Game/Draw.hs27
-rw-r--r--users/glittershark/xanthous/src/Xanthous/Game/Lenses.hs19
4 files changed, 27 insertions, 22 deletions
diff --git a/users/glittershark/xanthous/src/Xanthous/App.hs b/users/glittershark/xanthous/src/Xanthous/App.hs
index a0913780faef..9091961b725c 100644
--- a/users/glittershark/xanthous/src/Xanthous/App.hs
+++ b/users/glittershark/xanthous/src/Xanthous/App.hs
@@ -217,7 +217,7 @@ handleCommand Close = do
 handleCommand Look = do
   prompt_ @'PointOnMap ["look", "prompt"] Cancellable
     $ \(PointOnMapResult pos) ->
-      use (entities . EntityMap.atPosition pos)
+      gets (revealedEntitiesAtPosition pos)
       >>= \case
         Empty -> say_ ["look", "nothing"]
         ents -> describeEntities ents
diff --git a/users/glittershark/xanthous/src/Xanthous/Game.hs b/users/glittershark/xanthous/src/Xanthous/Game.hs
index 4ca668891971..89c23f0de850 100644
--- a/users/glittershark/xanthous/src/Xanthous/Game.hs
+++ b/users/glittershark/xanthous/src/Xanthous/Game.hs
@@ -17,6 +17,7 @@ module Xanthous.Game
   , updateCharacterVision
   , characterVisiblePositions
   , entitiesAtCharacter
+  , revealedEntitiesAtPosition
 
     -- * Messages
   , MessageHistory(..)
diff --git a/users/glittershark/xanthous/src/Xanthous/Game/Draw.hs b/users/glittershark/xanthous/src/Xanthous/Game/Draw.hs
index 0e1fedc67d19..2375ae8c557e 100644
--- a/users/glittershark/xanthous/src/Xanthous/Game/Draw.hs
+++ b/users/glittershark/xanthous/src/Xanthous/Game/Draw.hs
@@ -12,15 +12,14 @@ import           Brick.Widgets.Edit
 import           Xanthous.Data
 import           Xanthous.Data.App (ResourceName, Panel(..))
 import qualified Xanthous.Data.App as Resource
-import           Xanthous.Data.EntityMap (EntityMap, atPosition)
 import qualified Xanthous.Data.EntityMap as EntityMap
 import           Xanthous.Game.State
 import           Xanthous.Entities.Character
 import           Xanthous.Entities.Item (Item)
 import           Xanthous.Game
                  ( characterPosition
-                 , characterVisiblePositions
                  , character
+                 , revealedEntitiesAtPosition
                  )
 import           Xanthous.Game.Prompt
 import           Xanthous.Orphans ()
@@ -54,28 +53,18 @@ drawPromptState (WaitingPrompt msg (Prompt _ pt ps pri _)) =
       str ("[" <> pure chr <> "] ") <+> txtWrap m
 
 drawEntities
-  :: (Position -> Bool)
-    -- ^ 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
+  :: GameState
   -> Widget ResourceName
-drawEntities isVisible isRevealed allEnts
-  = vBox rows
+drawEntities game = vBox rows
   where
+    allEnts = game ^. entities
     entityPositions = EntityMap.positions allEnts
     maxY = fromMaybe 0 $ maximumOf (folded . y) entityPositions
     maxX = fromMaybe 0 $ maximumOf (folded . x) entityPositions
     rows = mkRow <$> [0..maxY]
     mkRow rowY = hBox $ renderEntityAt . flip Position rowY <$> [0..maxX]
     renderEntityAt 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 $ revealedEntitiesAtPosition pos game
     renderTopEntity pos ents
       = let neighbors = EntityMap.neighbors pos allEnts
         in maybe (str " ") (drawWithNeighbors neighbors)
@@ -86,11 +75,7 @@ drawMap :: GameState -> Widget ResourceName
 drawMap game
   = viewport Resource.MapViewport Both
   . cursorPosition game
-  $ drawEntities
-    (`member` characterVisiblePositions game)
-    (\pos -> (game ^. debugState . allRevealed)
-            || (pos `member` (game ^. revealedPositions)))
-    (game ^. entities)
+  $ drawEntities game
 
 bullet :: Char
 bullet = '•'
diff --git a/users/glittershark/xanthous/src/Xanthous/Game/Lenses.hs b/users/glittershark/xanthous/src/Xanthous/Game/Lenses.hs
index 1f2d21665fdb..6242b855f1cc 100644
--- a/users/glittershark/xanthous/src/Xanthous/Game/Lenses.hs
+++ b/users/glittershark/xanthous/src/Xanthous/Game/Lenses.hs
@@ -12,6 +12,7 @@ module Xanthous.Game.Lenses
   , getInitialState
   , initialStateFromSeed
   , entitiesAtCharacter
+  , revealedEntitiesAtPosition
 
     -- * Collisions
   , Collision(..)
@@ -129,3 +130,21 @@ entitiesAtCharacter = lens getter setter
     getter gs = gs ^. entities . EntityMap.atPosition (gs ^. characterPosition)
     setter gs ents = gs
       & entities . EntityMap.atPosition (gs ^. characterPosition) .~ ents
+
+-- | Returns all entities at the given position that are revealed to the
+-- character.
+--
+-- Concretely, this is either entities that are *currently* visible to the
+-- character, or entities, that are immobile and that the character has seen
+-- before
+revealedEntitiesAtPosition :: Position -> GameState -> (VectorBag SomeEntity)
+revealedEntitiesAtPosition p gs
+  | p `member` characterVisiblePositions gs
+  = entitiesAtPosition
+  | p `member` (gs ^. revealedPositions)
+  = immobileEntitiesAtPosition
+  | otherwise
+  = mempty
+  where
+    entitiesAtPosition = gs ^. entities . EntityMap.atPosition p
+    immobileEntitiesAtPosition = filter (not . entityCanMove) entitiesAtPosition