From 436043b1694989883fdbb07c40dcd38508bd48ae Mon Sep 17 00:00:00 2001 From: jgk Date: Thu, 6 May 2021 14:07:51 +0200 Subject: [PATCH] Continue ai refactor --- src/Dodge/AIs.hs | 2 +- src/Dodge/Creature.hs | 12 ++++++++++++ src/Dodge/Creature/Action.hs | 4 ++-- src/Dodge/Creature/ChooseTarget.hs | 9 +++++++++ src/Dodge/Creature/ImpulseRat.hs | 26 ++++++++++++++++++++++++++ src/Dodge/Creature/Rationality.hs | 23 +++++++++++++++-------- src/Dodge/Creature/Rationality/Data.hs | 11 ++++++----- src/Dodge/Creature/State.hs | 12 ++++++------ src/Dodge/Creature/State/Data.hs | 1 - src/Dodge/Creature/YourControl.hs | 22 +++++++++++----------- src/Dodge/Data.hs | 3 +++ src/Dodge/Default.hs | 4 +++- 12 files changed, 94 insertions(+), 35 deletions(-) create mode 100644 src/Dodge/Creature/ChooseTarget.hs create mode 100644 src/Dodge/Creature/ImpulseRat.hs diff --git a/src/Dodge/AIs.hs b/src/Dodge/AIs.hs index 325c74666..be42fee3a 100644 --- a/src/Dodge/AIs.hs +++ b/src/Dodge/AIs.hs @@ -796,7 +796,7 @@ launcherAI inRange outRange w (f,g) cr = (TurnTo p:_) -> ( (f,g') , replaceImpulse [] . crTurnTo p $ cr) (TurnByFor a 0:_) -> ( (f,g') , replaceImpulse [] . over crDir (+a) $ cr) (TurnByFor a i:_) -> ( (f,g') , replaceImpulse [TurnByFor a (i-1)] . over crDir (+a) $ cr) - (SetPosture pture:_) -> ((f,g), replaceImpulse [] $ set (crState . stance . posture) pture cr) + (SetPosture pture:_) -> ((f,g), replaceImpulse [] $ set (crStance . posture) pture cr) (MoveByFor p 0:_) -> ((f,g'), replaceImpulse [] . crMvBy p $ cr) (MoveByFor p i:_) -> ((f,g'), replaceImpulse [MoveByFor p (i-1)] . crMvBy p $ cr) (Fire:_) | pointHitsWalls cpos (cpos +.+ 40 *.* unitVectorAtAngle (_crDir cr)) diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 37985ebb2..66c0e66cc 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -17,6 +17,7 @@ import Dodge.Creature.YourControl import Dodge.Creature.Inanimate import Dodge.Creature.State import Dodge.Creature.Picture +import Dodge.Creature.Rationality import Dodge.Item import Dodge.Picture.Layer import Dodge.Creature.Picture @@ -65,6 +66,17 @@ smallChaseCrit = defaultCreature } chaseCrit :: Creature chaseCrit = defaultCreature + { _crUpdate = stateUpdate $ impulsiveAI $ applyBasicImpulse + , _crHP = 300 + , _crPict = basicCrPict green + , _crState = defaultState + {_goals = [[Wait]] + ,_faction = ChaseCritters + } + , _crInv = IM.empty + } +chaseCrit' :: Creature +chaseCrit' = defaultCreature { _crUpdate = stateUpdate chaseAI , _crHP = 300 , _crPict = basicCrPict green diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index e8edb1764..54dbc4621 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -76,7 +76,7 @@ crMvBy p' cr = stepForward (magV p) $ over crPos (+.+ p) cr where p = (*.*) (equipFactor * aimingFactor) $ rotateV (_crDir cr) p' equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr - aimingFactor | (_posture $ _stance $ _crState cr) == Aiming + aimingFactor | (_posture $ _crStance cr) == Aiming = fromMaybe 1 $ it ^? itAimingSpeed | otherwise = 1 it = _crInv cr IM.! _crInvSel cr @@ -85,7 +85,7 @@ stepForward :: Float -- ^ Speed -> Creature -> Creature -stepForward speed cr = over (crState . stance . carriage) f cr +stepForward speed cr = over (crStance . carriage) f cr where f (w@Walking {}) = w {_stepToAdd = ceiling speed} f s = s diff --git a/src/Dodge/Creature/ChooseTarget.hs b/src/Dodge/Creature/ChooseTarget.hs new file mode 100644 index 000000000..8051ee937 --- /dev/null +++ b/src/Dodge/Creature/ChooseTarget.hs @@ -0,0 +1,9 @@ +module Dodge.Creature.ChooseTarget + where +import Dodge.Data +import Dodge.Base + +targetYouLOS :: Creature -> World -> Maybe Creature +targetYouLOS cr w + | hasLOS (_crPos cr) (_crPos $ you w) w = Just $ you w + | otherwise = Nothing diff --git a/src/Dodge/Creature/ImpulseRat.hs b/src/Dodge/Creature/ImpulseRat.hs new file mode 100644 index 000000000..a616df59f --- /dev/null +++ b/src/Dodge/Creature/ImpulseRat.hs @@ -0,0 +1,26 @@ +module Dodge.Creature.ImpulseRat + where +import Dodge.Data +import Dodge.Creature.ChooseTarget +import Dodge.Creature.Rationality.Data +import Geometry + +chaseImpulse' + :: (Creature -> World -> Maybe Creature) -- ^ Function for determining target + -> Creature + -> World + -> [Impulse] +chaseImpulse' targFunc cr w = case targFunc cr w of + Nothing -> [] + Just crTarg -> chaseTarg cr crTarg + +chaseTarg :: Creature -> Creature -> [Impulse] +chaseTarg cr crT + | dist tpos cpos < combinedRad + 5 + && abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4 + = [Melee (_crID crT)] + | otherwise = [MoveForward 3 , TurnToward 0.05 tpos] + where + cpos = _crPos cr + tpos = _crPos crT + combinedRad = _crRad cr + _crRad crT diff --git a/src/Dodge/Creature/Rationality.hs b/src/Dodge/Creature/Rationality.hs index 63d008158..5bd931a62 100644 --- a/src/Dodge/Creature/Rationality.hs +++ b/src/Dodge/Creature/Rationality.hs @@ -5,10 +5,18 @@ import Dodge.Creature.Rationality.Data import Dodge.Creature.Action import Dodge.Creature.Action.UseItem +import System.Random +import Control.Lens + impulsiveAI :: (Impulse -> World -> Creature -> (World -> World, Creature)) -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) -impulsiveAI = undefined +impulsiveAI impulseFunc w (f,g) cr + = (\(f''' ,cr) -> ((f''',g),Just cr)) + $ foldr + (\imp (f' , cr') -> let (f'', cr'') = impulseFunc imp w cr' in (f'' . f', cr'')) + (id, cr) + (_crImpulse $ _crRationality cr) applyBasicImpulse :: Impulse @@ -16,11 +24,10 @@ applyBasicImpulse -> Creature -> (World -> World , Creature) applyBasicImpulse imp w cr = case imp of - Move p = (id, creatureMove p cr) - Turn a = (id, creatureTurn a cr) - UseItem = (crUseItem cr, cr) - SwitchToItem i = (id, cr & crInvSel .~ i) - Wait t = (id, cr & crRationality . crImpulse . waitTime -~ 1 - _ = (id, cr) - DropItem = undefined + Move p -> (id, creatureMove p cr) + Turn a -> (id, creatureTurn a cr) + UseItem -> (crUseItem cr, cr) + SwitchToItem i -> (id, cr & crInvSel .~ i) + _ -> (id, cr) + DropItem -> undefined diff --git a/src/Dodge/Creature/Rationality/Data.hs b/src/Dodge/Creature/Rationality/Data.hs index 76e8a5031..ba2896128 100644 --- a/src/Dodge/Creature/Rationality/Data.hs +++ b/src/Dodge/Creature/Rationality/Data.hs @@ -9,20 +9,21 @@ import Control.Lens data Rationality = NonRat | ImpulseRat - {_crImpulse :: Impulse } + {_crImpulse :: [Impulse] } | ActionRat - {_crImpulse :: Impulse + {_crImpulse :: [Impulse] ,_crAction :: Action } | StrategyRat - {_crImpulse :: Impulse + {_crImpulse :: [Impulse] ,_crAction :: Action ,_crStrategy :: Strategy } - data Impulse = Move Point2 + | MoveForward Float | Turn Float + | TurnToward Float Point2 | UseItem | SwitchToItem Int | DropItem @@ -30,8 +31,8 @@ data Impulse | UseWorldObject Int | Bark -- placeholder for various communication types | UseIntrinsicAbility + | Melee Int | ChangePosture Posture - | Wait {_waitTime :: Int} data Action = Attack Int diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 8f4d375f6..5d3ad56f7 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -99,7 +99,7 @@ sumDamage cr dm x = x + _dmAmount dm movementSideEff :: Creature -> World -> World movementSideEff cr w | hasJetPack - = case cr ^? crState . stance . carriage of + = case cr ^? crStance . carriage of Just (Boosting v) -> makeFlameletTimed (oldPos +.+ (_crRad cr + 3) *.* (unitVectorAtAngle $ _crDir cr + pi)) @@ -110,7 +110,7 @@ movementSideEff cr w $ set randGen g w _ -> w - | otherwise = case cr ^? crState . stance . carriage of + | otherwise = case cr ^? crStance . carriage of Just (Walking x y) -> takeStep x y w _ -> w where hasJetPack = any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr @@ -154,12 +154,12 @@ updateMovement g cr | isFrictionless cr = (over crPos (+.+ momentum) $ setOldPos cr, g') | otherwise - = case cr ^? crState . stance . carriage of + = case cr ^? crStance . carriage of Just (Walking x y) - -> (set (crState . stance . carriage) (Walking ((x+y)`mod`120) 0) + -> (set (crStance . carriage) (Walking ((x+y)`mod`120) 0) $ setOldPos cr, g) - _ -> (set (crState . stance . carriage) (Walking 0 0) + _ -> (set (crStance . carriage) (Walking 0 0) $ setOldPos cr, g) where @@ -170,7 +170,7 @@ updateMovement g cr (randAng,g') = randomR (0,2*pi) g isFrictionless :: Creature -> Bool -isFrictionless cr = case cr ^? crState . stance . carriage of +isFrictionless cr = case cr ^? crStance . carriage of Just (Boosting _) -> True Just (Floating) -> True _ -> False diff --git a/src/Dodge/Creature/State/Data.hs b/src/Dodge/Creature/State/Data.hs index c58192bd5..51cd3afb3 100644 --- a/src/Dodge/Creature/State/Data.hs +++ b/src/Dodge/Creature/State/Data.hs @@ -11,7 +11,6 @@ import Control.Lens data CreatureState = CrSt { _goals :: [[Impulse]] - , _stance :: Stance , _faction :: Faction , _crDamage :: [DamageType] , _crPastDamage :: [[DamageType]] diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index 2f541c204..178bf1fe0 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -37,45 +37,45 @@ wasdWithAiming w speed aimSpeed i cr -- = over crPos (+.+ (speed *.* mov)) = over crPos (+.+ (speed *.* unitVectorAtAngle mouseDir)) . set crDir mouseDir - $ set (crState . stance . carriage) (Boosting mov) + $ set (crStance . carriage) (Boosting mov) cr | any (\it -> it ^? itIdentity == Just JetPack) (_crInv cr) && isMoving && isAiming = set crDir mouseDir - $ set (crState . stance . carriage) Floating + $ set (crStance . carriage) Floating cr | any (\it -> it ^? itIdentity == Just JetPack) (_crInv cr) && isMoving = over crPos (+.+ (speed *.* mov)) . over crDir (flip fromMaybe dir) - $ set (crState . stance . carriage) (Boosting mov) + $ set (crStance . carriage) (Boosting mov) cr | any (\it -> it ^? itIdentity == Just JetPack) (_crInv cr) && isAiming - = set (crState . stance . carriage) Floating + = set (crStance . carriage) Floating $ set crDir mouseDir cr | any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr - = set (crState . stance . carriage) Floating + = set (crStance . carriage) Floating cr | isAiming = stepForward aimSpeed $ over crPos (+.+ (aimSpeed *.* mov)) $ set crDir mouseDir - $ set (crState . stance . carriage) (Walking 0 0) + $ set (crStance . carriage) (Walking 0 0) cr | isMoving = stepForward speed $ over crPos (+.+ (speed *.* mov)) $ over crDir (`fromMaybe` dir) - $ set (crState . stance . carriage) (Walking 0 0) + $ set (crStance . carriage) (Walking 0 0) cr | otherwise = over crDir (`fromMaybe` dir) - $ set (crState . stance . carriage) Standing + $ set (crStance . carriage) Standing cr where (mov',dir') = wasdComp (view keys w) w (mov,dir) = (rotateV (_cameraRot w) mov',fmap (_cameraRot w +) dir') isMoving = mov' /= (0,0) - isAiming = _posture (_stance $ _crState cr) == Aiming + isAiming = _posture (_crStance cr) == Aiming mouseDir = case w ^? creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) . itAttachment of Just (Just ItScope{_scopePos = p}) -> normalizeAngle $ argV @@ -100,9 +100,9 @@ wasdComp ks w = f $ foldr ( (+.+) . wasdM w ) (0,0) ks mouseActionsCr :: S.Set SDL.MouseButton -> Creature -> Creature mouseActionsCr keys cr | rbPressed - = set ( crState . stance . posture) Aiming cr + = set ( crStance . posture) Aiming cr | otherwise - = set ( crState . stance . posture) AtEase cr + = set ( crStance . posture) AtEase cr where lbPressed = SDL.ButtonLeft `S.member` keys rbPressed = SDL.ButtonRight `S.member` keys diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index bde28e140..b7905df50 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -18,6 +18,7 @@ import Dodge.Picture.Layer.Data import Dodge.Creature.Data import Dodge.Creature.State.Data import Dodge.Creature.Stance.Data +import Dodge.Creature.Rationality.Data import Dodge.Data.Menu import Dodge.Data.SoundOrigin import Dodge.Data.DamageType @@ -148,6 +149,8 @@ data Creature = Creature , _crState :: CreatureState , _crCorpse :: Picture , _crApplyDamage :: [DamageType] -> Creature -> (World -> World,Creature) + , _crStance :: Stance + , _crRationality :: Rationality } data WorldState = DoorNumOpen Int diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 35cfc5d00..68e624cf9 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -10,6 +10,7 @@ import Dodge.Item.Weapon.ExtraEffect import Dodge.Data import Dodge.Creature.Stance.Data import Dodge.Creature.State.Data +import Dodge.Creature.Rationality.Data import Dodge.Data.Menu import Dodge.SoundLogic import Dodge.Base @@ -88,10 +89,11 @@ defaultCreature = Creature , _crState = defaultState , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 10 , _crApplyDamage = defaultApplyDamage + , _crStance = Stance {_carriage=Walking 0 0,_posture=AtEase} + , _crRationality = ImpulseRat [] } defaultState = CrSt { _goals = [] - , _stance = Stance {_carriage=Walking 0 0,_posture=AtEase} , _faction = NoFaction , _crDamage = [] , _crPastDamage = []