ActionPlan refactor

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
+    UseTarget f -> performAction cr w $ doMCrAc f $ cr ^? crIntention . targetCr . _Just
-    UseSelf f   -> performAction cr w $ f cr
+    UseSelf f   -> performAction cr w $ doCrAc f cr
-    UseAheadPos f -> performAction cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
+    UseAheadPos f -> performAction cr w (doP2Ac f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
-    UseMvTargetPos f -> performAction cr w $ f $ _mvToPoint $ _crIntention cr
+    UseMvTargetPos f -> performAction cr w $ doMP2Ac f $ _mvToPoint $ _crIntention cr
-    ArbitraryAction f -> performAction cr w (f cr w)
+    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)

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
+bfsThenReturn t = ArbitraryAction (CrWdBFSThenReturn t)
-  where
+--    theaction
-    theaction cr w = fromMaybe NoAction $ do
+--  where
-        n <- walkableNodeNear w (_crPos cr)
+--    theaction cr w = fromMaybe NoAction $ do
-        let as = take 20 $ map PathTo $ bfsNodePoints n w
+--        n <- walkableNodeNear w (_crPos cr)
-        return $ DoReplicate t $
+--        let as = take 20 $ map PathTo $ bfsNodePoints n w
-            foldr DoActionThen NoAction as
+--        return $ DoReplicate t $
+--            foldr DoActionThen NoAction as
         
     

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

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])

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

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

src/Dodge/Data/ActionPlan.hs

@@ -0,0 +1 @@
+module Dodge.Data.ActionPlan where

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

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 
+              , \_ _ -> StrategyActions Flee 
-                    [WdCrNegate (WdCrSafeDistFromTarget 150) `DoActionWhile` UseTarget (fleeFrom cr')
+                    [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 ])