ActionPlan refactor

2022-07-21 22:56:19 +01:00
parent 583027112d
commit dfc9b2dca9
9 changed files with 180 additions and 61 deletions
@@ -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