diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 0d4f973d7..d786eb29d 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 a44b3b228..cc07b3560 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 1b9f138fe..710e577be 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 e5ee66dea..5c9130de3 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 4efcc8dbc..ed592e265 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)