Factor out an "entitiesAtCharacter" lens

Factor an "entitiesAtCharacter" lens from the one-two step of getting
the character position, then getting the entities at that position.
This commit is contained in:
Griffin Smith 2020-01-25 11:18:32 -05:00
parent 2fc4fcfee9
commit 9256c976ed
3 changed files with 13 additions and 8 deletions

View file

@ -167,8 +167,7 @@ handleCommand Drop = do
selectItemFromInventory_ ["drop", "menu"] Cancellable id
(say_ ["drop", "nothing"])
$ \(MenuResult item) -> do
charPos <- use characterPosition
entities . EntityMap.atPosition charPos %= (SomeEntity item <|)
entitiesAtCharacter %= (SomeEntity item <|)
say ["drop", "dropped"] $ object [ "item" A..= item ]
continue
@ -277,9 +276,7 @@ handleCommand Save = do
exitSuccess
handleCommand GoUp = do
charPos <- use characterPosition
hasStairs <- uses (entities . EntityMap.atPosition charPos)
$ elem (SomeEntity UpStaircase)
hasStairs <- uses entitiesAtCharacter $ elem (SomeEntity UpStaircase)
if hasStairs
then uses levels prevLevel >>= \case
Just levs' -> levels .= levs'
@ -291,9 +288,7 @@ handleCommand GoUp = do
continue
handleCommand GoDown = do
charPos <- use characterPosition
hasStairs <- uses (entities . EntityMap.atPosition charPos)
$ elem (SomeEntity DownStaircase)
hasStairs <- uses entitiesAtCharacter $ elem (SomeEntity DownStaircase)
if hasStairs
then do

View file

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

View file

@ -10,6 +10,7 @@ module Xanthous.Game.Lenses
, characterVisiblePositions
, getInitialState
, initialStateFromSeed
, entitiesAtCharacter
-- * Collisions
, Collision(..)
@ -28,6 +29,7 @@ import Xanthous.Data
import Xanthous.Data.Levels
import qualified Xanthous.Data.EntityMap as EntityMap
import Xanthous.Data.EntityMap.Graphics (visiblePositions)
import Xanthous.Data.VectorBag
import Xanthous.Entities.Character (Character, mkCharacter)
import {-# SOURCE #-} Xanthous.Entities.Entities ()
--------------------------------------------------------------------------------
@ -113,3 +115,10 @@ entitiesCollision = join . maximumMay . fmap entityCollision
collisionAt :: MonadState GameState m => Position -> m (Maybe Collision)
collisionAt p = uses (entities . EntityMap.atPosition p) entitiesCollision
entitiesAtCharacter :: Lens' GameState (VectorBag SomeEntity)
entitiesAtCharacter = lens getter setter
where
getter gs = gs ^. entities . EntityMap.atPosition (gs ^. characterPosition)
setter gs ents = gs
& entities . EntityMap.atPosition (gs ^. characterPosition) .~ ents