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
This commit is contained in:
Griffin Smith 2021-06-13 23:03:15 -04:00 committed by grfn
parent 30d83d7c82
commit bf79617bd8
6 changed files with 98 additions and 28 deletions

View file

@ -15,7 +15,7 @@ import qualified Data.Aeson as A
import Data.Generics.Product.Fields import Data.Generics.Product.Fields
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
import Xanthous.Data import Xanthous.Data
( Positioned(..), positioned, position ( Positioned(..), positioned, position, _Position
, diffPositions, stepTowards, isUnit , diffPositions, stepTowards, isUnit
, Ticks, (|*|), invertedRate , Ticks, (|*|), invertedRate
) )
@ -24,15 +24,18 @@ import Xanthous.Entities.Creature.Hippocampus
import Xanthous.Entities.Character (Character) import Xanthous.Entities.Character (Character)
import qualified Xanthous.Entities.Character as Character import qualified Xanthous.Entities.Character as Character
import qualified Xanthous.Entities.RawTypes as Raw 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.State
import Xanthous.Game.Lenses import Xanthous.Game.Lenses
( entitiesCollision, collisionAt ( entitiesCollision, collisionAt
, character, characterPosition , character, characterPosition, positionIsCharacterVisible
, hearingRadius
) )
import Xanthous.Data.EntityMap.Graphics (linesOfSight, canSee) import Xanthous.Data.EntityMap.Graphics (linesOfSight, canSee)
import Xanthous.Random import Xanthous.Random
import Xanthous.Monad (say) 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 -- TODO move the following two classes to a more central location
@ -57,6 +60,28 @@ stepGormlak
-> Positioned entity -> Positioned entity
-> m (Positioned entity) -> m (Positioned entity)
stepGormlak ticks pe@(Positioned pos creature) = do 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 dest <- maybe (selectDestination pos creature) pure
$ creature ^. field @"_hippocampus" . destination $ creature ^. field @"_hippocampus" . destination
let progress' = let progress' =
@ -64,7 +89,7 @@ stepGormlak ticks pe@(Positioned pos creature) = do
+ creature ^. field @"_creatureType" . Raw.speed . invertedRate |*| ticks + creature ^. field @"_creatureType" . Raw.speed . invertedRate |*| ticks
if progress' < 1 if progress' < 1
then pure then pure
$ pe $ pe'
& positioned . field @"_hippocampus" . destination & positioned . field @"_hippocampus" . destination
?~ (dest & destinationProgress .~ progress') ?~ (dest & destinationProgress .~ progress')
else do else do
@ -72,37 +97,54 @@ stepGormlak ticks pe@(Positioned pos creature) = do
remainingSpeed = progress' - 1 remainingSpeed = progress' - 1
newDest <- selectDestination newPos creature newDest <- selectDestination newPos creature
<&> destinationProgress +~ remainingSpeed <&> destinationProgress +~ remainingSpeed
let pe' = pe & positioned . field @"_hippocampus" . destination ?~ newDest let pe'' = pe' & positioned . field @"_hippocampus" . destination ?~ newDest
collisionAt newPos >>= \case collisionAt newPos >>= \case
Nothing -> pure $ pe' & position .~ newPos Nothing -> pure $ pe'' & position .~ newPos
Just Stop -> pure pe' Just Stop -> pure pe''
Just Combat -> do Just Combat -> do
ents <- use $ entities . atPosition newPos ents <- use $ entities . atPosition newPos
when (any (entityIs @Character) ents) attackCharacter when (any (entityIs @Character) ents) attackCharacter
pure pe' pure pe'
where 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 vision = visionRadius creature
attackCharacter = do attackCharacter = do
say ["combat", "creatureAttack"] $ object [ "creature" A..= creature ] say ["combat", "creatureAttack"] $ object [ "creature" A..= creature ]
character %= Character.damage 1 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 } newtype GormlakBrain entity = GormlakBrain { _unGormlakBrain :: entity }
instance (IsCreature entity) => Brain (GormlakBrain entity) where instance (IsCreature entity) => Brain (GormlakBrain entity) where

View file

