diff options
author | Griffin Smith <root@gws.fyi> | 2020-02-08T18·42-0500 |
---|---|---|
committer | Griffin Smith <root@gws.fyi> | 2020-02-08T18·42-0500 |
commit | 782d3880c8da35b48276a874d396d24ca6dc7004 (patch) | |
tree | 600fdc2d397db39170ee8057951156928684f2e2 /src/Xanthous | |
parent | 308c7eb4f6cd1e7bb333e438bb4e6c904d9c20ee (diff) |
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.
Diffstat (limited to 'src/Xanthous')
-rw-r--r-- | src/Xanthous/App.hs | 23 | ||||
-rw-r--r-- | src/Xanthous/Entities/Creature.hs | 1 | ||||
-rw-r--r-- | src/Xanthous/Entities/Entities.hs | 1 | ||||
-rw-r--r-- | src/Xanthous/Game/State.hs | 8 | ||||
-rw-r--r-- | src/Xanthous/messages.yaml | 1 |
5 files changed, 33 insertions, 1 deletions
diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 0d4f973d7120..d786eb29daa3 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -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 diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs index a44b3b22813b..cc07b3560c2c 100644 --- a/src/Xanthous/Entities/Creature.hs +++ b/src/Xanthous/Entities/Creature.hs @@ -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 diff --git a/src/Xanthous/Entities/Entities.hs b/src/Xanthous/Entities/Entities.hs index 1b9f138fe22f..710e577be866 100644 --- a/src/Xanthous/Entities/Entities.hs +++ b/src/Xanthous/Entities/Entities.hs @@ -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 diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs index e5ee66deac45..5c9130de386a 100644 --- a/src/Xanthous/Game/State.hs +++ b/src/Xanthous/Game/State.hs @@ -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 diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml index 4efcc8dbc324..ed592e26507e 100644 --- a/src/Xanthous/messages.yaml +++ b/src/Xanthous/messages.yaml @@ -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) |