From c847955b7c2dcf3ae97c6365a63c6911e4c7312b Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 11 Dec 2021 19:32:20 +0000 Subject: [PATCH] Remove Reader monad from multiple creature ais --- src/Dodge/Creature/Boid.hs | 12 ++++ src/Dodge/Creature/ChainUpdates.hs | 19 +++++++ src/Dodge/Creature/LtAutoCrit.hs | 26 ++++----- src/Dodge/Creature/PistolCrit.hs | 23 ++++---- src/Dodge/Creature/ReaderUpdate.hs | 88 +---------------------------- src/Dodge/Creature/SpreadGunCrit.hs | 26 ++++----- src/Dodge/Creature/SwarmCrit.hs | 15 ++--- 7 files changed, 78 insertions(+), 131 deletions(-) create mode 100644 src/Dodge/Creature/ChainUpdates.hs diff --git a/src/Dodge/Creature/Boid.hs b/src/Dodge/Creature/Boid.hs index 5c00c28cd..eeced20d9 100644 --- a/src/Dodge/Creature/Boid.hs +++ b/src/Dodge/Creature/Boid.hs @@ -215,6 +215,18 @@ flockToPointUsing pf mvf cr = reader $ \w -> case _targetCr $ _crIntention cr of where cenp = _crGroupCenter $ _creatureGroups w IM.! _crGroupID (_crGroup cr) ptarg = pf tcr cenp cr +flockToPointUsing' + :: (Creature -> Point2 -> Creature -> Point2) + -> (Point2 -> Creature -> Creature -> [Impulse]) + -> World + -> Creature + -> Creature +flockToPointUsing' pf mvf w cr = case _targetCr $ _crIntention cr of + Nothing -> cr + Just tcr -> cr & crActionPlan . crImpulse .~ mvf ptarg cr tcr + where + cenp = _crGroupCenter $ _creatureGroups w IM.! _crGroupID (_crGroup cr) + ptarg = pf tcr cenp cr flockFunc :: (Creature -> Point2 -> Creature -> Point2) diff --git a/src/Dodge/Creature/ChainUpdates.hs b/src/Dodge/Creature/ChainUpdates.hs new file mode 100644 index 000000000..fd1093927 --- /dev/null +++ b/src/Dodge/Creature/ChainUpdates.hs @@ -0,0 +1,19 @@ +module Dodge.Creature.ChainUpdates where +import Dodge.Data + +import Data.Foldable +chainCreatureUpdatesLR' + :: [Either (World -> Creature -> Creature) (Creature -> Creature)] + -> World -> Creature -> Creature +chainCreatureUpdatesLR' ls w cr = foldr unf cr ls + where + unf (Left g) = g w + unf (Right g) = g + +chainCreatureUpdatesLR + :: [Either (World -> Creature -> Creature) (Creature -> Creature)] + -> World -> Creature -> Creature +chainCreatureUpdatesLR ls w cr = foldl' unf cr ls + where + unf cr' (Left g) = g w cr' + unf cr' (Right g) = g cr' diff --git a/src/Dodge/Creature/LtAutoCrit.hs b/src/Dodge/Creature/LtAutoCrit.hs index c92945de9..92e605d18 100644 --- a/src/Dodge/Creature/LtAutoCrit.hs +++ b/src/Dodge/Creature/LtAutoCrit.hs @@ -4,6 +4,7 @@ module Dodge.Creature.LtAutoCrit import Dodge.Data import Dodge.Default import Dodge.Creature.Picture +import Dodge.Creature.ChainUpdates import Dodge.Creature.Impulse import Dodge.Creature.Action import Dodge.Creature.Test @@ -18,20 +19,16 @@ import Dodge.Item.Weapon.BulletGuns import Dodge.Item.Consumable import Geometry import Picture ---import Dodge.RandomHelp ---import Data.Maybe import qualified Data.IntMap.Strict as IM import Control.Lens -import Control.Monad.Reader ---import System.Random ltAutoCrit :: Creature ltAutoCrit = defaultCreature { _crPict = basicCrPict red - , _crUpdate = stateUpdate $ impulsiveAIR $ - performActionsR - >=> watchUpdateStratR + , _crUpdate = stateUpdate' $ impulsiveAI $ chainCreatureUpdatesLR + [ Left performActions + , Left $ watchUpdateStrat [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) [DoActionIf (not . crIsAiming) drawWeapon ,DoActionThen @@ -41,13 +38,14 @@ ltAutoCrit = defaultCreature ) , (crAwayFromPost, goToPostStrat) ] - >=> perceptionUpdate [0] - >=> doStrategyActionsR - >=> reloadOverrideR - >=> targetYouWhenCognizantR - >=> overrideInternalRRR - (\cr -> (&&) <$> crHasTargetR cr <*> crStratConMatchesR (GetTo (V2 0 0)) cr) - (pure . (crActionPlan . crStrategy .~ WatchAndWait)) + , Left $ perceptionUpdate' [0] + , Right $ doStrategyActions + , Right $ reloadOverride + , Left $ targetYouWhenCognizant + , Right $ overrideInternal + (\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr) + (crActionPlan . crStrategy .~ WatchAndWait) + ] , _crActionPlan = ActionPlan { _crImpulse = [] , _crAction = [] diff --git a/src/Dodge/Creature/PistolCrit.hs b/src/Dodge/Creature/PistolCrit.hs index 9f5fefbcb..23875ff2c 100644 --- a/src/Dodge/Creature/PistolCrit.hs +++ b/src/Dodge/Creature/PistolCrit.hs @@ -10,7 +10,7 @@ import Dodge.Creature.Action import Dodge.Creature.Volition import Dodge.Creature.Strategy import Dodge.Creature.ReaderUpdate ---import Dodge.Creature.ChooseTarget +import Dodge.Creature.ChainUpdates import Dodge.Creature.Perception import Dodge.Creature.State --import Dodge.Creature.State.Data @@ -29,20 +29,21 @@ import Control.Monad.State pistolCrit :: Creature pistolCrit = defaultCreature { _crPict = basicCrPict red - , _crUpdate = stateUpdate $ impulsiveAIR $ - performActionsR - >=> watchUpdateStratR + , _crUpdate = stateUpdate' $ impulsiveAI $ chainCreatureUpdatesLR + [Left performActions + ,Left $ watchUpdateStrat [ (crHasTargetLOS, \w cr -> StrategyActions (ShootAt 0) [DoActionIf (not . crIsAiming) drawWeapon,chooseMovement cr w]) , (crAwayFromPost, goToPostStrat) ] - >=> perceptionUpdate [0] - >=> doStrategyActionsR - >=> reloadOverrideR - >=> targetYouWhenCognizantR - >=> overrideInternalRRR - (\cr -> (&&) <$> crHasTargetR cr <*> crStratConMatchesR (GetTo (V2 0 0)) cr) - (pure . (crActionPlan . crStrategy .~ WatchAndWait)) + ,Left $ perceptionUpdate' [0] + ,Right $ doStrategyActions + ,Right $ reloadOverride + ,Left $ targetYouWhenCognizant + ,Right $ overrideInternal + (\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr) + (crActionPlan . crStrategy .~ WatchAndWait) + ] , _crActionPlan = ActionPlan { _crImpulse = [] , _crAction = [] diff --git a/src/Dodge/Creature/ReaderUpdate.hs b/src/Dodge/Creature/ReaderUpdate.hs index 792f9ac7b..c308199e7 100644 --- a/src/Dodge/Creature/ReaderUpdate.hs +++ b/src/Dodge/Creature/ReaderUpdate.hs @@ -1,25 +1,17 @@ {- | Functions updating a creature in a Reader World environment -} module Dodge.Creature.ReaderUpdate - ( doStrategyActionsR - , doStrategyActions + ( doStrategyActions , setTargetMv - , targetYouWhenCognizantR , targetYouWhenCognizant - , overrideMeleeCloseTargetR , overrideMeleeCloseTarget - , watchUpdateStratR , watchUpdateStrat - , reloadOverrideR , reloadOverride - , overrideInternalRRR , overrideInternal , goToTarget - , flockACCR , flockACC , setMvPos , setViewPos - ) - where + ) where import Dodge.Data import Dodge.Creature.Test import Dodge.Creature.Volition @@ -29,16 +21,10 @@ import Geometry import FoldableHelp import qualified Data.IntMap.Strict as IM -import Control.Monad.Reader import Control.Lens import Control.Applicative import Data.Maybe -overrideMeleeCloseTargetR - :: Creature - -> Reader World Creature -overrideMeleeCloseTargetR cr = return $ maybe cr (tryMeleeAttack cr) (_targetCr $ _crIntention cr) - overrideMeleeCloseTarget :: Creature -> Creature overrideMeleeCloseTarget cr = maybe cr (tryMeleeAttack cr) (_targetCr $ _crIntention cr) @@ -73,29 +59,6 @@ setTargetMv targFunc w cr = maybe (\ctarg -> cr & crIntention . mvToPoint ?~ _crPos ctarg) (targFunc w cr) -flockACCR :: Creature -> Reader World Creature -flockACCR cr = do - case cr ^? crIntention . targetCr . _Just of - Nothing -> pure cr - Just tcr -> do - w <- ask - let tpos = _crPos tcr - cpos = _crPos cr - isFarACC cr' = _crGroup cr' == _crGroup cr - && _crID cr' /= _crID cr - && dist (_crPos cr') tpos > dist cpos tpos - nearACCs = IM.filter isFarACC $ creaturesNearPointI 5 cpos w - macr = safeMinimumOn (dist cpos . _crPos) nearACCs - case macr of - Nothing -> pure cr - Just acr -> do - let r = _crRad acr + _crRad cr + 10 - horDir = normalizeV (vNormal (cpos -.- tpos)) - horShift = if isLHS tpos cpos (_crPos acr) - then r *.* horDir - else negate r *.* horDir - pure $ cr & crIntention . mvToPoint ?~ tpos +.+ horShift - -- fugly flockACC :: World -> Creature -> Creature flockACC w cr = case cr ^? crIntention . targetCr . _Just of @@ -139,12 +102,6 @@ replaceNullWith :: a -> [a] -> [a] replaceNullWith x [] = [x] replaceNullWith _ xs = xs -doStrategyActionsR :: Creature -> Reader World Creature -doStrategyActionsR cr = return $ case cr ^? crActionPlan . crStrategy of - Just (StrategyActions strat acs) -> cr & crActionPlan . crAction .~ acs - & crActionPlan . crStrategy .~ strat - _ -> cr - doStrategyActions :: Creature -> Creature doStrategyActions cr = case cr ^? crActionPlan . crStrategy of Just (StrategyActions strat acs) -> cr & crActionPlan . crAction .~ acs @@ -163,45 +120,11 @@ reloadOverride cr , WaitThen 1 $ DoActionWhileInterrupt NoAction crIsReloading (DoImpulses [ChangeStrategy WatchAndWait]) ] -reloadOverrideR :: Creature -> Reader World Creature -reloadOverrideR cr - | cr ^? crInv . ix (_crInvSel cr) . itConsumption . ammoLoaded == Just 0 - && cr ^. crStance . posture == Aiming - = return $ cr & crActionPlan . crStrategy .~ StrategyActions Reload reloadActions - | otherwise = return cr - where - reloadActions = - [ holsterWeapon - , WaitThen 1 $ DoActionWhileInterrupt NoAction crIsReloading (DoImpulses [ChangeStrategy WatchAndWait]) - ] - -overrideInternalRRR - :: (Creature -> Reader World Bool) - -> (Creature -> Reader World Creature) - -> Creature - -> Reader World Creature -overrideInternalRRR test update cr = do - b <- test cr - if b then update cr else pure cr - -overrideInternal - :: (Creature -> Bool) - -> (Creature -> Creature) - -> Creature - -> Creature +overrideInternal :: (Creature -> Bool) -> (Creature -> Creature) -> Creature -> Creature overrideInternal test update cr | test cr = update cr | otherwise = cr -watchUpdateStratR - :: [ ((World, Creature) -> Bool, World -> Creature -> Strategy) ] - -> Creature - -> Reader World Creature -watchUpdateStratR fs cr = reader $ \w -> case cr ^? crActionPlan . crStrategy of - Just WatchAndWait -> cr - & crActionPlan . crStrategy .~ listGuard (fs, \_ _ -> WatchAndWait) (w, cr) w cr - _ -> cr - watchUpdateStrat :: [ ((World, Creature) -> Bool, World -> Creature -> Strategy) ] -> World @@ -218,11 +141,6 @@ listGuard ( (test,y):ps, z ) x | otherwise = listGuard (ps, z) x listGuard (_,z) _ = z -targetYouWhenCognizantR :: Creature -> Reader World Creature -targetYouWhenCognizantR cr = reader $ \w -> case cr ^? crPerception . crAwarenessLevel . ix 0 of - Just (Cognizant _) -> cr & crIntention . targetCr ?~ _creatures w IM.! 0 - _ -> cr & crIntention . targetCr .~ Nothing - targetYouWhenCognizant :: World -> Creature -> Creature targetYouWhenCognizant w cr = case cr ^? crPerception . crAwarenessLevel . ix 0 of -- so this caused a space leak: be careful with ?~ diff --git a/src/Dodge/Creature/SpreadGunCrit.hs b/src/Dodge/Creature/SpreadGunCrit.hs index 2d00e52e3..02e4a3e68 100644 --- a/src/Dodge/Creature/SpreadGunCrit.hs +++ b/src/Dodge/Creature/SpreadGunCrit.hs @@ -10,7 +10,7 @@ import Dodge.Creature.Action import Dodge.Creature.Volition import Dodge.Creature.Strategy import Dodge.Creature.ReaderUpdate ---import Dodge.Creature.ChooseTarget +import Dodge.Creature.ChainUpdates import Dodge.Creature.Perception import Dodge.Creature.State --import Dodge.Creature.State.Data @@ -23,16 +23,13 @@ import Picture --import Data.Maybe import qualified Data.IntMap.Strict as IM import Control.Lens -import Control.Monad ---import Control.Monad.Trans.Reader ---import System.Random spreadGunCrit :: Creature spreadGunCrit = defaultCreature { _crPict = basicCrPict red - , _crUpdate = stateUpdate $ impulsiveAIR $ - performActionsR - >=> watchUpdateStratR + , _crUpdate = stateUpdate' $ impulsiveAI $ chainCreatureUpdatesLR + [Left performActions + ,Left $ watchUpdateStrat [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) [DoActionIf (not . crIsAiming) drawWeapon ,DoActionThen @@ -42,13 +39,14 @@ spreadGunCrit = defaultCreature ) , (crAwayFromPost, goToPostStrat) ] - >=> perceptionUpdate [0] - >=> doStrategyActionsR - >=> reloadOverrideR - >=> targetYouWhenCognizantR - >=> overrideInternalRRR - (\cr -> (&&) <$> crHasTargetR cr <*> crStratConMatchesR (GetTo (V2 0 0)) cr) - (\ cr -> pure $ cr & crActionPlan . crStrategy .~ WatchAndWait) + ,Left $ perceptionUpdate' [0] + ,Right $ doStrategyActions + ,Right $ reloadOverride + ,Left $ targetYouWhenCognizant + ,Right $ overrideInternal + (\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr) + (\ cr -> cr & crActionPlan . crStrategy .~ WatchAndWait) + ] , _crActionPlan = ActionPlan { _crImpulse = [] , _crAction = [] diff --git a/src/Dodge/Creature/SwarmCrit.hs b/src/Dodge/Creature/SwarmCrit.hs index 421c2c912..edb890c7a 100644 --- a/src/Dodge/Creature/SwarmCrit.hs +++ b/src/Dodge/Creature/SwarmCrit.hs @@ -5,6 +5,7 @@ module Dodge.Creature.SwarmCrit import Dodge.Data import Dodge.Default import Dodge.Creature.Picture +import Dodge.Creature.ChainUpdates import Dodge.Creature.Boid import Dodge.Creature.ReaderUpdate import Dodge.Creature.Perception @@ -14,16 +15,16 @@ import Dodge.Picture.Layer import Picture import Control.Lens -import Control.Monad.Reader swarmCrit :: Creature swarmCrit = defaultCreature - { _crUpdate = stateUpdate $ impulsiveAIR $ - flockToPointUsing (encircleDistP 100) (meleeHeadingMove 0.1 0.1 (pi/4) 3.9) - >=> return . (crMeleeCooldown %~ max 0 . subtract 1) - >=> perceptionUpdate [0] - >=> doStrategyActionsR - >=> targetYouWhenCognizantR + { _crUpdate = stateUpdate' $ impulsiveAI $ chainCreatureUpdatesLR + [ Left $ flockToPointUsing' (encircleDistP 100) (meleeHeadingMove 0.1 0.1 (pi/4) 3.9) + , Right $ (crMeleeCooldown %~ max 0 . subtract 1) + , Left $ perceptionUpdate' [0] + , Right $ doStrategyActions + , Left $ targetYouWhenCognizant + ] -- , doStrategyActions -- , targetYouWhenCognizant