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 |                  ( move | ||||||
|                  , Dimensions'(Dimensions) |                  , Dimensions'(Dimensions) | ||||||
|                  , positioned |                  , positioned | ||||||
|  |                  , position | ||||||
|                  , Position |                  , Position | ||||||
|                  , Ticks |                  , Ticks | ||||||
|                  , (|*|) |                  , (|*|) | ||||||
|  | @ -195,12 +196,32 @@ handleCommand Close = do | ||||||
|   prompt_ @'DirectionPrompt ["close", "prompt"] Cancellable |   prompt_ @'DirectionPrompt ["close", "prompt"] Cancellable | ||||||
|     $ \(DirectionResult dir) -> do |     $ \(DirectionResult dir) -> do | ||||||
|       pos <- move dir <$> use characterPosition |       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"] |       if | null doors -> say_ ["close", "nothingToClose"] | ||||||
|          | all (view $ _2 . closed) doors -> say_ ["close", "alreadyClosed"] |          | 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 |          | otherwise -> do | ||||||
|              for_ doors $ \(eid, _) -> |              for_ doors $ \(eid, _) -> | ||||||
|                entities . ix eid . positioned . _SomeEntity . closed .= True |                entities . ix eid . positioned . _SomeEntity . closed .= True | ||||||
|  |              for_ nonDoors $ \(eid, _) -> | ||||||
|  |                entities . ix eid . position %= move dir | ||||||
|              say_ ["close", "success"] |              say_ ["close", "success"] | ||||||
|       pure () |       pure () | ||||||
|   stepGame -- TODO |   stepGame -- TODO | ||||||
|  |  | ||||||
|  | @ -66,6 +66,7 @@ instance Brain Creature where | ||||||
| 
 | 
 | ||||||
| instance Entity Creature where | instance Entity Creature where | ||||||
|   blocksVision _ = False |   blocksVision _ = False | ||||||
|  |   blocksObject _ = True | ||||||
|   description = view $ creatureType . Raw.description |   description = view $ creatureType . Raw.description | ||||||
|   entityChar = view $ creatureType . char |   entityChar = view $ creatureType . char | ||||||
|   entityCollision = const $ Just Combat |   entityCollision = const $ Just Combat | ||||||
|  |  | ||||||
|  | @ -47,6 +47,7 @@ deriving via WithOptions '[ FieldLabelModifier '[Drop 1] ] GameState | ||||||
| 
 | 
 | ||||||
| instance Entity SomeEntity where | instance Entity SomeEntity where | ||||||
|   blocksVision (SomeEntity ent) = blocksVision ent |   blocksVision (SomeEntity ent) = blocksVision ent | ||||||
|  |   blocksObject (SomeEntity ent) = blocksObject ent | ||||||
|   description (SomeEntity ent) = description ent |   description (SomeEntity ent) = description ent | ||||||
|   entityChar (SomeEntity ent) = entityChar ent |   entityChar (SomeEntity ent) = entityChar ent | ||||||
|   entityCollision (SomeEntity ent) = entityCollision ent |   entityCollision (SomeEntity ent) = entityCollision ent | ||||||
|  |  | ||||||
|  | @ -295,6 +295,7 @@ instance | ||||||
| 
 | 
 | ||||||
| class Brain a where | class Brain a where | ||||||
|   step :: Ticks -> Positioned a -> AppM (Positioned a) |   step :: Ticks -> Positioned a -> AppM (Positioned a) | ||||||
|  |   -- | Does this entity ever move on its own? | ||||||
|   entityCanMove :: a -> Bool |   entityCanMove :: a -> Bool | ||||||
|   entityCanMove = const False |   entityCanMove = const False | ||||||
| 
 | 
 | ||||||
|  | @ -326,6 +327,12 @@ class ( Show a, Eq a, Ord a, NFData a | ||||||
|       , Draw a, Brain a |       , Draw a, Brain a | ||||||
|       ) => Entity a where |       ) => Entity a where | ||||||
|   blocksVision :: a -> Bool |   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 |   description :: a -> Text | ||||||
|   entityChar :: a -> EntityChar |   entityChar :: a -> EntityChar | ||||||
|   entityCollision :: a -> Maybe Collision |   entityCollision :: a -> Maybe Collision | ||||||
|  | @ -368,6 +375,7 @@ instance Draw SomeEntity where | ||||||
| instance Brain SomeEntity where | instance Brain SomeEntity where | ||||||
|   step ticks (Positioned p (SomeEntity ent)) = |   step ticks (Positioned p (SomeEntity ent)) = | ||||||
|     fmap SomeEntity <$> step ticks (Positioned p ent) |     fmap SomeEntity <$> step ticks (Positioned p ent) | ||||||
|  |   entityCanMove (SomeEntity ent) = entityCanMove ent | ||||||
| 
 | 
 | ||||||
| downcastEntity :: forall (a :: Type). (Typeable a) => SomeEntity -> Maybe a | downcastEntity :: forall (a :: Type). (Typeable a) => SomeEntity -> Maybe a | ||||||
| downcastEntity (SomeEntity e) = cast e | downcastEntity (SomeEntity e) = cast e | ||||||
|  |  | ||||||
|  | @ -45,6 +45,7 @@ close: | ||||||
|     - You shut the door. |     - You shut the door. | ||||||
|   nothingToClose: "There's nothing to close there." |   nothingToClose: "There's nothing to close there." | ||||||
|   alreadyClosed: "That door is already closed." |   alreadyClosed: "That door is already closed." | ||||||
|  |   blocked: "The {{entityDescriptions}} {{blockOrBlocks}} the door!" | ||||||
| 
 | 
 | ||||||
| look: | look: | ||||||
|   prompt: Select a position on the map to describe (use Enter to confirm) |   prompt: Select a position on the map to describe (use Enter to confirm) | ||||||
|  |  | ||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue