From 1b88921bc36e5da1ade5c52827d057dc2be65bc5 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Fri, 3 Jan 2020 12:41:48 -0500 Subject: Decouple Gormlak AI from creatures Decouple the definition of the Gormlak AI from the creature type itself using generic lenses and a "HasVisionRadius" typeclass, to begin to untangle the hs-boot web of circular dependencies. This actually *increases* the number of hs-boot files from 1 to 2, but both of the source imports that use them are single-instance (unlike gormlak AI which I would expect to grow linearly with the growth of the game), plus at least one should be able to go away once we remove collision from the game lenses module and move it into something defined in the entity class itself. --- src/Xanthous/AI/Gormlak.hs | 74 +++++++++++++++++++++++++++++----------------- 1 file changed, 47 insertions(+), 27 deletions(-) (limited to 'src/Xanthous/AI/Gormlak.hs') diff --git a/src/Xanthous/AI/Gormlak.hs b/src/Xanthous/AI/Gormlak.hs index 3e950f67f364..031262533d21 100644 --- a/src/Xanthous/AI/Gormlak.hs +++ b/src/Xanthous/AI/Gormlak.hs @@ -1,14 +1,18 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE UndecidableInstances #-} -------------------------------------------------------------------------------- -module Xanthous.AI.Gormlak () where +module Xanthous.AI.Gormlak + ( HasVisionRadius(..) + , GormlakBrain(..) + ) where -------------------------------------------------------------------------------- import Xanthous.Prelude hiding (lines) -------------------------------------------------------------------------------- -import Data.Coerce 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 @@ -16,14 +20,11 @@ import Xanthous.Data , Ticks, (|*|), invertedRate ) import Xanthous.Data.EntityMap -import qualified Xanthous.Entities.Creature as Creature -import Xanthous.Entities.Creature - ( Creature, hippocampus, creatureType - , destination, destinationProgress, destinationPosition - ) +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 ( Collision(..), entityCollision, collisionAt @@ -34,28 +35,44 @@ 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 - :: (MonadState GameState m, MonadRandom m) + :: forall entity m. + ( MonadState GameState m, MonadRandom m + , IsCreature entity + ) => Ticks - -> Positioned Creature - -> m (Positioned Creature) + -> Positioned entity + -> m (Positioned entity) stepGormlak ticks pe@(Positioned pos creature) = do dest <- maybe (selectDestination pos creature) pure - $ creature ^. hippocampus . destination + $ creature ^. field @"_hippocampus" . destination let progress' = dest ^. destinationProgress - + creature ^. creatureType . Raw.speed . invertedRate |*| ticks + + creature ^. field @"_creatureType" . Raw.speed . invertedRate |*| ticks if progress' < 1 then pure $ pe - & positioned . hippocampus . destination + & 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 . hippocampus . destination ?~ newDest + let pe' = pe & positioned . field @"_hippocampus" . destination ?~ newDest collisionAt newPos >>= \case Nothing -> pure $ pe' & position .~ newPos Just Stop -> pure pe' @@ -64,7 +81,7 @@ stepGormlak ticks pe@(Positioned pos creature) = do when (any (entityIs @Character) ents) attackCharacter pure pe' where - selectDestination pos' creature' = Creature.destinationFromPos <$> do + selectDestination pos' creature' = destinationFromPos <$> do canSeeCharacter <- uses entities $ canSee (entityIs @Character) pos' vision if canSeeCharacter then do @@ -76,29 +93,32 @@ stepGormlak ticks pe@(Positioned pos creature) = do lines <- map (takeWhile (isNothing . entityCollision . map snd . snd) -- the first item on these lines is always the creature itself . fromMaybe mempty . tailMay) - . linesOfSight pos' (Creature.visionRadius creature') + . linesOfSight pos' (visionRadius creature') <$> use entities line <- choose $ weightedBy length lines pure $ fromMaybe pos' $ fmap fst . headMay =<< line - vision = Creature.visionRadius creature + vision = visionRadius creature attackCharacter = do say ["combat", "creatureAttack"] $ object [ "creature" A..= creature ] character %= Character.damage 1 -newtype GormlakBrain = GormlakBrain Creature +newtype GormlakBrain entity = GormlakBrain { _unGormlakBrain :: entity } -instance Brain GormlakBrain where - step ticks = fmap coerce . stepGormlak ticks . coerce +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 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 +-- instance Entity Creature where +-- blocksVision _ = False +-- description = view $ Creature.creatureType . Raw.description +-- entityChar = view $ Creature.creatureType . char -- cgit 1.4.1