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 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

View file

@ -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
}

View file

@ -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)

View file

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

View file

@ -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

View file

@ -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?