@ -7,6 +7,7 @@ module Xanthous.Entities.Creature.Hippocampus
, initialHippocampus , initialHippocampus
-- ** Lenses -- ** Lenses
, destination , destination
, greetedCharacter
-- ** Destination -- ** Destination
, Destination(..) , Destination(..)
, destinationFromPos , destinationFromPos
@ -50,7 +51,11 @@ destinationFromPos _destinationPosition =
in Destination{..} in Destination{..}
data Hippocampus = Hippocampus 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 stock (Eq, Show, Ord, Generic)
deriving anyclass (NFData, CoArbitrary, Function) deriving anyclass (NFData, CoArbitrary, Function)
@ -61,4 +66,7 @@ data Hippocampus = Hippocampus
makeLenses ''Hippocampus makeLenses ''Hippocampus
initialHippocampus :: Hippocampus initialHippocampus :: Hippocampus
initialHippocampus = Hippocampus Nothing initialHippocampus = Hippocampus
{ _destination = Nothing
, _greetedCharacter = False
}

View file

@ -37,6 +37,7 @@ module Xanthous.Entities.RawTypes
, HasLongDescription(..) , HasLongDescription(..)
, HasMaxHitpoints(..) , HasMaxHitpoints(..)
, HasName(..) , HasName(..)
, HasSayVerb(..)
, HasSpeed(..) , HasSpeed(..)
, HasWieldable(..) , HasWieldable(..)
) where ) where
@ -80,6 +81,8 @@ data CreatureType = CreatureType
, _friendly :: !Bool , _friendly :: !Bool
, _speed :: !TicksPerTile , _speed :: !TicksPerTile
, _language :: !(Maybe LanguageName) , _language :: !(Maybe LanguageName)
, _sayVerb :: Text -- ^ The verb, in present tense, for when the creature
-- says something
} }
deriving stock (Show, Eq, Ord, Generic) deriving stock (Show, Eq, Ord, Generic)
deriving anyclass (NFData, CoArbitrary, Function) deriving anyclass (NFData, CoArbitrary, Function)

View file

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

View file

@ -9,10 +9,12 @@ module Xanthous.Game.Lenses
, updateCharacterVision , updateCharacterVision
, characterVisiblePositions , characterVisiblePositions
, characterVisibleEntities , characterVisibleEntities
, positionIsCharacterVisible
, getInitialState , getInitialState
, initialStateFromSeed , initialStateFromSeed
, entitiesAtCharacter , entitiesAtCharacter
, revealedEntitiesAtPosition , revealedEntitiesAtPosition
, hearingRadius
-- * Collisions -- * Collisions
, Collision(..) , Collision(..)
@ -93,8 +95,13 @@ character = positionedCharacter . positioned
characterPosition :: Lens' GameState Position characterPosition :: Lens' GameState Position
characterPosition = positionedCharacter . position characterPosition = positionedCharacter . position
-- TODO make this dynamic
visionRadius :: Word 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 -- | Update the revealed entities at the character's position based on their
-- vision -- vision
@ -116,6 +123,10 @@ characterVisibleEntities game =
let charPos = game ^. characterPosition let charPos = game ^. characterPosition
in visibleEntities charPos visionRadius $ game ^. entities in visibleEntities charPos visionRadius $ game ^. entities
positionIsCharacterVisible :: MonadState GameState m => Position -> m Bool
positionIsCharacterVisible p = (p `elem`) <$> characterVisiblePositions
-- ^ TODO optimize
entitiesCollision entitiesCollision
:: ( Functor f :: ( Functor f
, forall xx. MonoFoldable (f xx) , forall xx. MonoFoldable (f xx)
@ -149,11 +160,12 @@ revealedEntitiesAtPosition
=> Position => Position
-> m (VectorBag SomeEntity) -> m (VectorBag SomeEntity)
revealedEntitiesAtPosition p = do revealedEntitiesAtPosition p = do
allRev <- use $ debugState . allRevealed
cvps <- characterVisiblePositions cvps <- characterVisiblePositions
entitiesAtPosition <- use $ entities . EntityMap.atPosition p entitiesAtPosition <- use $ entities . EntityMap.atPosition p
revealed <- use revealedPositions revealed <- use revealedPositions
let immobileEntitiesAtPosition = filter (not . entityCanMove) entitiesAtPosition let immobileEntitiesAtPosition = filter (not . entityCanMove) entitiesAtPosition
pure $ if | p `member` cvps pure $ if | allRev || p `member` cvps
-> entitiesAtPosition -> entitiesAtPosition
| p `member` revealed | p `member` revealed
-> immobileEntitiesAtPosition -> immobileEntitiesAtPosition

View file

@ -17,6 +17,10 @@ quit:
entities: entities:
description: You see here {{entityDescriptions}} 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: pickUp:
menu: What would you like to pick up? menu: What would you like to pick up?