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

View file

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

View file

@ -10,6 +10,7 @@ module Xanthous.Game.Lenses
, characterVisiblePositions , characterVisiblePositions
, getInitialState , getInitialState
, initialStateFromSeed , initialStateFromSeed
, entitiesAtCharacter
-- * Collisions -- * Collisions
, Collision(..) , Collision(..)
@ -28,6 +29,7 @@ import Xanthous.Data
import Xanthous.Data.Levels import Xanthous.Data.Levels
import qualified Xanthous.Data.EntityMap as EntityMap import qualified Xanthous.Data.EntityMap as EntityMap
import Xanthous.Data.EntityMap.Graphics (visiblePositions) import Xanthous.Data.EntityMap.Graphics (visiblePositions)
import Xanthous.Data.VectorBag
import Xanthous.Entities.Character (Character, mkCharacter) import Xanthous.Entities.Character (Character, mkCharacter)
import {-# SOURCE #-} Xanthous.Entities.Entities () import {-# SOURCE #-} Xanthous.Entities.Entities ()
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -113,3 +115,10 @@ entitiesCollision = join . maximumMay . fmap entityCollision
collisionAt :: MonadState GameState m => Position -> m (Maybe Collision) collisionAt :: MonadState GameState m => Position -> m (Maybe Collision)
collisionAt p = uses (entities . EntityMap.atPosition p) entitiesCollision 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