From e366698064ed271e4b9f564393f2446c9b8962cd Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 5 Sep 2021 22:27:31 +0100 Subject: [PATCH] Start ai cleanup --- src/Dodge/Creature.hs | 3 +- src/Dodge/Creature/Action.hs | 93 ++++++++++++- src/Dodge/Creature/Action/UseItem.hs | 9 +- src/Dodge/Creature/ArmourChase.hs | 50 ++----- src/Dodge/Creature/AutoCrit.hs | 3 +- src/Dodge/Creature/ChaseCrit.hs | 9 +- src/Dodge/Creature/ImpulseRat.hs | 60 +-------- src/Dodge/Creature/LauncherCrit.hs | 9 +- src/Dodge/Creature/LtAutoCrit.hs | 9 +- src/Dodge/Creature/PistolCrit.hs | 8 +- src/Dodge/Creature/Rationality.hs | 187 --------------------------- src/Dodge/Creature/ReaderUpdate.hs | 154 ++++++++++++++-------- src/Dodge/Creature/SentinelAI.hs | 77 +++++------ src/Dodge/Creature/SpreadGunCrit.hs | 9 +- src/Dodge/Creature/SwarmCrit.hs | 2 +- src/Dodge/Creature/YourControl.hs | 2 +- src/Dodge/Data.hs | 130 ++++++++----------- src/Dodge/Default.hs | 25 +++- src/Dodge/Update.hs | 2 - 19 files changed, 352 insertions(+), 489 deletions(-) delete mode 100644 src/Dodge/Creature/Rationality.hs diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index e8397a64f..b44457196 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -18,6 +18,7 @@ import Dodge.Creature.State.Data --import Dodge.Creature.SetTarget import Dodge.Creature.Volition import Dodge.Creature.Test +import Dodge.Creature.Impulse import Dodge.Creature.SentinelAI import Dodge.Creature.LauncherCrit import Dodge.Creature.PistolCrit @@ -40,7 +41,6 @@ import Dodge.Creature.YourControl import Dodge.Creature.Inanimate import Dodge.Creature.State import Dodge.Creature.Picture -import Dodge.Creature.Rationality --import Dodge.Creature.ChooseTarget --import Dodge.Item import Dodge.Picture.Layer @@ -65,6 +65,7 @@ spawnerCrit = defaultCreature , _crPict = basicCrPict blue , _crInv = IM.empty -- IM.fromList [(0,frontArmour)] } + miniGunCrit :: Creature miniGunCrit = defaultCreature { _crPict = basicCrPict red diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index d02428d8f..b5cca57b6 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -1,15 +1,12 @@ {- | Actions performed by creatures within the world -} module Dodge.Creature.Action - ( module Dodge.Creature.Action - , module Dodge.Creature.Action.UseItem - , module Dodge.Creature.Action.Movement - ) +-- ( module Dodge.Creature.Action +-- , module Dodge.Creature.Action.UseItem +-- , module Dodge.Creature.Action.Movement +-- ) where -import Dodge.Creature.Action.UseItem -import Dodge.Creature.Action.Movement import Dodge.Creature.Stance.Data ---import Dodge.Creature.State.Data import Dodge.WorldEvent.Shockwave import Dodge.Data import Dodge.Base @@ -30,7 +27,89 @@ import Control.Lens import Data.Maybe --import Data.List import System.Random +import Control.Monad.Reader --import qualified Data.Map as M +performActions :: World -> Creature -> Creature +performActions w cr = cr + & crActionPlan . crImpulse .~ concat iss + & crActionPlan . crAction .~ catMaybes mayas + where + (iss, mayas) = unzip $ map (performAction cr w) $ cr ^. crActionPlan . crAction + +performActionsR :: Creature -> Reader World Creature +performActionsR cr = reader $ \w -> performActions w cr + +{- | Performing an action means that a creature has some impulses for a frame, and + updates or deletes the action itself. +-- doAction -} +performAction + :: Creature + -> World + -> Action + -> ( [Impulse] , Maybe Action ) +performAction cr w ac = case ac of + AimAt tcid p + -> ([TurnToward tpos aimSp], Just $ AimAt tcid tpos) + where + canSee' = canSee (_crID cr) tcid w + aimSp = case cr ^? crMvType . mvAimSpeed of + Just f -> f $ safeAngleVV (unitVectorAtAngle cdir) (tpos - cpos) + Nothing -> error "creature without aiming type" + tpos | canSee' = _crPos (_creatures w IM.! tcid) + | otherwise = p + WaitThen 0 newAc -> ([] , Just newAc) + WaitThen t newAc -> ([] , Just (WaitThen (t-1) newAc)) + ImpulsesList (xs:xss) -> (xs, Just $ ImpulsesList xss) + ImpulsesList _ -> ([], Nothing) + DoImpulses imps -> (imps, Nothing) + DoActionThen fsta afta -> case performAction cr w fsta of + (imps , Just nxta) -> (imps, Just (DoActionThen nxta afta)) + (imps , Nothing ) -> (imps, Just afta) + DoActionWhile f act -> performAction cr w $ DoActionWhilePartial act f act + DoActionWhilePartial partAc f resetAc + | f (w,cr) -> case performAction cr w partAc of + (imps, Just nxta) -> (imps, Just $ DoActionWhilePartial nxta f resetAc) + (imps, Nothing) -> (imps, Just $ DoActionWhilePartial resetAc f resetAc) + | otherwise -> performAction cr w partAc + DoActionIf f ifa + | f (w,cr) -> performAction cr w ifa + | otherwise -> ([],Nothing) + DoActionIfElse ifa f elsea + | f (w,cr) -> performAction cr w ifa + | otherwise -> performAction cr w elsea + DoActionWhileInterrupt repa f afta + | f (w,cr) -> (fst $ performAction cr w repa, Just $ DoActionWhileInterrupt repa f afta) + | otherwise -> performAction cr w afta + DoActions [] -> ([], Nothing) + DoActions acs -> + let (imps, newAcs) = unzip $ map (performAction cr w) acs + in (concat imps, Just . DoActions $ catMaybes newAcs) + StartSentinelPost -> ([AddGoal $ SentinelAt (_crPos cr) (_crDir cr)], Nothing) + PathTo p + | dist cpos p < 5 -> ([], Nothing) + | hasLOS cpos p w -> ([MvTurnToward p,MvForward] , Just (PathTo p)) + | otherwise -> ([], Nothing) + LeadTarget p -> case cr ^? crTarget . _Just of + Just tcr -> ([TurnTo (_crPos tcr +.+ rotateV (_crDir tcr) p)], Nothing) + _ -> ([], Nothing) + UseTarget f -> performAction cr w $ f $ cr ^? crTarget . _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 $ _crMvTarget cr + ArbitraryAction f -> performAction cr w (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) + DoReplicate t nxtac -> performAction cr w $ DoReplicatePartial nxtac t nxtac + DoReplicatePartial _ 0 pac -> performAction cr w pac + DoReplicatePartial sac t pac -> case performAction cr w pac of + (imps , Just nac) -> (imps, Just $ DoReplicatePartial sac t nac) + (imps , _) -> (imps, Just $ DoReplicatePartial sac (t-1) sac) + NoAction -> ([],Nothing) +-- _ -> ([], Nothing) + where + cpos = _crPos cr + cdir = _crDir cr startReloadingWeapon :: Creature diff --git a/src/Dodge/Creature/Action/UseItem.hs b/src/Dodge/Creature/Action/UseItem.hs index decb18fe3..e2af96496 100644 --- a/src/Dodge/Creature/Action/UseItem.hs +++ b/src/Dodge/Creature/Action/UseItem.hs @@ -1,4 +1,8 @@ module Dodge.Creature.Action.UseItem + ( useItem + , tryUseItem + , useLeftItem + ) where import Dodge.Data import Dodge.Inventory @@ -13,11 +17,6 @@ useItem n w = itemEffect c it w c = _creatures w IM.! n it = _crInv c IM.! _crInvSel c --- TODO this needs sorting out and possibly removing -crUseItem :: Creature -> World -> World ---crUseItem cr = itemEffect (_crID cr) (_crInv cr IM.! _crInvSel cr) -crUseItem = tryUseItem - tryUseItem :: Creature -> World diff --git a/src/Dodge/Creature/ArmourChase.hs b/src/Dodge/Creature/ArmourChase.hs index 88a84c910..d454e986c 100644 --- a/src/Dodge/Creature/ArmourChase.hs +++ b/src/Dodge/Creature/ArmourChase.hs @@ -2,22 +2,19 @@ module Dodge.Creature.ArmourChase ( armourChaseCrit ) where -import Dodge.Base import Dodge.Data import Dodge.Default import Dodge.Creature.State import Dodge.Creature.State.Data -import Dodge.Creature.Rationality import Dodge.Creature.ReaderUpdate import Dodge.Creature.AlertLevel import Dodge.Creature.Picture +import Dodge.Creature.Impulse +import Dodge.Creature.Action import Dodge.Item.Equipment import Dodge.Item.Consumable import Picture -import Geometry -import FoldableHelp -import Data.Maybe import qualified Data.IntMap.Strict as IM import Control.Lens import Control.Monad.Reader @@ -28,10 +25,11 @@ armourChaseCrit = defaultCreature watchUpdateStratR [] >=> doStrategyActionsR >=> performActionsR >=> - chaseTargetR (const . _crTarget) >=> - basicPerceptionUpdateR [0] >=> targetYouWhenCognizantR >=> + setTargetMv (pure . _crTarget) >=> flockACCR >=> + basicPerceptionUpdateR [0] >=> + goToTarget >=> overrideMeleeCloseTargetR >=> return . (crMeleeCooldown %~ max 0 . subtract 1) , _crHP = 300 @@ -40,37 +38,13 @@ armourChaseCrit = defaultCreature [(0,frontArmour) ,(1,medkit 200) ] + , _crActionPlan = ActionPlan + {_crImpulse = [] + ,_crAction = [] + ,_crStrategy = FollowImpulses + ,_crGoal = [Kill 0] + } , _crMeleeCooldown = 0 , _crGroup = ShieldGroup - , _crMvType = ChaseMvType - { _chaseSpeed = 2.5 - , _chaseTurnRad = f - , _chaseTurnJit = 0.2 - } + , _crMvType = defaultChaseMvType } - where - f x | x > pi / 4 = 0.2 - | otherwise = 0.05 - -flockACCR :: Creature -> Reader World Creature -flockACCR = reader . flockACC - -flockACC :: Creature -> World -> Creature -flockACC cr w = fromMaybe cr $ mFlockACC cr w - -mFlockACC :: Creature -> World -> Maybe Creature -mFlockACC cr w = do - tcr <- _crTarget cr - let tpos = _crPos tcr - cpos = _crPos cr - isFarACC cr' = _crGroup cr' == ShieldGroup && _crID cr' /= _crID cr - && dist (_crPos cr') tpos > dist cpos tpos - -- && circOnSeg (_crPos cr') tpos cpos (_crRad cr + _crRad cr') - nearACCs = IM.filter isFarACC $ creaturesNearPointI 3 cpos w - acr <- safeMinimumOn (dist cpos . _crPos) nearACCs - 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 - return $ cr & crActionPlan . crImpulse .~ [MoveForward 2.5,TurnToward (tpos +.+ horShift) 0.05 ] diff --git a/src/Dodge/Creature/AutoCrit.hs b/src/Dodge/Creature/AutoCrit.hs index 82b48feb8..db4fd634a 100644 --- a/src/Dodge/Creature/AutoCrit.hs +++ b/src/Dodge/Creature/AutoCrit.hs @@ -6,7 +6,7 @@ import Dodge.Default import Dodge.Creature.Picture import Dodge.Creature.SentinelAI --import Dodge.Creature.ChooseTarget -import Dodge.Creature.Rationality +import Dodge.Creature.Impulse import Dodge.Creature.State --import Dodge.Creature.State.Data import Dodge.Item.Weapon.AutoGun @@ -32,4 +32,5 @@ autoCrit = defaultCreature , _crInvSel = 0 , _crRad = 10 , _crHP = 300 + , _crMvType = defaultAimMvType } diff --git a/src/Dodge/Creature/ChaseCrit.hs b/src/Dodge/Creature/ChaseCrit.hs index 3f379ca67..a27a488ed 100644 --- a/src/Dodge/Creature/ChaseCrit.hs +++ b/src/Dodge/Creature/ChaseCrit.hs @@ -8,7 +8,8 @@ import Dodge.Creature.Picture --import Dodge.Creature.Test import Dodge.Creature.ReaderUpdate import Dodge.Creature.ChooseTarget -import Dodge.Creature.Rationality +import Dodge.Creature.Impulse +import Dodge.Creature.Action import Dodge.Creature.AlertLevel import Dodge.Creature.State import Dodge.Creature.State.Data @@ -49,9 +50,9 @@ chaseCrit = defaultCreature , _crMeleeCooldown = 0 , _crFaction = ColorFaction green , _crMvType = ChaseMvType - { _chaseSpeed = 2.5 - , _chaseTurnRad = f - , _chaseTurnJit = 0.2 + { _mvSpeed = 2.5 + , _mvTurnRad = f + , _mvTurnJit = 0.2 } } where diff --git a/src/Dodge/Creature/ImpulseRat.hs b/src/Dodge/Creature/ImpulseRat.hs index 3bc571087..f193c6368 100644 --- a/src/Dodge/Creature/ImpulseRat.hs +++ b/src/Dodge/Creature/ImpulseRat.hs @@ -1,25 +1,12 @@ module Dodge.Creature.ImpulseRat + ( mvPointMeleeTarg + , meleeHeadingMove + ) where import Dodge.Data ---import Dodge.Base ---import Dodge.Creature.ChooseTarget ---import Dodge.Creature.State.Data + import Geometry ---import qualified Data.IntMap.Strict as IM -import Control.Lens ---import Control.Monad.Reader - - -chaseTarget - :: (Creature -> World -> Maybe Creature) -- ^ Function for determining target - -> World - -> Creature - -> Creature -chaseTarget targFunc w cr = case targFunc cr w of - Nothing -> cr - Just crTarg -> cr & crActionPlan . crImpulse .~ chaseTarg cr crTarg - meleeHeadingMove :: Float -- ^ max turn speed -> Float -- ^ min turn speed @@ -62,42 +49,3 @@ mvPointMeleeTarg p cr crT cpos = _crPos cr tpos = _crPos crT combinedRad = _crRad cr + _crRad crT - -chaseTarg :: Creature -> Creature -> [Impulse] -chaseTarg cr crT - | dist tpos cpos < combinedRad + 5 - && abs (_crDir cr - argV (tpos -.- cpos)) < pi/4 - = [ TurnToward tpos 0.05 ] - | abs (_crDir cr - argV (tpos -.- cpos)) < pi/4 - = [MoveForward 2.5 , TurnToward tpos 0.2, RandomTurn 0.2 ] - | otherwise = [MoveForward 2.5 , TurnToward tpos 0.05, RandomTurn 0.2 ] - where - cpos = _crPos cr - tpos = _crPos crT - combinedRad = _crRad cr + _crRad crT - -impulseShootAtTarget - :: (Creature -> World -> Maybe Creature) -- ^ Function for determining target - -> World - -> Creature - -> Creature -impulseShootAtTarget targFunc w cr = case targFunc cr w of - Nothing -> cr - Just crTarg -> cr & crActionPlan . crImpulse .~ impulseShootAtTarg cr crTarg - -impulseShootAtTarg :: Creature -> Creature -> [Impulse] -impulseShootAtTarg cr crT - | dist tpos cpos < combinedRad + 5 - && abs (_crDir cr - argV (tpos -.- cpos)) < pi/4 - && _crMeleeCooldown cr == 0 - = [Melee (_crID crT)] - | dist tpos cpos < combinedRad + 5 - && abs (_crDir cr - argV (tpos -.- cpos)) < pi/4 - = [ TurnToward tpos 0.05 ] - | abs (_crDir cr - argV (tpos -.- cpos)) < pi/4 - = [MoveForward 2.5 , TurnToward tpos 0.2, RandomTurn 0.2 ] - | otherwise = [MoveForward 2.5 , TurnToward tpos 0.05, RandomTurn 0.2 ] - where - cpos = _crPos cr - tpos = _crPos crT - combinedRad = _crRad cr + _crRad crT diff --git a/src/Dodge/Creature/LauncherCrit.hs b/src/Dodge/Creature/LauncherCrit.hs index 70dbe6fc8..f662415a7 100644 --- a/src/Dodge/Creature/LauncherCrit.hs +++ b/src/Dodge/Creature/LauncherCrit.hs @@ -10,12 +10,13 @@ import Dodge.Creature.Volition import Dodge.Creature.ActionRat --import Dodge.Creature.ChooseTarget import Dodge.Creature.ReaderUpdate -import Dodge.Creature.Rationality import Dodge.Creature.AlertLevel import Dodge.Creature.State --import Dodge.Creature.State.Data import Dodge.Item.Weapon.Launcher --import Dodge.Item.Consumable +import Dodge.Creature.Impulse +import Dodge.Creature.Action import Geometry.Data import Picture @@ -36,9 +37,9 @@ launcherCrit = defaultCreature >=> doStrategyActionsR >=> reloadOverrideR >=> targetYouWhenCognizantR - >=> overrideInternalR - (onBoth (&&) crHasTarget (crStratConMatches (GetTo (V2 0 0)))) - (\ _ -> crActionPlan . crStrategy .~ WatchAndWait) + >=> overrideInternalRRR + (\cr -> (&&) <$> crHasTargetR cr <*> crStratConMatchesR (GetTo (V2 0 0)) cr) + (pure . (crActionPlan . crStrategy .~ WatchAndWait)) , _crActionPlan = ActionPlan { _crImpulse = [] , _crAction = [] diff --git a/src/Dodge/Creature/LtAutoCrit.hs b/src/Dodge/Creature/LtAutoCrit.hs index c0665b374..aa7c28581 100644 --- a/src/Dodge/Creature/LtAutoCrit.hs +++ b/src/Dodge/Creature/LtAutoCrit.hs @@ -4,12 +4,13 @@ module Dodge.Creature.LtAutoCrit import Dodge.Data import Dodge.Default import Dodge.Creature.Picture +import Dodge.Creature.Impulse +import Dodge.Creature.Action import Dodge.Creature.Test import Dodge.Creature.Volition import Dodge.Creature.ActionRat --import Dodge.Creature.ChooseTarget import Dodge.Creature.ReaderUpdate -import Dodge.Creature.Rationality import Dodge.Creature.AlertLevel import Dodge.Creature.State --import Dodge.Creature.State.Data @@ -44,9 +45,9 @@ ltAutoCrit = defaultCreature >=> doStrategyActionsR >=> reloadOverrideR >=> targetYouWhenCognizantR - >=> overrideInternalR - (onBoth (&&) crHasTarget (crStratConMatches (GetTo (V2 0 0)))) - (\ _ -> crActionPlan . crStrategy .~ WatchAndWait) + >=> overrideInternalRRR + (\cr -> (&&) <$> crHasTargetR cr <*> crStratConMatchesR (GetTo (V2 0 0)) cr) + (pure . (crActionPlan . crStrategy .~ WatchAndWait)) , _crActionPlan = ActionPlan { _crImpulse = [] , _crAction = [] diff --git a/src/Dodge/Creature/PistolCrit.hs b/src/Dodge/Creature/PistolCrit.hs index 3bdd232c4..81aa969e9 100644 --- a/src/Dodge/Creature/PistolCrit.hs +++ b/src/Dodge/Creature/PistolCrit.hs @@ -5,11 +5,12 @@ import Dodge.Data import Dodge.Default import Dodge.Creature.Picture import Dodge.Creature.Test +import Dodge.Creature.Impulse +import Dodge.Creature.Action import Dodge.Creature.Volition import Dodge.Creature.ActionRat import Dodge.Creature.ReaderUpdate --import Dodge.Creature.ChooseTarget -import Dodge.Creature.Rationality import Dodge.Creature.AlertLevel import Dodge.Creature.State --import Dodge.Creature.State.Data @@ -39,8 +40,9 @@ pistolCrit = defaultCreature >=> doStrategyActionsR >=> reloadOverrideR >=> targetYouWhenCognizantR - >=> overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (V2 0 0)))) - ( \ _ -> crActionPlan . crStrategy .~ WatchAndWait ) + >=> overrideInternalRRR + (\cr -> (&&) <$> crHasTargetR cr <*> crStratConMatchesR (GetTo (V2 0 0)) cr) + (pure . (crActionPlan . crStrategy .~ WatchAndWait)) , _crActionPlan = ActionPlan { _crImpulse = [] , _crAction = [] diff --git a/src/Dodge/Creature/Rationality.hs b/src/Dodge/Creature/Rationality.hs deleted file mode 100644 index d93224786..000000000 --- a/src/Dodge/Creature/Rationality.hs +++ /dev/null @@ -1,187 +0,0 @@ -module Dodge.Creature.Rationality - where -import Dodge.Data -import Dodge.Base.Collide -import Dodge.Creature.Action ---import Dodge.Creature.Action.UseItem -import Dodge.Creature.State.Data -import Dodge.Creature.Stance.Data -import Dodge.SoundLogic -import Dodge.SoundLogic.Synonyms -import Geometry - -import Data.Maybe -import qualified Data.IntMap.Strict as IM -import System.Random -import Control.Lens -import Control.Monad.Reader -import Data.Monoid - -composeInternalAIs - :: [World -> Creature -> Creature] - -> World - -> Creature - -> Creature -composeInternalAIs fs w c = foldr ($ w) c fs - -impulsiveAIR - :: (Creature -> Reader World Creature) - -> Creature - -> World - -> (Endo World , Maybe Creature) -impulsiveAIR impf cr w = bimap Endo Just $ followImpulses w . ($ w) . runReader $ impf cr - ---impulsiveAI --- :: (World -> Creature -> Creature) -- ^ Internal AI update, should determine impulses --- -> World --- -> (World -> World,StdGen) --- -> Creature --- -> ((World -> World,StdGen), Maybe Creature) ---impulsiveAI impF w (f,g) = followImpulses w (f,g) . impF w - --- needs cleanup -followImpulses - :: World - -> Creature - -> (World -> World, Creature) -followImpulses w cr - = foldr - (\imp (f , cr') -> let (f'', cr'') = followImpulse cr' w imp in (f'' . f , cr'')) - (id, cr) - (_crImpulse $ _crActionPlan cr) - -followImpulse - :: Creature - -> World - -> Impulse - -> (World -> World , Creature) -followImpulse cr w imp = case imp of - Move p -> (id, crMvBy p cr) - MoveForward x -> (id, crMvForward x cr) - Turn a -> (id, creatureTurn a cr) - TurnToward p a -> (id, creatureTurnToward p a cr) - TurnTo p -> (id, creatureTurnTo p cr) - ChangePosture post -> (id, cr & crStance . posture .~ post) - UseItem -> (crUseItem cr, cr) - SwitchToItem i -> (id, cr & crInvSel .~ i) - Melee cid -> - (hitCr cid - , crMvBy (10 *.* normalizeV (posFromID cid -.- cpos)) $ cr & crMeleeCooldown .~ 20) -- randomise cooldown? - RandomTurn a -> (id, creatureTurn (rr a) cr) - MakeSound sid -> ( soundOnceOrigin sid (CrSound (_crID cr)) (_crPos cr) , cr ) - DropItem -> undefined - ChangeStrategy strat -> (id, cr & crActionPlan . crStrategy .~ strat) - AddGoal gl -> (id, cr & crActionPlan . crGoal %~ (gl :) ) - ArbitraryImpulseFunction f -> (id, f w cr) - ArbitraryImpulse f -> followImpulse cr w (f cr w) - ImpulseUseTargetCID f -> case cr ^? crTarget . _Just of - Just tcr -> followImpulse cr w (f $ _crID tcr) - _ -> (id,cr) - ImpulseUseTarget f -> case cr ^? crTarget . _Just of - Just tcr -> followImpulse cr w (f tcr) - _ -> (id,cr) - ImpulseUseAheadPos f -> followImpulse cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr))) - _ -> (id , cr) - where - cpos = _crPos cr - posFromID cid = _crPos $ _creatures w IM.! cid - rr a = fst $ randomR (-a,a) $ _randGen w - hitCr i = over (creatures . ix i . crState . crDamage) (addDam i) - . soundOnce hitSound - addDam i dams = Blunt 100 cpos (posFromID i) (posFromID i) : dams - -actionUpdateAI - :: (World -> Creature -> Creature) -- ^ the function updating the actions - -> World - -> Creature - -> Creature -actionUpdateAI actF w c = performActions w $ actF w c - -listGuard :: ([(a -> Bool, b)] , b) -> a -> b -listGuard ( (test,y):ps, z ) x - | test x = y - | otherwise = listGuard (ps, z) x -listGuard (_,z) _ = z - -performActions :: World -> Creature -> Creature -performActions w cr = cr - & crActionPlan . crImpulse .~ concat iss - & crActionPlan . crAction .~ catMaybes mayas - where - (iss, mayas) = unzip $ map (performAction cr w) $ cr ^. crActionPlan . crAction - -performActionsR :: Creature -> Reader World Creature -performActionsR cr = reader $ \w -> performActions w cr - - -{- | Performing an action means that a creature has some impulses for a frame, and - updates or deletes the action itself. -} -performAction - :: Creature - -> World - -> Action - -> ( [Impulse] , Maybe Action ) -performAction cr w ac = case ac of - AimAtCloseSlow tcid p speed slowSpeed a - | canSee (_crID cr) tcid w && safeAngleVV (unitVectorAtAngle cdir) (tpos -.- cpos) < a - -> ([TurnToward tpos slowSpeed] , Just $ AimAtCloseSlow tcid tpos speed slowSpeed a) - | canSee (_crID cr) tcid w - -> ([TurnToward tpos speed] , Just $ AimAtCloseSlow tcid tpos speed slowSpeed a) - | safeAngleVV (unitVectorAtAngle cdir) (tpos -.- cpos) < a - -> ([TurnToward p slowSpeed] , Just $ AimAtCloseSlow tcid p speed slowSpeed a) - | otherwise -> ([TurnToward p speed] , Just $ AimAtCloseSlow tcid p speed slowSpeed a) - where - tpos = _crPos (_creatures w IM.! tcid) - WaitThen 0 newAc -> ([] , Just newAc) - WaitThen t newAc -> ([] , Just (WaitThen (t-1) newAc)) - ImpulsesList (xs:xss) -> (xs, Just $ ImpulsesList xss) - ImpulsesList _ -> ([], Nothing) - DoImpulses imps -> (imps, Nothing) - DoActionThen fsta afta -> case performAction cr w fsta of - (imps , Just nxta) -> (imps, Just (DoActionThen nxta afta)) - (imps , Nothing ) -> (imps, Just afta) - DoActionWhile f repa -> performAction cr w $ DoActionWhilePartial repa f repa - DoActionWhilePartial partAc f resetAc - | f (w,cr) -> case performAction cr w partAc of - (imps, Just nxta) -> (imps, Just $ DoActionWhilePartial nxta f resetAc) - (imps, _) -> (imps, Just $ DoActionWhilePartial resetAc f resetAc) - | otherwise -> performAction cr w partAc - DoActionIf f ifa - | f (w,cr) -> performAction cr w ifa - | otherwise -> ([],Nothing) - DoActionIfElse ifa f elsea - | f (w,cr) -> performAction cr w ifa - | otherwise -> performAction cr w elsea - DoActionWhileInterrupt repa f afta - | f (w,cr) -> (fst $ performAction cr w repa, Just $ DoActionWhileInterrupt repa f afta) - | otherwise -> performAction cr w afta - DoActions [] -> ([], Nothing) - DoActions acs -> - let (imps, newAcs) = unzip $ map (performAction cr w) acs - in (concat imps, Just . DoActions $ catMaybes newAcs) - StartSentinelPost -> ([AddGoal $ SentinelAt (_crPos cr) (_crDir cr)], Nothing) - PathTo p - | dist cpos p < 5 -> ([], Nothing) - | hasLOS cpos p w -> ([TurnToward p (pi/4),MoveForward 3] , Just (PathTo p)) - | otherwise -> ([], Nothing) - LeadTarget p -> case cr ^? crTarget . _Just of - Just tcr -> ([TurnTo (_crPos tcr +.+ rotateV (_crDir tcr) p)], Nothing) - _ -> ([], Nothing) - UseTargetCID f -> case cr ^? crTarget . _Just of - Just tcr -> performAction cr w (f $ _crID tcr) - _ -> ([],Nothing) - UseTarget f -> performAction cr w $ f $ cr ^? crTarget . _Just - UseAheadPos f -> performAction cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr))) - ArbitraryAction f -> performAction cr w (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) - DoReplicate t nxtac -> performAction cr w $ DoReplicatePartial nxtac t nxtac - DoReplicatePartial _ 0 pac -> performAction cr w pac - DoReplicatePartial sac t pac -> case performAction cr w pac of - (imps , Just nac) -> (imps, Just $ DoReplicatePartial sac t nac) - (imps , _) -> (imps, Just $ DoReplicatePartial sac (t-1) sac) - _ -> ([], Nothing) - where - cpos = _crPos cr - cdir = _crDir cr diff --git a/src/Dodge/Creature/ReaderUpdate.hs b/src/Dodge/Creature/ReaderUpdate.hs index 59d5f2321..1e0cf3e2e 100644 --- a/src/Dodge/Creature/ReaderUpdate.hs +++ b/src/Dodge/Creature/ReaderUpdate.hs @@ -1,12 +1,27 @@ -{- | Function updating a creature in a Reader World environment -} +{- | Functions updating a creature in a Reader World environment -} module Dodge.Creature.ReaderUpdate + ( doStrategyActionsR + , chaseTargetR + , chaseTargetRR + , setTargetMv + , targetYouWhenCognizantR + , overrideMeleeCloseTargetR + , watchUpdateStratR + , reloadOverrideR + , overrideInternalRRR + , goToTarget + , flockACCR + ) where import Dodge.Data import Dodge.Creature.Stance.Data import Dodge.Creature.Test import Dodge.Creature.Volition import Dodge.Creature.AlertLevel.Data +import Dodge.Base +import Dodge.Base.Collide import Geometry +import FoldableHelp import qualified Data.IntMap.Strict as IM import Control.Monad.Reader @@ -27,32 +42,90 @@ tryMeleeAttack cr tcr | otherwise = cr where cpos = _crPos cr - --meleeActions = - -- [DoImpulses [Melee (_crID tcr)] - -- `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait] - -- ] + +chaseTargetRR + :: (Creature -> Reader World (Maybe Creature)) -- ^ Function for determining target + -> Creature + -> Reader World Creature +chaseTargetRR targFunc cr = do + targ <- targFunc cr + case targ of + Nothing -> pure cr + Just crTarg -> pure $ cr & crActionPlan . crImpulse .~ chaseTarg cr crTarg +setTargetMv + :: (Creature -> Reader World (Maybe Creature)) -- ^ Function for determining target + -> Creature + -> Reader World Creature +setTargetMv targFunc cr = do + targ <- targFunc cr + case targ of + Nothing -> pure cr + Just crTarg -> pure $ cr & crMvTarget .~ Just (_crPos crTarg) +flockACCR :: Creature -> Reader World Creature +flockACCR cr = do + case cr ^? crTarget . _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 & crMvTarget .~ Just (tpos +.+ horShift) + +goToTarget :: Creature -> Reader World Creature +goToTarget cr = do + w <- ask + case cr ^? crMvTarget . _Just of + Just p + | dist p cpos > _crRad cr + 10 && hasLOS p cpos w + -> pure $ cr & crActionPlan . crImpulse .~ + [ MoveForward speed + , TurnToward p (trad dirOffset) + , RandomTurn jit + ] + | dist p cpos > _crRad cr + 10 + -> pure $ cr & crActionPlan . crAction .~ [PathTo p] + where + dirOffset = abs (_crDir cr - argV (p -.- cpos)) + _ -> pure cr + where + cpos = _crPos cr + mvType = _crMvType cr + speed = _mvSpeed mvType + trad = _mvTurnRad mvType + jit = _mvTurnJit mvType + chaseTargetR :: (Creature -> World -> Maybe Creature) -- ^ Function for determining target -> Creature -> Reader World Creature -chaseTargetR targFunc cr = reader $ \w -> case targFunc cr w of +chaseTargetR targFunc cr = reader $ \w -> case targFunc cr w of Nothing -> cr Just crTarg -> cr & crActionPlan . crImpulse .~ chaseTarg cr crTarg chaseTarg :: Creature -> Creature -> [Impulse] chaseTarg cr crT = [MoveForward speed, TurnToward tpos (trad dirOffset), RandomTurn jit] where - cpos = _crPos cr - tpos = _crPos crT - mvType = _crMvType cr - speed = _chaseSpeed mvType - trad = _chaseTurnRad mvType - jit = _chaseTurnJit mvType + cpos = _crPos cr + tpos = _crPos crT + mvType = _crMvType cr + speed = _mvSpeed mvType + trad = _mvTurnRad mvType + jit = _mvTurnJit mvType dirOffset = abs (_crDir cr - argV (tpos -.- cpos)) --- | abs (_crDir cr - argV (tpos -.- cpos)) < pi/4 --- = [MoveForward 2.5 , TurnToward tpos 0.2, RandomTurn 0.2 ] --- | otherwise = [MoveForward 2.5 , TurnToward tpos 0.05, RandomTurn 0.2 ] doStrategyActionsR :: Creature @@ -76,24 +149,14 @@ reloadOverrideR cr , WaitThen 1 $ DoActionWhileInterrupt NoAction crIsReloading (DoImpulses [ChangeStrategy WatchAndWait]) ] -overrideInternalR - :: ((World , Creature) -> Bool) - -> (World -> Creature -> Creature) - -> Creature - -> Reader World Creature -overrideInternalR test update cr = reader $ \w -> - if test (w,cr) - then update w cr - else cr -overrideInternalRR - :: ((World , Creature) -> Bool) +overrideInternalRRR + :: (Creature -> Reader World Bool) -> (Creature -> Reader World Creature) -> Creature -> Reader World Creature -overrideInternalRR test update cr = reader $ \w -> - if test (w,cr) - then runReader (update cr) w - else cr +overrideInternalRRR test update cr = do + b <- test cr + if b then update cr else pure cr watchUpdateStratR :: [ ((World, Creature) -> Bool, World -> Creature -> Strategy) ] @@ -104,18 +167,6 @@ watchUpdateStratR fs cr = reader $ \w -> case cr ^? crActionPlan . crStrategy of & crActionPlan . crStrategy .~ listGuard (fs, \_ _ -> WatchAndWait) (w, cr) w cr _ -> cr -watchUpdateStratRRR - :: [ (Creature -> Reader World Bool, Creature -> Reader World Strategy) ] - -> Creature - -> Reader World Creature -watchUpdateStratRRR fs cr = do - return undefined fs cr --- reader $ \w -> case cr ^? crActionPlan . crStrategy of --- Just WatchAndWait -> cr --- & crActionPlan . crStrategy .~ listGuard (fs, \_ _ -> WatchAndWait) (w, cr) w cr --- _ -> cr - - listGuard :: ([(a -> Bool, b)] , b) -> a -> b listGuard ( (test,y):ps, z ) x @@ -125,16 +176,15 @@ listGuard (_,z) _ = z targetYouWhenCognizantR :: Creature -> Reader World Creature targetYouWhenCognizantR cr = reader $ \w -> case cr ^? crAwarenessLevel . ix 0 of --- Just (Cognizant _) -> cr & crTarget ?~ _creatures w IM.! 0 Just (Cognizant _) -> cr {_crTarget = Just $! _creatures w IM.! 0} _ -> cr & crTarget .~ Nothing -shootTargetWithStratR - :: (Creature -> World -> Maybe Creature) -- ^ Function for determining target - -> (World -> Creature -> Creature -> [Action] -> [Action]) - -- ^ Function for determining shooting strategy given target - -> Creature - -> Reader World Creature -shootTargetWithStratR targFunc strat cr = reader $ \w -> case targFunc cr w of - Nothing -> cr - Just crTarg -> cr & crActionPlan . crAction %~ strat w cr crTarg +--shootTargetWithStratR +-- :: (Creature -> World -> Maybe Creature) -- ^ Function for determining target +-- -> (World -> Creature -> Creature -> [Action] -> [Action]) +-- -- ^ Function for determining shooting strategy given target +-- -> Creature +-- -> Reader World Creature +--shootTargetWithStratR targFunc strat cr = reader $ \w -> case targFunc cr w of +-- Nothing -> cr +-- Just crTarg -> cr & crActionPlan . crAction %~ strat w cr crTarg diff --git a/src/Dodge/Creature/SentinelAI.hs b/src/Dodge/Creature/SentinelAI.hs index 08ae91aae..598706248 100644 --- a/src/Dodge/Creature/SentinelAI.hs +++ b/src/Dodge/Creature/SentinelAI.hs @@ -6,8 +6,8 @@ import Dodge.Creature.Test import Dodge.Creature.Volition import Dodge.Creature.ReaderUpdate import Dodge.Creature.ActionRat +import Dodge.Creature.Action --import Dodge.Creature.ChooseTarget -import Dodge.Creature.Rationality import Dodge.Creature.AlertLevel --import Dodge.Creature.State --import Dodge.Creature.State.Data @@ -20,34 +20,28 @@ import Data.Maybe import Control.Lens import Control.Monad import Control.Monad.Reader ---import System.Random sentinelAI :: Creature -> Reader World Creature sentinelAI = sentinelExtraWatchUpdate - [ (crHasTargetLOS - , \ _ cr -> - let lostest (w,cr') = canSee (_crID cr') tcid w - advanceShoot = ImpulsesList [[UseItem, MoveForward 3]] - tcid = _crID $ fromJust $ _crTarget cr - in StrategyActions (ShootAt tcid) - [ DoActionIfElse NoAction crIsAiming (DoActionThen drawWeapon (WaitThen 50 NoAction)) - `DoActionThen` - lostest `DoActionWhile` - advanceShoot `DoActionThen` - 75 `DoReplicate` - advanceShoot `DoActionThen` - DoImpulses [ChangeStrategy WatchAndWait] - , AimAtCloseSlow - { _targetID = tcid - , _targetSeenAt = V2 0 0 -- hack - , _aimSpeed = 0.2 - , _slowAimSpeed = 0.01 - , _slowAimAngle = pi/8 - } - ] - ) - ] + [ (crHasTargetLOS + , \ _ cr -> StrategyActions (ShootAt (fromJust $ tcid cr)) + [ DoActionIf + (not . crIsAiming) + (drawWeapon `DoActionThen` (50 `WaitThen` NoAction)) + `DoActionThen` lostest + `DoActionWhile` advanceShoot + `DoActionThen` 75 + `DoReplicate` advanceShoot + `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait] + , AimAt { _targetID = fromJust $ tcid cr , _targetSeenAt = V2 0 0 } + ] + ) + ] >=> reloadOverrideR + where + advanceShoot = DoImpulses [UseItem, MoveForward 3] + tcid cr = _crID <$> _crTarget cr + lostest (w,cr) = maybe False (\cid -> canSee (_crID cr) cid w) (tcid cr) sentinelFireType :: (Int -> Action) @@ -57,7 +51,8 @@ sentinelFireType f = performActionsR >=> watchUpdateStratR [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) [ drawwp `DoActionThen` f 0 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait] - , aiming] + , aiming + ] ) , (crAwayFromPost, goToPostStrat) ] @@ -65,17 +60,14 @@ sentinelFireType f = performActionsR >=> doStrategyActionsR >=> reloadOverrideR >=> targetYouWhenCognizantR - >=> overrideInternalR - (onBoth (&&) crHasTarget (crStratConMatches (GetTo (V2 0 0)))) - (\ _ -> crActionPlan . crStrategy .~ WatchAndWait) + >=> overrideInternalRRR + (\cr -> (&&) <$> crHasTargetR cr <*> crStratConMatchesR (GetTo (V2 0 0)) cr) + (pure . (crActionPlan . crStrategy .~ WatchAndWait)) where drawwp = DoActionIfElse NoAction crIsAiming (DoActionThen drawWeapon (WaitThen 50 NoAction)) - aiming = AimAtCloseSlow + aiming = AimAt { _targetID = 0 , _targetSeenAt = V2 0 0 -- hack - , _aimSpeed = 0.2 - , _slowAimSpeed = 0.01 - , _slowAimAngle = pi/8 } sentinelExtraWatchUpdate @@ -84,14 +76,13 @@ sentinelExtraWatchUpdate -> Reader World Creature sentinelExtraWatchUpdate xs = performActionsR >=> watchUpdateStratR - ( xs ++ [(crAwayFromPost, goToPostStrat)] ) + ( xs ++ [(crAwayFromPost, goToPostStrat)] ) >=> basicPerceptionUpdateR [0] >=> doStrategyActionsR --- >=> reloadOverrideR >=> targetYouWhenCognizantR - >=> overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (V2 0 0)))) - (\ _ -> crActionPlan . crStrategy .~ WatchAndWait) - + >=> overrideInternalRRR + (\cr -> (&&) <$> crHasTargetR cr <*> crStratConMatchesR (GetTo (V2 0 0)) cr) + (pure . (crActionPlan . crStrategy .~ WatchAndWait)) shootAtAdvance :: Int -> [Action] shootAtAdvance tcid = @@ -102,12 +93,9 @@ shootAtAdvance tcid = 75 `DoReplicate` advanceShoot `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait] - , AimAtCloseSlow + , AimAt { _targetID = tcid , _targetSeenAt = V2 0 0 -- hack - , _aimSpeed = 0.2 - , _slowAimSpeed = 0.01 - , _slowAimAngle = pi/8 } ] where @@ -123,12 +111,9 @@ shootAtWhileContinueTime tcid _ _ = StrategyActions (ShootAt tcid) 75 `DoReplicate` advanceShoot `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait] - , AimAtCloseSlow + , AimAt { _targetID = tcid , _targetSeenAt = V2 0 0 -- hack - , _aimSpeed = 0.2 - , _slowAimSpeed = 0.01 - , _slowAimAngle = pi/8 } ] where diff --git a/src/Dodge/Creature/SpreadGunCrit.hs b/src/Dodge/Creature/SpreadGunCrit.hs index 4597d0a7a..adcc2f5f2 100644 --- a/src/Dodge/Creature/SpreadGunCrit.hs +++ b/src/Dodge/Creature/SpreadGunCrit.hs @@ -5,11 +5,12 @@ import Dodge.Data import Dodge.Default import Dodge.Creature.Picture import Dodge.Creature.Test +import Dodge.Creature.Impulse +import Dodge.Creature.Action import Dodge.Creature.Volition import Dodge.Creature.ActionRat import Dodge.Creature.ReaderUpdate --import Dodge.Creature.ChooseTarget -import Dodge.Creature.Rationality import Dodge.Creature.AlertLevel import Dodge.Creature.State --import Dodge.Creature.State.Data @@ -23,6 +24,7 @@ import Picture import qualified Data.IntMap.Strict as IM import Control.Lens import Control.Monad +--import Control.Monad.Trans.Reader --import System.Random spreadGunCrit :: Creature @@ -44,8 +46,9 @@ spreadGunCrit = defaultCreature >=> doStrategyActionsR >=> reloadOverrideR >=> targetYouWhenCognizantR - >=> overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (V2 0 0)))) - (\ _ -> crActionPlan . crStrategy .~ WatchAndWait) + >=> overrideInternalRRR + (\cr -> (&&) <$> crHasTargetR cr <*> crStratConMatchesR (GetTo (V2 0 0)) cr) + (\ cr -> pure $ cr & crActionPlan . crStrategy .~ WatchAndWait) , _crActionPlan = ActionPlan { _crImpulse = [] , _crAction = [] diff --git a/src/Dodge/Creature/SwarmCrit.hs b/src/Dodge/Creature/SwarmCrit.hs index b0d7c5789..c3c052801 100644 --- a/src/Dodge/Creature/SwarmCrit.hs +++ b/src/Dodge/Creature/SwarmCrit.hs @@ -11,9 +11,9 @@ import Dodge.Creature.Boid import Dodge.Creature.ImpulseRat --import Dodge.Creature.ChooseTarget --import Dodge.Creature.SetTarget -import Dodge.Creature.Rationality import Dodge.Creature.ReaderUpdate import Dodge.Creature.AlertLevel +import Dodge.Creature.Impulse import Dodge.Creature.State import Dodge.Creature.State.Data import Dodge.Picture.Layer diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index 66ce6f094..2fff6224f 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -2,7 +2,7 @@ module Dodge.Creature.YourControl where import Dodge.Data --import Dodge.Base -import Dodge.Creature.Action +import Dodge.Creature.Action.Movement --import Dodge.Creature.State --import Dodge.Creature.State.Data import Dodge.Creature.Stance.Data diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index bf4e1917e..89e2dedff 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -220,14 +220,21 @@ data Creature = Creature , _crFaction :: Faction , _crGroup :: CrGroup , _crTarget :: Maybe Creature + , _crMvTarget :: Maybe Point2 , _crMvType :: CrMvType } data CrMvType - = DefCrMvType + = NoMvType | ChaseMvType - { _chaseSpeed :: Float - , _chaseTurnRad :: Float -> Float - , _chaseTurnJit :: Float + { _mvSpeed :: Float + , _mvTurnRad :: Float -> Float + , _mvTurnJit :: Float + } + | AimMvType + { _mvSpeed :: Float + , _mvTurnRad :: Float -> Float + , _mvTurnJit :: Float + , _mvAimSpeed :: Float -> Float } data WorldState = DoorNumOpen Int @@ -559,18 +566,19 @@ data ActionPlan data Impulse = Move Point2 | MoveForward Float - | StepForward | Turn Float | RandomTurn Float | TurnToward Point2 Float + | MvTurnToward Point2 + | MvForward | TurnTo Point2 | UseItem | SwitchToItem Int | DropItem - | PickupNearby Int - | UseWorldObject Int - | Bark -- placeholder for various communication types - | UseIntrinsicAbility +-- | PickupNearby Int +-- | UseWorldObject Int +-- | Bark -- placeholder for various communication types +-- | UseIntrinsicAbility | Melee Int | ChangePosture Posture | MakeSound Int @@ -594,87 +602,66 @@ infixr 9 `DoActionWhile` infixr 9 `DoReplicate` infixr 9 `DoImpulsesAlongside` data Action - = Attack - {_attackTargetID :: Int} - | AimAtCloseSlow - {_targetID :: Int - ,_targetSeenAt :: Point2 - ,_aimSpeed :: Float - ,_slowAimSpeed :: Float - ,_slowAimAngle :: Float - } - | MeleeAttack - {_meleeAttackLastSeen :: Point2 - ,_meleeAttackTargetID :: Int + = AimAt + {_targetID :: Int + ,_targetSeenAt :: Point2 } | PathTo - {_pathToPoint :: Point2 - } - | HealSelf - | DefendSelf - | Protect - {_protectCID :: Int - } - | SearchFor - {_searchForCID :: Int - } - | Search - | PickupItem - {_pickupItemID :: Int + {_pathToPoint :: Point2 } +-- | PickupItem +-- {_pickupItemID :: Int +-- } | ImpulsesList - {_impulsesListList :: [[Impulse]] + {_impulsesListList :: [[Impulse]] } | DoImpulses - {_doImpulsesList :: [Impulse] + {_doImpulsesList :: [Impulse] } | WaitThen - {_waitThenTimer :: Int - ,_waitThenAction :: Action + {_waitThenTimer :: Int + ,_waitThenAction :: Action } | DoActionWhile - {_doActionWhileCondition :: (World, Creature) -> Bool - ,_doActionWhileAction :: Action + {_doActionWhileCondition :: (World, Creature) -> Bool + ,_doActionWhileAction :: Action } | DoActionWhilePartial - {_doActionWhilePartial :: Action - ,_doActionWhileCondition :: (World, Creature) -> Bool - ,_doActionWhileAction :: Action + {_doActionWhilePartial :: Action + ,_doActionWhileCondition :: (World, Creature) -> Bool + ,_doActionWhileAction :: Action } | DoActionIf - {_doActionIfCondition :: (World, Creature) -> Bool - ,_doActionIfAction :: Action + {_doActionIfCondition :: (World, Creature) -> Bool + ,_doActionIfAction :: Action } | DoActionIfElse - {_doActionIfElseIfAction :: Action - ,_doActionIfElseCondition :: (World, Creature) -> Bool - ,_doActionIfElseElseAction :: Action + {_doActionIfElseIfAction :: Action + ,_doActionIfElseCondition :: (World, Creature) -> Bool + ,_doActionIfElseElseAction :: Action } | DoActionWhileInterrupt - {_doActionWhileThenDo :: Action - ,_doActionWhileThenCondition :: (World, Creature) -> Bool - ,_doActionWhileThenThen :: Action + {_doActionWhileThenDo :: Action + ,_doActionWhileThenCondition :: (World, Creature) -> Bool + ,_doActionWhileThenThen :: Action } | DoActions {_doActionsList :: [Action] } - | DoActionOnce - {_doActionOnceAction :: Action - } | DoActionThen - {_doActionThenFirst :: Action - ,_doActionThenSecond :: Action - } - | DoGuardActions - {_doGuardActionsList :: [( (World, Creature) -> Bool, Action, Maybe Action)] + {_doActionThenFirst :: Action + ,_doActionThenSecond :: Action } +-- | DoGuardActions +-- {_doGuardActionsList :: [( (World, Creature) -> Bool, Action, Maybe Action)] +-- } | DoReplicate - {_doReplicateTimes :: Int + {_doReplicateTimes :: Int ,_doReplicateAction :: Action } | DoReplicatePartial - {_partialAction :: Action - ,_doReplicateTimes :: Int + {_partialAction :: Action + ,_doReplicateTimes :: Int ,_doReplicateAction :: Action } | LeadTarget @@ -685,24 +672,21 @@ data Action | UseTarget {_useTarget :: Maybe Creature -> Action } - | UseTargetCID - {_useTargetCID :: Int -> Action - } | UseSelf {_useSelf :: Creature -> Action } | UseAheadPos {_useAheadPos :: Point2 -> Action } + | UseMvTargetPos + {_useMvTargetPos :: Maybe Point2 -> Action + } | ArbitraryAction { _arbitraryAction :: Creature -> World -> Action } - | DoActionAlongside -- ^ Repeatedly perform a side action alongside a main action until the main action terminates - {_sideAction :: Action - ,_mainAction :: Action - } - | DoImpulsesAlongside -- ^ Repeatedly perform impulses alongside a main action until the main action terminates - {_sideImpulses :: [Impulse] - ,_mainAction :: Action + | DoImpulsesAlongside + -- ^ Repeatedly perform impulses alongside a main action until the main action terminates + {_sideImpulses :: [Impulse] + ,_mainAction :: Action } deriving (Generic) -- deriving (Eq,Ord,Show) @@ -749,7 +733,7 @@ makeLenses ''ActionPlan makeLenses ''Impulse makeLenses ''Action makeLenses ''CrGroupParams - +makeLenses ''CrMvType numColor :: Int -> Color numColor 0 = toV4 (1,0,0,1) numColor 1 = toV4 (0,1,0,1) diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 3969b073e..026f7121e 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -55,9 +55,32 @@ defaultCreature = Creature , _crAwarenessLevel = IM.empty , _crFaction = NoFaction , _crTarget = Nothing + , _crMvTarget= Nothing , _crGroup = LoneWolf - , _crMvType = DefCrMvType + , _crMvType = NoMvType } +defaultChaseMvType :: CrMvType +defaultChaseMvType = ChaseMvType + { _mvSpeed = 3 + , _mvTurnRad = f + , _mvTurnJit = 0.2 + } + where + f x | x > pi / 4 = 0.2 + | otherwise = 0.05 +defaultAimMvType :: CrMvType +defaultAimMvType = AimMvType + { _mvSpeed = 3 + , _mvTurnRad = const 0.2 + , _mvTurnJit = 0.05 + , _mvAimSpeed = f + } + where + f x | x > pi/8 = 0.2 + | otherwise = 0.01 +defaultAimingCrit :: Creature +defaultAimingCrit = defaultCreature { _crMvType = defaultAimMvType } + defaultState :: CreatureState defaultState = CrSt { _crDamage = [] diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 52ea63a72..db0889589 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -148,8 +148,6 @@ updateCreatures w = appEndo f $ w where (f'',cr') = _crUpdate cr cr (w & randGen .~ g) (_,g') = genWord8 g - - {- | Apply door mechanisms. -} updateWalls :: World -> World