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:
parent
2fc4fcfee9
commit
9256c976ed
3 changed files with 13 additions and 8 deletions
|
@ -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
|
||||
|
|
|
@ -16,6 +16,7 @@ module Xanthous.Game
|
|||
, characterPosition
|
||||
, updateCharacterVision
|
||||
, characterVisiblePositions
|
||||
, entitiesAtCharacter
|
||||
|
||||
-- * Messages
|
||||
, MessageHistory(..)
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue