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