Block doors being closed on gormlaks
Prevent closing doors when there's a gormlak or other entity with the blocksObject attribute set to true on the same tile. There's a message sent here which is grammatically incorrect - it says "The a gormlak blocks the door" - should fix that later.
This commit is contained in:
		
							parent
							
								
									308c7eb4f6
								
							
						
					
					
						commit
						782d3880c8
					
				
					 5 changed files with 33 additions and 1 deletions
				
			
		|  | @ -26,6 +26,7 @@ import           Xanthous.Data | |||
|                  ( move | ||||
|                  , Dimensions'(Dimensions) | ||||
|                  , positioned | ||||
|                  , position | ||||
|                  , Position | ||||
|                  , Ticks | ||||
|                  , (|*|) | ||||
|  | @ -195,12 +196,32 @@ handleCommand Close = do | |||
|   prompt_ @'DirectionPrompt ["close", "prompt"] Cancellable | ||||
|     $ \(DirectionResult dir) -> do | ||||
|       pos <- move dir <$> use characterPosition | ||||
|       doors <- uses entities $ entitiesAtPositionWithType @Door pos | ||||
|       (nonDoors, doors) <- uses entities | ||||
|         $ partitionEithers | ||||
|         . toList | ||||
|         . map ( (matching . aside $ _SomeEntity @Door) | ||||
|               . over _2 (view positioned) | ||||
|               ) | ||||
|         . EntityMap.atPositionWithIDs pos | ||||
|       if | null doors -> say_ ["close", "nothingToClose"] | ||||
|          | all (view $ _2 . closed) doors -> say_ ["close", "alreadyClosed"] | ||||
|          | any (blocksObject . snd) nonDoors -> | ||||
|            say ["close", "blocked"] | ||||
|            $ object [ "entityDescriptions" | ||||
|                     A..= ( toSentence . map description . filter blocksObject | ||||
|                          . map snd | ||||
|                          ) nonDoors | ||||
|                     , "blockOrBlocks" | ||||
|                     A..= ( if length nonDoors == 1 | ||||
|                            then "blocks" | ||||
|                            else "block" | ||||
|                          :: Text) | ||||
|                     ] | ||||
|          | otherwise -> do | ||||
|              for_ doors $ \(eid, _) -> | ||||
|                entities . ix eid . positioned . _SomeEntity . closed .= True | ||||
|              for_ nonDoors $ \(eid, _) -> | ||||
|                entities . ix eid . position %= move dir | ||||
|              say_ ["close", "success"] | ||||
|       pure () | ||||
|   stepGame -- TODO | ||||
|  |  | |||
|  | @ -66,6 +66,7 @@ instance Brain Creature where | |||
| 
 | ||||
| instance Entity Creature where | ||||
|   blocksVision _ = False | ||||
|   blocksObject _ = True | ||||
|   description = view $ creatureType . Raw.description | ||||
|   entityChar = view $ creatureType . char | ||||
|   entityCollision = const $ Just Combat | ||||
|  |  | |||
|  | @ -47,6 +47,7 @@ deriving via WithOptions '[ FieldLabelModifier '[Drop 1] ] GameState | |||
| 
 | ||||
| instance Entity SomeEntity where | ||||
|   blocksVision (SomeEntity ent) = blocksVision ent | ||||
|   blocksObject (SomeEntity ent) = blocksObject ent | ||||
|   description (SomeEntity ent) = description ent | ||||
|   entityChar (SomeEntity ent) = entityChar ent | ||||
|   entityCollision (SomeEntity ent) = entityCollision ent | ||||
|  |  | |||
|  | @ -295,6 +295,7 @@ instance | |||
| 
 | ||||
| class Brain a where | ||||
|   step :: Ticks -> Positioned a -> AppM (Positioned a) | ||||
|   -- | Does this entity ever move on its own? | ||||
|   entityCanMove :: a -> Bool | ||||
|   entityCanMove = const False | ||||
| 
 | ||||
|  | @ -326,6 +327,12 @@ class ( Show a, Eq a, Ord a, NFData a | |||
|       , Draw a, Brain a | ||||
|       ) => Entity a where | ||||
|   blocksVision :: a -> Bool | ||||
| 
 | ||||
|   -- | Does this entity block a large object from being put in the same tile as | ||||
|   -- it - eg a a door being closed on it | ||||
|   blocksObject :: a -> Bool | ||||
|   blocksObject = const False | ||||
| 
 | ||||
|   description :: a -> Text | ||||
|   entityChar :: a -> EntityChar | ||||
|   entityCollision :: a -> Maybe Collision | ||||
|  | @ -368,6 +375,7 @@ instance Draw SomeEntity where | |||
| instance Brain SomeEntity where | ||||
|   step ticks (Positioned p (SomeEntity ent)) = | ||||
|     fmap SomeEntity <$> step ticks (Positioned p ent) | ||||
|   entityCanMove (SomeEntity ent) = entityCanMove ent | ||||
| 
 | ||||
| downcastEntity :: forall (a :: Type). (Typeable a) => SomeEntity -> Maybe a | ||||
| downcastEntity (SomeEntity e) = cast e | ||||
|  |  | |||
|  | @ -45,6 +45,7 @@ close: | |||
|     - You shut the door. | ||||
|   nothingToClose: "There's nothing to close there." | ||||
|   alreadyClosed: "That door is already closed." | ||||
|   blocked: "The {{entityDescriptions}} {{blockOrBlocks}} the door!" | ||||
| 
 | ||||
| look: | ||||
|   prompt: Select a position on the map to describe (use Enter to confirm) | ||||
|  |  | |||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue