diff options
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 a6cc789d68..a7938c1225 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 501a5b5972..9d5cc13451 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 a650a4f78e..5d30d73db6 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 41247532f9..8cddf85394 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 d93d30aba8..0514931923 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 c1835ef232..63763b1996 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? |