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

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,32 +60,9 @@ stepGormlak
   -> Positioned entity
   -> m (Positioned entity)
 stepGormlak ticks pe@(Positioned pos creature) = do
-  dest <- maybe (selectDestination pos creature) pure
+  canSeeCharacter <- uses entities $ canSee (entityIs @Character) pos vision
-         $ creature ^. field @"_hippocampus" . destination
+
-  let progress' =
+  let selectDestination pos' creature' = destinationFromPos <$> do
-        dest ^. destinationProgress
-        + creature ^. field @"_creatureType" . Raw.speed . invertedRate |*| ticks
-  if progress' < 1
-    then pure
-         $ pe
-         & positioned . field @"_hippocampus" . destination
-         ?~ (dest & destinationProgress .~ progress')
-    else do
-      let newPos = dest ^. destinationPosition
-          remainingSpeed = progress' - 1
-      newDest <- selectDestination newPos creature
-                <&> destinationProgress +~ remainingSpeed
-      let pe' = pe & positioned . field @"_hippocampus" . destination ?~ newDest
-      collisionAt newPos >>= \case
-        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
@@ -98,11 +78,73 @@ stepGormlak ticks pe@(Positioned pos creature) = do
           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' =
+        dest ^. destinationProgress
+        + creature ^. field @"_creatureType" . Raw.speed . invertedRate |*| ticks
+  if progress' < 1
+    then pure
+         $ pe'
+         & positioned . field @"_hippocampus" . destination
+         ?~ (dest & destinationProgress .~ progress')
+    else do
+      let newPos = dest ^. destinationPosition
+          remainingSpeed = progress' - 1
+      newDest <- selectDestination newPos creature
+                <&> destinationProgress +~ remainingSpeed
+      let pe'' = pe' & positioned . field @"_hippocampus" . destination ?~ newDest
+      collisionAt newPos >>= \case
+        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
     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

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
@@ -51,6 +52,10 @@ destinationFromPos _destinationPosition =
 
 data Hippocampus = Hippocampus
   { _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
+  }

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)

users/grfn/xanthous/src/Xanthous/Entities/Raws/gormlak.yaml

@@ -12,3 +12,4 @@ Creature:
   speed: 125
   friendly: false
   language: Gormlak
+  sayVerb: yells

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

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?