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…
	
	Add table
		Add a link
		
	
		Reference in a new issue