From bf79617bd844697258d0a87157b7ceb50597e37d Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 13 Jun 2021 23:03:15 -0400 Subject: feat(xanthous): Gormlaks yell in gormlak when they see the character Add a new "greetedCharacter" field to the creature hippocampus type, which tracks whether or not that creature has greeted the character yet. In the gormlak AI, when the gormlak sees the character and starts running towards them, if that field is set to False send a message that says that the gormlak yells a single randomly-generated gormlak word at the character, then set the field to true The gormlak yells "gukblom"! Change-Id: I17a388393693a322c2e09390884ed718911b2fc4 Reviewed-on: https://cl.tvl.fyi/c/depot/+/3207 Reviewed-by: grfn Tested-by: BuildkiteCI --- users/grfn/xanthous/src/Xanthous/AI/Gormlak.hs | 90 ++++++++++++++++------ .../src/Xanthous/Entities/Creature/Hippocampus.hs | 12 ++- .../xanthous/src/Xanthous/Entities/RawTypes.hs | 3 + .../src/Xanthous/Entities/Raws/gormlak.yaml | 1 + users/grfn/xanthous/src/Xanthous/Game/Lenses.hs | 16 +++- users/grfn/xanthous/src/Xanthous/messages.yaml | 4 + 6 files changed, 98 insertions(+), 28 deletions(-) diff --git a/users/grfn/xanthous/src/Xanthous/AI/Gormlak.hs b/users/grfn/xanthous/src/Xanthous/AI/Gormlak.hs index a6cc789d68..a7938c1225 100644 --- a/users/grfn/xanthous/src/Xanthous/AI/Gormlak.hs +++ b/users/grfn/xanthous/src/Xanthous/AI/Gormlak.hs @@ -15,7 +15,7 @@ import qualified Data.Aeson as A import Data.Generics.Product.Fields -------------------------------------------------------------------------------- import Xanthous.Data - ( Positioned(..), positioned, position + ( Positioned(..), positioned, position, _Position , diffPositions, stepTowards, isUnit , Ticks, (|*|), invertedRate ) @@ -24,15 +24,18 @@ import Xanthous.Entities.Creature.Hippocampus import Xanthous.Entities.Character (Character) import qualified Xanthous.Entities.Character as Character import qualified Xanthous.Entities.RawTypes as Raw -import Xanthous.Entities.RawTypes (CreatureType) +import Xanthous.Entities.RawTypes (CreatureType, HasLanguage (language), getLanguage) import Xanthous.Game.State import Xanthous.Game.Lenses ( entitiesCollision, collisionAt - , character, characterPosition + , character, characterPosition, positionIsCharacterVisible + , hearingRadius ) import Xanthous.Data.EntityMap.Graphics (linesOfSight, canSee) import Xanthous.Random import Xanthous.Monad (say) +import Xanthous.Generators.Speech (word) +import qualified Linear.Metric as Metric -------------------------------------------------------------------------------- -- TODO move the following two classes to a more central location @@ -57,6 +60,28 @@ stepGormlak -> Positioned entity -> m (Positioned entity) stepGormlak ticks pe@(Positioned pos creature) = do + canSeeCharacter <- uses entities $ canSee (entityIs @Character) pos vision + + let selectDestination pos' creature' = destinationFromPos <$> do + if canSeeCharacter + then do + charPos <- use characterPosition + if isUnit (pos' `diffPositions` charPos) + then attackCharacter $> pos' + else pure $ pos' `stepTowards` charPos + else do + lines <- map (takeWhile (isNothing . entitiesCollision . map snd . snd) + -- the first item on these lines is always the creature itself + . fromMaybe mempty . tailMay) + . linesOfSight pos' (visionRadius creature') + <$> use entities + line <- choose $ weightedBy length lines + pure $ fromMaybe pos' $ fmap fst . headMay =<< line + + pe' <- if canSeeCharacter && not (creature ^. creatureGreeted) + then yellAtCharacter $> (pe & positioned . creatureGreeted .~ True) + else pure pe + dest <- maybe (selectDestination pos creature) pure $ creature ^. field @"_hippocampus" . destination let progress' = @@ -64,7 +89,7 @@ stepGormlak ticks pe@(Positioned pos creature) = do + creature ^. field @"_creatureType" . Raw.speed . invertedRate |*| ticks if progress' < 1 then pure - $ pe + $ pe' & positioned . field @"_hippocampus" . destination ?~ (dest & destinationProgress .~ progress') else do @@ -72,37 +97,54 @@ stepGormlak ticks pe@(Positioned pos creature) = do remainingSpeed = progress' - 1 newDest <- selectDestination newPos creature <&> destinationProgress +~ remainingSpeed - let pe' = pe & positioned . field @"_hippocampus" . destination ?~ newDest + let pe'' = pe' & positioned . field @"_hippocampus" . destination ?~ newDest collisionAt newPos >>= \case - Nothing -> pure $ pe' & position .~ newPos - Just Stop -> pure pe' + Nothing -> pure $ pe'' & position .~ newPos + Just Stop -> pure pe'' Just Combat -> do ents <- use $ entities . atPosition newPos when (any (entityIs @Character) ents) attackCharacter pure pe' where - selectDestination pos' creature' = destinationFromPos <$> do - canSeeCharacter <- uses entities $ canSee (entityIs @Character) pos' vision - if canSeeCharacter - then do - charPos <- use characterPosition - if isUnit (pos' `diffPositions` charPos) - then attackCharacter $> pos' - else pure $ pos' `stepTowards` charPos - else do - lines <- map (takeWhile (isNothing . entitiesCollision . map snd . snd) - -- the first item on these lines is always the creature itself - . fromMaybe mempty . tailMay) - . linesOfSight pos' (visionRadius creature') - <$> use entities - line <- choose $ weightedBy length lines - pure $ fromMaybe pos' $ fmap fst . headMay =<< line - vision = visionRadius creature attackCharacter = do say ["combat", "creatureAttack"] $ object [ "creature" A..= creature ] character %= Character.damage 1 + yellAtCharacter = for_ (creature ^. field @"_creatureType" . language) + $ \lang -> do + utterance <- fmap (<> "!") . word $ getLanguage lang + creatureSaysText pe utterance + + creatureGreeted :: Lens' entity Bool + creatureGreeted = field @"_hippocampus" . greetedCharacter + + +-- | A creature sends some text +-- +-- If that creature is visible to the character, its description will be +-- included, otherwise if it's within earshot the character will just hear the +-- sound +creatureSaysText + :: (MonadState GameState m, MonadRandom m, IsCreature entity) + => Positioned entity + -> Text + -> m () +creatureSaysText ent txt = do + let entPos = ent ^. position . _Position . to (fmap fromIntegral) + charPos <- use $ characterPosition . _Position . to (fmap fromIntegral) + let dist :: Int + dist = round $ Metric.distance @_ @Double entPos charPos + audible = dist <= fromIntegral hearingRadius + when audible $ do + visible <- positionIsCharacterVisible $ ent ^. position + let path = ["entities", "say", "creature"] + <> [if visible then "visible" else "invisible"] + params = object [ "creature" A..= (ent ^. positioned) + , "message" A..= txt + ] + say path params + newtype GormlakBrain entity = GormlakBrain { _unGormlakBrain :: entity } instance (IsCreature entity) => Brain (GormlakBrain entity) where diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Creature/Hippocampus.hs b/users/grfn/xanthous/src/Xanthous/Entities/Creature/Hippocampus.hs index 501a5b5972..9d5cc13451 100644 --- a/users/grfn/xanthous/src/Xanthous/Entities/Creature/Hippocampus.hs +++ b/users/grfn/xanthous/src/Xanthous/Entities/Creature/Hippocampus.hs @@ -7,6 +7,7 @@ module Xanthous.Entities.Creature.Hippocampus , initialHippocampus -- ** Lenses , destination + , greetedCharacter -- ** Destination , Destination(..) , destinationFromPos @@ -50,7 +51,11 @@ destinationFromPos _destinationPosition = in Destination{..} data Hippocampus = Hippocampus - { _destination :: !(Maybe Destination) + { _destination :: !(Maybe Destination) + , -- | Has this creature greeted the character in any way yet? + -- + -- Some creature types ignore this field + _greetedCharacter :: !Bool } deriving stock (Eq, Show, Ord, Generic) deriving anyclass (NFData, CoArbitrary, Function) @@ -61,4 +66,7 @@ data Hippocampus = Hippocampus makeLenses ''Hippocampus initialHippocampus :: Hippocampus -initialHippocampus = Hippocampus Nothing +initialHippocampus = Hippocampus + { _destination = Nothing + , _greetedCharacter = False + } diff --git a/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs b/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs index a650a4f78e..5d30d73db6 100644 --- a/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs +++ b/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs @@ -37,6 +37,7 @@ module Xanthous.Entities.RawTypes , HasLongDescription(..) , HasMaxHitpoints(..) , HasName(..) + , HasSayVerb(..) , HasSpeed(..) , HasWieldable(..) ) where @@ -80,6 +81,8 @@ data CreatureType = CreatureType , _friendly :: !Bool , _speed :: !TicksPerTile , _language :: !(Maybe LanguageName) + , _sayVerb :: Text -- ^ The verb, in present tense, for when the creature + -- says something } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, CoArbitrary, Function) diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/gormlak.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/gormlak.yaml index 41247532f9..8cddf85394 100644 --- a/users/grfn/xanthous/src/Xanthous/Entities/Raws/gormlak.yaml +++ b/users/grfn/xanthous/src/Xanthous/Entities/Raws/gormlak.yaml @@ -12,3 +12,4 @@ Creature: speed: 125 friendly: false language: Gormlak + sayVerb: yells diff --git a/users/grfn/xanthous/src/Xanthous/Game/Lenses.hs b/users/grfn/xanthous/src/Xanthous/Game/Lenses.hs index d93d30aba8..0514931923 100644 --- a/users/grfn/xanthous/src/Xanthous/Game/Lenses.hs +++ b/users/grfn/xanthous/src/Xanthous/Game/Lenses.hs @@ -9,10 +9,12 @@ module Xanthous.Game.Lenses , updateCharacterVision , characterVisiblePositions , characterVisibleEntities + , positionIsCharacterVisible , getInitialState , initialStateFromSeed , entitiesAtCharacter , revealedEntitiesAtPosition + , hearingRadius -- * Collisions , Collision(..) @@ -93,8 +95,13 @@ character = positionedCharacter . positioned characterPosition :: Lens' GameState Position characterPosition = positionedCharacter . position +-- TODO make this dynamic visionRadius :: Word -visionRadius = 12 -- TODO make this dynamic +visionRadius = 12 + +-- TODO make this dynamic +hearingRadius :: Word +hearingRadius = 12 -- | Update the revealed entities at the character's position based on their -- vision @@ -116,6 +123,10 @@ characterVisibleEntities game = let charPos = game ^. characterPosition in visibleEntities charPos visionRadius $ game ^. entities +positionIsCharacterVisible :: MonadState GameState m => Position -> m Bool +positionIsCharacterVisible p = (p `elem`) <$> characterVisiblePositions +-- ^ TODO optimize + entitiesCollision :: ( Functor f , forall xx. MonoFoldable (f xx) @@ -149,11 +160,12 @@ revealedEntitiesAtPosition => Position -> m (VectorBag SomeEntity) revealedEntitiesAtPosition p = do + allRev <- use $ debugState . allRevealed cvps <- characterVisiblePositions entitiesAtPosition <- use $ entities . EntityMap.atPosition p revealed <- use revealedPositions let immobileEntitiesAtPosition = filter (not . entityCanMove) entitiesAtPosition - pure $ if | p `member` cvps + pure $ if | allRev || p `member` cvps -> entitiesAtPosition | p `member` revealed -> immobileEntitiesAtPosition diff --git a/users/grfn/xanthous/src/Xanthous/messages.yaml b/users/grfn/xanthous/src/Xanthous/messages.yaml index c1835ef232..63763b1996 100644 --- a/users/grfn/xanthous/src/Xanthous/messages.yaml +++ b/users/grfn/xanthous/src/Xanthous/messages.yaml @@ -17,6 +17,10 @@ quit: entities: description: You see here {{entityDescriptions}} + say: + creature: + visible: The {{creature.creatureType.name}} {{creature.creatureType.sayVerb}} "{{message}}" + invisible: You hear something yell "{{message}}" in the distance pickUp: menu: What would you like to pick up? -- cgit 1.4.1