From 6266c5d32f9ff651fcfc3a4cc0c68e89da56ca65 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 11 Apr 2021 17:53:27 -0400 Subject: refactor(users/glittershark): Rename to grfn Rename my //users directory and all places that refer to glittershark to grfn, including nix references and documentation. This may require some extra attention inside of gerrit's database after it lands to allow me to actually push things. Change-Id: I4728b7ec2c60024392c1c1fa6e0d4a59b3e266fa Reviewed-on: https://cl.tvl.fyi/c/depot/+/2933 Tested-by: BuildkiteCI Reviewed-by: tazjin Reviewed-by: lukegb Reviewed-by: glittershark --- users/grfn/xanthous/src/Xanthous/AI/Gormlak.hs | 124 +++++++++++++++++++++++++ 1 file changed, 124 insertions(+) create mode 100644 users/grfn/xanthous/src/Xanthous/AI/Gormlak.hs (limited to 'users/grfn/xanthous/src/Xanthous/AI/Gormlak.hs') diff --git a/users/grfn/xanthous/src/Xanthous/AI/Gormlak.hs b/users/grfn/xanthous/src/Xanthous/AI/Gormlak.hs new file mode 100644 index 000000000000..a6cc789d6894 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/AI/Gormlak.hs @@ -0,0 +1,124 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE UndecidableInstances #-} +-------------------------------------------------------------------------------- +module Xanthous.AI.Gormlak + ( HasVisionRadius(..) + , GormlakBrain(..) + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding (lines) +-------------------------------------------------------------------------------- +import Control.Monad.State +import Control.Monad.Random +import Data.Aeson (object) +import qualified Data.Aeson as A +import Data.Generics.Product.Fields +-------------------------------------------------------------------------------- +import Xanthous.Data + ( Positioned(..), positioned, position + , diffPositions, stepTowards, isUnit + , Ticks, (|*|), invertedRate + ) +import Xanthous.Data.EntityMap +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.Game.State +import Xanthous.Game.Lenses + ( entitiesCollision, collisionAt + , character, characterPosition + ) +import Xanthous.Data.EntityMap.Graphics (linesOfSight, canSee) +import Xanthous.Random +import Xanthous.Monad (say) +-------------------------------------------------------------------------------- + +-- TODO move the following two classes to a more central location + +class HasVisionRadius a where visionRadius :: a -> Word + +type IsCreature entity = + ( HasVisionRadius entity + , HasField "_hippocampus" entity entity Hippocampus Hippocampus + , HasField "_creatureType" entity entity CreatureType CreatureType + , A.ToJSON entity + ) + +-------------------------------------------------------------------------------- + +stepGormlak + :: forall entity m. + ( MonadState GameState m, MonadRandom m + , IsCreature entity + ) + => Ticks + -> Positioned entity + -> m (Positioned entity) +stepGormlak ticks pe@(Positioned pos creature) = do + dest <- maybe (selectDestination pos creature) pure + $ creature ^. field @"_hippocampus" . destination + let progress' = + dest ^. destinationProgress + + creature ^. field @"_creatureType" . Raw.speed . invertedRate |*| ticks + if progress' < 1 + then pure + $ pe + & positioned . field @"_hippocampus" . destination + ?~ (dest & destinationProgress .~ progress') + else do + let newPos = dest ^. destinationPosition + remainingSpeed = progress' - 1 + newDest <- selectDestination newPos creature + <&> destinationProgress +~ remainingSpeed + let pe' = pe & positioned . field @"_hippocampus" . destination ?~ newDest + collisionAt newPos >>= \case + 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 + +newtype GormlakBrain entity = GormlakBrain { _unGormlakBrain :: entity } + +instance (IsCreature entity) => Brain (GormlakBrain entity) where + step ticks + = fmap (fmap GormlakBrain) + . stepGormlak ticks + . fmap _unGormlakBrain + entityCanMove = const True + +-------------------------------------------------------------------------------- + +-- instance Brain Creature where +-- step = brainVia GormlakBrain +-- entityCanMove = const True + +-- instance Entity Creature where +-- blocksVision _ = False +-- description = view $ Creature.creatureType . Raw.description +-- entityChar = view $ Creature.creatureType . char -- cgit 1.4.1