From dd1616666593f65bab70f1363b5d040fe5edd054 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Fri, 20 Sep 2019 19:38:16 -0400 Subject: Describe what you see when you walk over items Every step the character takes, describe the entities at that position excluding the character. --- src/Xanthous/App.hs | 18 +++++++++++++++++- src/Xanthous/Entities.hs | 3 +++ src/Xanthous/Entities/Character.hs | 1 + src/Xanthous/Entities/Creature.hs | 12 +++++++----- src/Xanthous/Entities/Environment.hs | 2 ++ src/Xanthous/Entities/Item.hs | 15 +++++++++------ src/Xanthous/Entities/Raws/noodles.yaml | 2 +- src/Xanthous/Util/Inflection.hs | 15 +++++++++++++++ src/Xanthous/messages.yaml | 3 +++ 9 files changed, 58 insertions(+), 13 deletions(-) create mode 100644 src/Xanthous/Util/Inflection.hs (limited to 'src/Xanthous') diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index df0b30c41b..fce2beed13 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -8,7 +8,8 @@ import qualified Brick import Brick.Widgets.Edit (handleEditorEvent) import Graphics.Vty.Attributes (defAttr) import Graphics.Vty.Input.Events (Event(EvKey), Key(..)) -import Control.Monad.State (get, state, StateT(..)) +import Control.Monad.State (get, state, StateT(..), MonadState) +import Control.Monad.Random (MonadRandom) import Data.Coerce import Control.Monad.State.Class (modify) import Data.Aeson (object, ToJSON) @@ -29,12 +30,14 @@ import Xanthous.Game.Prompt import Xanthous.Monad import Xanthous.Resource (Name) import Xanthous.Messages (message) +import Xanthous.Util.Inflection (toSentence) -------------------------------------------------------------------------------- import qualified Xanthous.Entities.Character as Character import Xanthous.Entities.Character (characterName) import Xanthous.Entities import Xanthous.Entities.Item (Item) import Xanthous.Entities.Environment (Door, open, locked) +import Xanthous.Entities.Character import Xanthous.Generators import qualified Xanthous.Generators.CaveAutomata as CaveAutomata -------------------------------------------------------------------------------- @@ -93,6 +96,7 @@ handleCommand (Move dir) = do collisionAt newPos >>= \case Nothing -> do characterPosition .= newPos + describeEntitiesAt newPos modify updateCharacterVision Just Combat -> undefined Just Stop -> pure () @@ -198,3 +202,15 @@ entitiesAtPositionWithType pos em = case downcastEntity @a se of Just e -> [(eid, e)] Nothing -> [] + +describeEntitiesAt :: (MonadState GameState m, MonadRandom m) => Position -> m () +describeEntitiesAt pos = + use ( entities + . EntityMap.atPosition pos + . to (filter (not . entityIs @Character)) + ) >>= \case + Empty -> pure () + ents -> + let descriptions = description <$> ents + in say ["entities", "description"] $ object + ["entityDescriptions" A..= toSentence descriptions] diff --git a/src/Xanthous/Entities.hs b/src/Xanthous/Entities.hs index e47e820f27..66a583f6b3 100644 --- a/src/Xanthous/Entities.hs +++ b/src/Xanthous/Entities.hs @@ -38,9 +38,11 @@ import Xanthous.Orphans () class (Show a, Eq a, Draw a) => Entity a where blocksVision :: a -> Bool + description :: a -> Text instance Entity a => Entity (Positioned a) where blocksVision (Positioned _ ent) = blocksVision ent + description (Positioned _ ent) = description ent -------------------------------------------------------------------------------- data SomeEntity where @@ -59,6 +61,7 @@ instance Draw SomeEntity where instance Entity SomeEntity where blocksVision (SomeEntity ent) = blocksVision ent + description (SomeEntity ent) = description ent downcastEntity :: (Entity a, Typeable a) => SomeEntity -> Maybe a downcastEntity (SomeEntity e) = cast e diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index 695d7bb0d0..924c1857a8 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -41,6 +41,7 @@ instance Draw Character where instance Entity Character where blocksVision _ = False + description _ = "yourself" instance Arbitrary Character where arbitrary = genericArbitrary diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs index b59cceab40..c660a6cdf5 100644 --- a/src/Xanthous/Entities/Creature.hs +++ b/src/Xanthous/Entities/Creature.hs @@ -9,13 +9,14 @@ module Xanthous.Entities.Creature , damage ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude +import Xanthous.Prelude -------------------------------------------------------------------------------- -import Data.Word -import Test.QuickCheck.Arbitrary.Generic +import Data.Word +import Test.QuickCheck.Arbitrary.Generic -------------------------------------------------------------------------------- -import Xanthous.Entities.RawTypes hiding (Creature) -import Xanthous.Entities (Draw(..), Entity(..), DrawRawChar(..)) +import Xanthous.Entities.RawTypes hiding (Creature, description) +import qualified Xanthous.Entities.RawTypes as Raw +import Xanthous.Entities (Draw(..), Entity(..), DrawRawChar(..)) -------------------------------------------------------------------------------- data Creature = Creature @@ -31,6 +32,7 @@ instance Arbitrary Creature where instance Entity Creature where blocksVision _ = False + description = view $ creatureType . Raw.description newWithType :: CreatureType -> Creature newWithType _creatureType = diff --git a/src/Xanthous/Entities/Environment.hs b/src/Xanthous/Entities/Environment.hs index d9275266b0..4ef67a577d 100644 --- a/src/Xanthous/Entities/Environment.hs +++ b/src/Xanthous/Entities/Environment.hs @@ -24,6 +24,7 @@ data Wall = Wall instance Entity Wall where blocksVision _ = True + description _ = "a wall" instance Arbitrary Wall where arbitrary = pure Wall @@ -65,3 +66,4 @@ instance Draw Door where instance Entity Door where blocksVision = not . view open + description _ = "a door" diff --git a/src/Xanthous/Entities/Item.hs b/src/Xanthous/Entities/Item.hs index baf4be2f54..6b50f50ad8 100644 --- a/src/Xanthous/Entities/Item.hs +++ b/src/Xanthous/Entities/Item.hs @@ -1,17 +1,19 @@ {-# LANGUAGE TemplateHaskell #-} +-------------------------------------------------------------------------------- module Xanthous.Entities.Item ( Item(..) , itemType , newWithType ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude -import Test.QuickCheck -import Data.Aeson (ToJSON, FromJSON) -import Data.Aeson.Generic.DerivingVia +import Xanthous.Prelude +import Test.QuickCheck +import Data.Aeson (ToJSON, FromJSON) +import Data.Aeson.Generic.DerivingVia -------------------------------------------------------------------------------- -import Xanthous.Entities.RawTypes hiding (Item) -import Xanthous.Entities (Draw(..), Entity(..), DrawRawChar(..)) +import Xanthous.Entities.RawTypes hiding (Item, description) +import qualified Xanthous.Entities.RawTypes as Raw +import Xanthous.Entities (Draw(..), Entity(..), DrawRawChar(..)) -------------------------------------------------------------------------------- data Item = Item @@ -30,6 +32,7 @@ instance Arbitrary Item where instance Entity Item where blocksVision _ = False + description = view $ itemType . Raw.description newWithType :: ItemType -> Item newWithType = Item diff --git a/src/Xanthous/Entities/Raws/noodles.yaml b/src/Xanthous/Entities/Raws/noodles.yaml index 120087d483..91a0a35388 100644 --- a/src/Xanthous/Entities/Raws/noodles.yaml +++ b/src/Xanthous/Entities/Raws/noodles.yaml @@ -1,6 +1,6 @@ Item: name: noodles - description: a big bowl o' noodles + description: "a big bowl o' noodles" longDescription: You know exactly what kind of noodles char: char: 'n' diff --git a/src/Xanthous/Util/Inflection.hs b/src/Xanthous/Util/Inflection.hs new file mode 100644 index 0000000000..fc66c08761 --- /dev/null +++ b/src/Xanthous/Util/Inflection.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE ViewPatterns #-} + +module Xanthous.Util.Inflection + ( toSentence + ) where + +import Xanthous.Prelude + +toSentence :: (MonoFoldable mono, Element mono ~ Text) => mono -> Text +toSentence xs = case reverse . toList $ xs of + [] -> "" + [x] -> x + [b, a] -> a <> " and " <> b + (final : butlast) -> + intercalate ", " (reverse butlast) <> ", and " <> final diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml index ef4f09543d..4d7b0003fa 100644 --- a/src/Xanthous/messages.yaml +++ b/src/Xanthous/messages.yaml @@ -1,5 +1,8 @@ welcome: Welcome to Xanthous, {{characterName}}! It's dangerous out there, why not stay inside? +entities: + description: You see here {{entityDescriptions}} + items: pickUp: You pick up the {{item.itemType.name}} nothingToPickUp: "There's nothing here to pick up" -- cgit 1.4.1