fix(xan): Don't allow looking at invisible things

Extract the conditional we're using to decide whether or not to render a
given entity at a position, and use that when getting the list of
entities to describe as a result of the "Look" command.

Change-Id: I1ec86211c2fcbd984dd52338fb5631667c22c723
Reviewed-on: https://cl.tvl.fyi/c/depot/+/903
Reviewed-by: glittershark <grfn@gws.fyi>
Reviewed-by: BuildkiteCI
Tested-by: BuildkiteCI
This commit is contained in:
Griffin Smith 2020-07-03 13:40:17 -04:00 committed by glittershark
parent 361ffd42d7
commit 26bb34823d
4 changed files with 27 additions and 22 deletions

View file

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

View file

@ -17,6 +17,7 @@ module Xanthous.Game
, updateCharacterVision
, characterVisiblePositions
, entitiesAtCharacter
, revealedEntitiesAtPosition
-- * Messages
, MessageHistory(..)

View file

@ -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 = '•'

View file

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