feat(xanthous): Gormlaks yell in gormlak when they see the character r/2661

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 <grfn@gws.fyi>
Tested-by: BuildkiteCI

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 a6cc789d6894..a7938c12254c 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 501a5b597221..9d5cc134517f 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 a650a4f78ea7..5d30d73db6c5 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 41247532f9dc..8cddf85394a6 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 d93d30aba876..051493192323 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 c1835ef2327b..63763b199634 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?