about summary refs log tree commit diff
path: root/users/grfn/xanthous/src/Xanthous/AI
diff options
context:
space:
mode:
Diffstat (limited to 'users/grfn/xanthous/src/Xanthous/AI')
-rw-r--r--users/grfn/xanthous/src/Xanthous/AI/Gormlak.hs90
1 files changed, 66 insertions, 24 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