From dfc9b2dca9d78dcffd26e24cf4241b848d10ab31 Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 21 Jul 2022 22:56:19 +0100 Subject: [PATCH] ActionPlan refactor --- src/Dodge/Creature/Action.hs | 11 +-- src/Dodge/Creature/ReaderUpdate.hs | 19 +++-- src/Dodge/Creature/SentinelAI.hs | 1 - src/Dodge/Creature/Volition.hs | 8 +- src/Dodge/CreatureEffect.hs | 115 +++++++++++++++++++++++++++++ src/Dodge/Data.hs | 12 +-- src/Dodge/Data/ActionPlan.hs | 1 + src/Dodge/Data/CreatureEffect.hs | 37 ++++++++++ src/Dodge/Humanoid.hs | 37 +--------- 9 files changed, 180 insertions(+), 61 deletions(-) create mode 100644 src/Dodge/CreatureEffect.hs create mode 100644 src/Dodge/Data/ActionPlan.hs create mode 100644 src/Dodge/Data/CreatureEffect.hs diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index 817e1ea9d..70b75499a 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -100,6 +100,7 @@ performTurnToA cr p -- doAction -} performAction :: Creature -> World -> Action -> OutAction performAction cr w ac = case ac of + ActionNothing -> ([],Nothing) LabelAction str subAc -> second (fmap (LabelAction str)) $ performAction cr w subAc AimAt tcid p -> performAimAt cr w tcid p WaitThen 0 newAc -> ([] , Just newAc) @@ -135,11 +136,11 @@ performAction cr w ac = case ac of LeadTarget p -> case cr ^? crIntention . targetCr . _Just of Just tcr -> ([TurnTo (_crPos tcr +.+ rotateV (_crDir tcr) p)], Nothing) _ -> ([], Nothing) - UseTarget f -> performAction cr w $ f $ cr ^? crIntention . targetCr . _Just - UseSelf f -> performAction cr w $ f cr - UseAheadPos f -> performAction cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr))) - UseMvTargetPos f -> performAction cr w $ f $ _mvToPoint $ _crIntention cr - ArbitraryAction f -> performAction cr w (f cr w) + UseTarget f -> performAction cr w $ doMCrAc f $ cr ^? crIntention . targetCr . _Just + UseSelf f -> performAction cr w $ doCrAc f cr + UseAheadPos f -> performAction cr w (doP2Ac f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr))) + UseMvTargetPos f -> performAction cr w $ doMP2Ac f $ _mvToPoint $ _crIntention cr + ArbitraryAction f -> performAction cr w (doCrWdAc f cr w) DoImpulsesAlongside sideImp mainAc -> case performAction cr w mainAc of (imp, Just nxtac) -> (sideImp ++ imp, Just $ DoImpulsesAlongside sideImp nxtac) (imp, _) -> (sideImp ++ imp, Nothing) diff --git a/src/Dodge/Creature/ReaderUpdate.hs b/src/Dodge/Creature/ReaderUpdate.hs index 2a71a8fcb..2c6379676 100644 --- a/src/Dodge/Creature/ReaderUpdate.hs +++ b/src/Dodge/Creature/ReaderUpdate.hs @@ -15,11 +15,9 @@ module Dodge.Creature.ReaderUpdate , setViewPos ) where import Dodge.Data -import Dodge.Creature.Test import Dodge.Creature.Volition import Dodge.Base import Dodge.Zone -import Dodge.Path import Geometry import qualified IntMapHelp as IM @@ -106,7 +104,7 @@ goToTarget w cr = _ -> viewTarget w cr lookAroundSelf :: Action -lookAroundSelf = UseSelf $ \cr -> TurnToPoint (_crPos cr -.- 10 *.* unitVectorAtAngle (_crDir cr)) +lookAroundSelf = UseSelf CrTurnAround -- $ \cr -> TurnToPoint (_crPos cr -.- 10 *.* unitVectorAtAngle (_crDir cr)) viewTarget :: World -> Creature -> Creature viewTarget w cr = do @@ -188,12 +186,13 @@ searchIfDamaged cr | otherwise = cr bfsThenReturn :: Int -> Action -bfsThenReturn t = ArbitraryAction theaction - where - theaction cr w = fromMaybe NoAction $ do - n <- walkableNodeNear w (_crPos cr) - let as = take 20 $ map PathTo $ bfsNodePoints n w - return $ DoReplicate t $ - foldr DoActionThen NoAction as +bfsThenReturn t = ArbitraryAction (CrWdBFSThenReturn t) +-- theaction +-- where +-- theaction cr w = fromMaybe NoAction $ do +-- n <- walkableNodeNear w (_crPos cr) +-- let as = take 20 $ map PathTo $ bfsNodePoints n w +-- return $ DoReplicate t $ +-- foldr DoActionThen NoAction as diff --git a/src/Dodge/Creature/SentinelAI.hs b/src/Dodge/Creature/SentinelAI.hs index 4199fb63f..9fb3c8393 100644 --- a/src/Dodge/Creature/SentinelAI.hs +++ b/src/Dodge/Creature/SentinelAI.hs @@ -5,7 +5,6 @@ module Dodge.Creature.SentinelAI ) where import Dodge.Data import Dodge.Creature.ChainUpdates -import Dodge.Base.Collide import Dodge.Creature.Test import Dodge.Creature.Volition import Dodge.Creature.ReaderUpdate diff --git a/src/Dodge/Creature/Volition.hs b/src/Dodge/Creature/Volition.hs index 27c657079..7c2155e94 100644 --- a/src/Dodge/Creature/Volition.hs +++ b/src/Dodge/Creature/Volition.hs @@ -3,12 +3,10 @@ module Dodge.Creature.Volition ( holsterWeapon , drawWeapon , shootTillEmpty - , fleeFrom +-- , fleeFrom , shootFirstMiss ) where import Dodge.Data ---import Dodge.Base.Collide -import Dodge.Creature.Test import Dodge.SoundLogic.LoadSound import Geometry @@ -16,10 +14,6 @@ holsterWeapon, drawWeapon :: Action holsterWeapon = DoImpulses [ChangePosture AtEase, MakeSound whiteNoiseFadeOutS] drawWeapon = DoImpulses [ChangePosture Aiming, MakeSound whiteNoiseFadeInS] -fleeFrom :: Creature -> Maybe Creature -> Action -fleeFrom cr mtcr = case mtcr of - Just tcr -> DoImpulses [MoveForward 3, TurnToward ((2 *.* _crPos cr) -.- _crPos tcr) (pi/4)] - Nothing -> NoAction shootTillEmpty :: Action --shootTillEmpty = (crCanShoot `DoActionWhile` DoImpulses [UseItem]) diff --git a/src/Dodge/CreatureEffect.hs b/src/Dodge/CreatureEffect.hs new file mode 100644 index 000000000..3a9842e6f --- /dev/null +++ b/src/Dodge/CreatureEffect.hs @@ -0,0 +1,115 @@ +module Dodge.CreatureEffect where +import Dodge.Data +import Geometry +import Dodge.Creature.Test +import Dodge.Base.Collide +import Dodge.Path +import qualified IntMapHelp as IM + +import Data.Maybe + +doWdCrCr :: WdCrCr -> World -> Creature -> Creature +doWdCrCr ce = case ce of + NoCreatureEffect -> const id + +doCrWdImp :: CrWdImp -> Creature -> World -> Impulse +doCrWdImp cwi = case cwi of + NoCrWdImp -> const $ const ImpulseNothing + +doCrWdWd :: CrWdWd -> Creature -> World -> World +doCrWdWd cww = case cww of + CrWdWdId -> const id + +doIntImp :: IntImp -> Int -> Impulse +doIntImp ii = case ii of + NoIntImp -> const ImpulseNothing + +doCrImp :: CrImp -> Creature -> Impulse +doCrImp ci = case ci of + NoCrImp -> const ImpulseNothing + TurnTowardCr x -> \cr -> TurnToward (_crPos cr) x + +doP2Imp :: P2Imp -> Point2 -> Impulse +doP2Imp p2i = case p2i of + P2ImpNo -> const ImpulseNothing + +doWdCrBl :: WdCrBl -> World -> Creature -> Bool +doWdCrBl wcb = case wcb of + WdCrTrue -> const $ const True + WdCrBlfromCrBl cb -> \_ cr -> doCrBl cb cr + WdCrNegate wcb' -> \w -> not . doWdCrBl wcb' w + WdCrLOSTarget -> \w cr -> maybe False (\cid -> canSee (_crID cr) cid w) + (_crID <$> _targetCr (_crIntention cr)) + WdCrSafeDistFromTarget x -> \_ -> crSafeDistFromTarg x -- currently ignores walls etc + +doCrBl :: CrBl -> Creature -> Bool +doCrBl cb = case cb of + CrCanShoot -> crCanShoot + CrIsReloading -> crIsReloading + CrIsAiming -> crIsAiming + +doMCrAc :: MCrAc -> Maybe Creature -> Action +doMCrAc mca = case mca of + MCrNoAction -> const ActionNothing + +doCrAc :: CrAc -> Creature -> Action +doCrAc ca = case ca of + CrTurnAround -> \cr -> TurnToPoint (_crPos cr -.- 10 *.* unitVectorAtAngle (_crDir cr)) + CrFleeFromTarget -> fleeFromTarget + +fleeFromTarget :: Creature -> Action +fleeFromTarget cr = fleeFrom cr (_targetCr (_crIntention cr)) + +doP2Ac :: P2Ac -> Point2 -> Action +doP2Ac p2a = case p2a of + P2NoAction -> const ActionNothing + +doMP2Ac :: MP2Ac -> Maybe Point2 -> Action +doMP2Ac mp2a = case mp2a of + MP2NoAction -> const ActionNothing + +doCrWdAc :: CrWdAc -> Creature -> World -> Action +doCrWdAc cw = case cw of + CrWdBFSThenReturn t -> \cr w -> fromMaybe NoAction $ do + n <- walkableNodeNear w (_crPos cr) + let as = take 20 $ map PathTo $ bfsNodePoints n w + return $ DoReplicate t $ + foldr DoActionThen NoAction as + ChooseMovementSpreadGun -> chooseMovementSpreadGun + ChooseMovementLtAuto -> chooseMovementLtAuto + +chooseMovementSpreadGun :: Creature -> World -> Action +chooseMovementSpreadGun cr w + | dist cpos p < 30 && safeAngleVV (p -.- cpos) (unitVectorAtAngle (_crDir cr)) > pi + = DoImpulses [UseItem, MoveForward (-3)] + | d < 30 = DoImpulses [UseItem,TurnToward p 0.06] + | d < 60 = DoImpulses [UseItem,TurnToward p 0.06,MoveForward 3] + | d < 100 = DoImpulses [TurnToward p 0.06, MoveForward 3 ] + | d < 200 = DoImpulses [TurnToward p (0.06 + 0.002 *(d-100)), MoveForward 3 ] + | otherwise + = DoImpulses [TurnToward p 0.26, MoveForward 3] + where + d = dist cpos p + cpos = _crPos cr + tcr = _creatures w IM.! 0 + p = _crPos tcr + +chooseMovementLtAuto :: Creature -> World -> Action +chooseMovementLtAuto cr w + | dist cpos p > 200 = DoImpulses [UseItem,TurnToward p 0.05 , MoveForward 3] + | dist cpos p < 80 = DoImpulses [UseItem,TurnToward p 0.05, MoveForward (-3) ] + | errorAngleVV 22 (p' -.- cpos) (unitVectorAtAngle (_crDir cr)) < 0.4 + = DoImpulses [UseItem,TurnToward p' 0.01, Move (V2 0 3)] + | otherwise + = DoImpulses [UseItem,TurnToward p' 0.05, Move (V2 0 3)] + where + cpos = _crPos cr + tcr = _creatures w IM.! 0 + p = _crPos tcr + v = vNormal $ p -.- cpos + p' = p +.+ 0.5 *.* (v -.- 20 *.* normalizeV v) + +fleeFrom :: Creature -> Maybe Creature -> Action +fleeFrom cr mtcr = case mtcr of + Just tcr -> DoImpulses [MoveForward 3, TurnToward ((2 *.* _crPos cr) -.- _crPos tcr) (pi/4)] + Nothing -> NoAction diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 7e589da59..a05f208cb 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -741,6 +741,7 @@ data Action {_actLabel :: String ,_actAction :: Action } + | ActionNothing | AimAt {_targetID :: Int ,_targetSeenAt :: Point2 @@ -812,19 +813,19 @@ data Action | NoAction | StartSentinelPost | UseTarget - {_useTarget :: Maybe Creature -> Action + {_useTarget :: MCrAc } | UseSelf - {_useSelf :: Creature -> Action + {_useSelf :: CrAc } | UseAheadPos - {_useAheadPos :: Point2 -> Action + {_useAheadPos :: P2Ac } | UseMvTargetPos - {_useMvTargetPos :: Maybe Point2 -> Action + {_useMvTargetPos :: MP2Ac } | ArbitraryAction - { _arbitraryAction :: Creature -> World -> Action } + { _arbitraryAction :: CrWdAc } | DoImpulsesAlongside -- ^ Repeatedly perform impulses alongside a main action until the main action terminates {_sideImpulses :: [Impulse] @@ -833,6 +834,7 @@ data Action deriving (Generic) instance Show Action where show act = case act of + ActionNothing -> "ActionNothing" LabelAction {_actLabel = str ,_actAction = subAct diff --git a/src/Dodge/Data/ActionPlan.hs b/src/Dodge/Data/ActionPlan.hs new file mode 100644 index 000000000..7da669f6b --- /dev/null +++ b/src/Dodge/Data/ActionPlan.hs @@ -0,0 +1 @@ +module Dodge.Data.ActionPlan where diff --git a/src/Dodge/Data/CreatureEffect.hs b/src/Dodge/Data/CreatureEffect.hs new file mode 100644 index 000000000..4162a93b9 --- /dev/null +++ b/src/Dodge/Data/CreatureEffect.hs @@ -0,0 +1,37 @@ +module Dodge.Data.CreatureEffect where + +data WdCrCr = NoCreatureEffect + +data CrWdImp = NoCrWdImp + +data CrWdWd = CrWdWdId + +data IntImp = NoIntImp + +data CrImp = NoCrImp + | TurnTowardCr Float -- turn amount + +data P2Imp = P2ImpNo + +data WdCrBl = WdCrTrue + | WdCrBlfromCrBl CrBl + | WdCrNegate WdCrBl + | WdCrLOSTarget + | WdCrSafeDistFromTarget Float + +data CrBl = CrCanShoot + | CrIsReloading + | CrIsAiming + +data MCrAc = MCrNoAction + +data CrAc = CrTurnAround + | CrFleeFromTarget + +data P2Ac = P2NoAction + +data MP2Ac = MP2NoAction + +data CrWdAc = CrWdBFSThenReturn Int + | ChooseMovementSpreadGun + | ChooseMovementLtAuto diff --git a/src/Dodge/Humanoid.hs b/src/Dodge/Humanoid.hs index ecb5ec144..c5f493429 100644 --- a/src/Dodge/Humanoid.hs +++ b/src/Dodge/Humanoid.hs @@ -39,7 +39,7 @@ updateHumanoid cr = case cr ^?! crType . humanoidAI of [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) [DoActionIf (WdCrNegate $ WdCrBlfromCrBl CrIsAiming) drawWeapon ,DoActionThen - (DoActionWhile WdCrLOSTarget $ ArbitraryAction chooseMovementSpreadGun) + (DoActionWhile WdCrLOSTarget $ ArbitraryAction ChooseMovementSpreadGun) (DoImpulses [ChangeStrategy WatchAndWait]) ] ) @@ -74,7 +74,7 @@ updateHumanoid cr = case cr ^?! crType . humanoidAI of [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) [DoActionIf (WdCrNegate $ WdCrBlfromCrBl CrIsAiming) drawWeapon ,DoActionThen - (DoActionWhile WdCrLOSTarget $ ArbitraryAction chooseMovementLtAuto) + (DoActionWhile WdCrLOSTarget $ ArbitraryAction ChooseMovementLtAuto) (DoImpulses [ChangeStrategy WatchAndWait]) ] ) @@ -129,8 +129,8 @@ updateHumanoid cr = case cr ^?! crType . humanoidAI of , \_ _ -> StrategyActions Reload reloadActions ) , (const $ not . crSafeDistFromTarg 150 - , \_ cr' -> StrategyActions Flee - [WdCrNegate (WdCrSafeDistFromTarget 150) `DoActionWhile` UseTarget (fleeFrom cr') + , \_ _ -> StrategyActions Flee + [WdCrNegate (WdCrSafeDistFromTarget 150) `DoActionWhile` UseSelf CrFleeFromTarget-- (fleeFrom cr') `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait] ] ) , (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) @@ -154,21 +154,6 @@ defaultImpulsive = fmap (fmap updateRandGen) . stateUpdate . impulsiveAIBefore . updateRandGen w = let (_,g) = randomR (0,1::Int) (_randGen w) in w & randGen .~ g -chooseMovementSpreadGun :: Creature -> World -> Action -chooseMovementSpreadGun cr w - | dist cpos p < 30 && safeAngleVV (p -.- cpos) (unitVectorAtAngle (_crDir cr)) > pi - = DoImpulses [UseItem, MoveForward (-3)] - | d < 30 = DoImpulses [UseItem,TurnToward p 0.06] - | d < 60 = DoImpulses [UseItem,TurnToward p 0.06,MoveForward 3] - | d < 100 = DoImpulses [TurnToward p 0.06, MoveForward 3 ] - | d < 200 = DoImpulses [TurnToward p (0.06 + 0.002 *(d-100)), MoveForward 3 ] - | otherwise - = DoImpulses [TurnToward p 0.26, MoveForward 3] - where - d = dist cpos p - cpos = _crPos cr - tcr = _creatures w IM.! 0 - p = _crPos tcr chooseMovementPistol :: Creature -> World -> Action chooseMovementPistol cr w = chooseMovementPistol' cr w @@ -235,20 +220,6 @@ retreatActionsPistol tcr cr = tpos (tpos +.+ vNormal (cpos -.- tpos)) -chooseMovementLtAuto :: Creature -> World -> Action -chooseMovementLtAuto cr w - | dist cpos p > 200 = DoImpulses [UseItem,TurnToward p 0.05 , MoveForward 3] - | dist cpos p < 80 = DoImpulses [UseItem,TurnToward p 0.05, MoveForward (-3) ] - | errorAngleVV 22 (p' -.- cpos) (unitVectorAtAngle (_crDir cr)) < 0.4 - = DoImpulses [UseItem,TurnToward p' 0.01, Move (V2 0 3)] - | otherwise - = DoImpulses [UseItem,TurnToward p' 0.05, Move (V2 0 3)] - where - cpos = _crPos cr - tcr = _creatures w IM.! 0 - p = _crPos tcr - v = vNormal $ p -.- cpos - p' = p +.+ 0.5 *.* (v -.- 20 *.* normalizeV v) retreatFireLauncher :: Action retreatFireLauncher = ImpulsesList ( [ UseItem ] : replicate 20 [ Turn 0.16 ])