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
|
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
|
||||||
|
|
|
@ -16,6 +16,7 @@ module Xanthous.Game
|
||||||
, characterPosition
|
, characterPosition
|
||||||
, updateCharacterVision
|
, updateCharacterVision
|
||||||
, characterVisiblePositions
|
, characterVisiblePositions
|
||||||
|
, entitiesAtCharacter
|
||||||
|
|
||||||
-- * Messages
|
-- * Messages
|
||||||
, MessageHistory(..)
|
, MessageHistory(..)
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue