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