ActionPlan refactor

2022-07-21 22:56:19 +01:00
parent 583027112d
commit dfc9b2dca9
9 changed files with 180 additions and 61 deletions
@@ -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)
@@ -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
        
    
@@ -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
@@ -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])
@@ -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
@@ -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
@@ -0,0 +1 @@
+module Dodge.Data.ActionPlan where
@@ -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
@@ -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 ])