about summary refs log tree commit diff
path: root/users/grfn/xanthous/src/Xanthous
diff options
context:
space:
mode:
Diffstat (limited to 'users/grfn/xanthous/src/Xanthous')
-rw-r--r--users/grfn/xanthous/src/Xanthous/AI/Gormlak.hs90
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Creature/Hippocampus.hs12
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs3
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Raws/gormlak.yaml1
-rw-r--r--users/grfn/xanthous/src/Xanthous/Game/Lenses.hs16
-rw-r--r--users/grfn/xanthous/src/Xanthous/messages.yaml4
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?