diff options
Diffstat (limited to 'users/glittershark/xanthous/src/Xanthous')
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 |