Cleanup Action datatypes, clear sel set if scroll different section

2026-05-10 23:32:59 +01:00
parent dfb451c450
commit b213525c21
11 changed files with 276 additions and 206 deletions
@@ -39,14 +39,16 @@ import qualified Data.Set as S
 -- it is desirable to be able to determine when an action is finished,
 -- so that DoActionThen and the like are easy to define
 performActions :: Int -> World -> World
-performActions cid w =
-    foldl'
+performActions cid w = fromMaybe w $ do
+    a <- cr ^?crActionPlan.apAction
+    let (iss, mayas) = performAction cr w a
+    return $ foldl'
        (followImpulse cid)
        (w & cWorld . lWorld . creatures . ix cid . crActionPlan . apAction .~ mayas)
        iss
  where
    cr = w ^?! cWorld . lWorld . creatures . ix cid
-    (iss, mayas) = maybe ([],NoAction) (performAction cr w) (cr ^? crActionPlan . apAction)
+--    (iss, mayas) = maybe ([],NoAction) (performAction cr w) (cr ^? crActionPlan . apAction)

 type ActionUpdate = ([Impulse], Action)

@@ -55,6 +57,7 @@ type ActionUpdate = ([Impulse], Action)
 -}
 performAction :: Creature -> World -> Action -> ActionUpdate
 performAction cr w ac = case ac of
+    Eat {} -> ([],NoAction)
    AimAt tcid p -> performAimAt cr w tcid p
    WaitThen 0 newAc -> ([], newAc)
    WaitThen t newAc -> ([], WaitThen (t -1) newAc)
@@ -65,7 +68,7 @@ performAction cr w ac = case ac of
    DoActionThen fsta afta -> case performAction cr w fsta of
        (imps, NoAction) -> (imps, afta)
        (imps, nxta) -> (imps, DoActionThen nxta afta)
-    DoActionWhile f act -> performAction cr w $ DoActionWhilePartial act f act
+--    DoActionWhile f act -> performAction cr w $ DoActionWhilePartial act f act
    DoActionWhilePartial partAc f resetAc
        | doWdCrBl f w cr -> case performAction cr w partAc of
            (imps, NoAction) -> (imps, DoActionWhilePartial resetAc f resetAc)
@@ -80,11 +83,6 @@ performAction cr w ac = case ac of
    DoActionWhileInterrupt repa f afta
        | doWdCrBl f w cr -> (fst $ performAction cr w repa, DoActionWhileInterrupt repa f afta)
        | otherwise -> performAction cr w afta
--    DoActions [] -> ([], NoAction)
--    DoActions acs ->
--        let (imps, newAcs) = foldMap (performAction cr w) acs
--         in (imps, newAcs)
--    StartSentinelPost -> ([AddGoal $ SentinelAt (cr ^. crPos . _xy) (_crDir cr)], NoAction)
    PathTo p a -> performPathTo a cr w p
    EvadeAim -> tryEvadeSideways cr w
    TurnToPoint p -> performTurnToA cr p
@@ -92,8 +90,6 @@ performAction cr w ac = case ac of
        i <- cr ^? crIntention . targetCr . _Just
        tcr <- w ^? cWorld . lWorld . creatures . ix i
        return ([TurnTo (tcr ^. crPos . _xy +.+ rotateV (_crDir tcr) p)], NoAction)
--    UseSelf f -> performAction cr w $ doCrAc f cr
--    ArbitraryAction f -> performAction cr w (doCrWdAc f cr w)
    DoImpulsesAlongside sideImp mainAc -> performAction cr w mainAc & _1 <>~ sideImp
    DoReplicate t nxtac -> performAction cr w $ DoReplicatePartial nxtac t nxtac
    DoReplicatePartial _ 0 pac -> performAction cr w pac
@@ -38,6 +38,8 @@ chaseCrit =
        & crName .~ "chaseCrit"
        & crHP .~ HP 150
        & crFaction .~ ColorFaction green
+        & crActionPlan . apGoal .~ SearchForFood
+        & crActionPlan . apStrategy .~ Search

 crabCrit :: Creature
 crabCrit = defaultCreature
@@ -2,6 +2,11 @@

 module Dodge.Creature.Update (updateCreature) where

+import qualified Data.Semigroup as Semi
+import Dodge.WorldEvent.ThingsHit
+import Dodge.Humanoid
+import Dodge.Creature.Perception
+import Dodge.Creature.ReaderUpdate
 import Dodge.Creature.Slime
 import Dodge.Creature.Radius
 import Dodge.Creature.MoveType
@@ -25,7 +30,6 @@ import Dodge.Creature.YourControl
 import Dodge.Damage
 import Dodge.Data.Damage.Type
 import Dodge.Data.World
-import Dodge.Humanoid
 import Dodge.Inventory
 import Dodge.Lampoid
 import Dodge.Prop.Gib
@@ -62,7 +66,7 @@ updateLivingCreature cr = case cr ^. crType of
            . yourControl
    LampCrit{} -> updateLampoid cr
    BarrelCrit bt -> updateBarreloid bt cr
-    ChaseCrit{} -> crUpdate cid . performActions cid . updateChaseCrit cid
+    ChaseCrit{} -> crUpdate cid . performActions cid . updateChaseCrit cid cr
    CrabCrit{} -> crUpdate cid . performActions cid . crabCritInternal cid
    AutoCrit{} -> crUpdate cid
    SwarmCrit{} -> crUpdate cid
@@ -364,6 +368,72 @@ slinkCritUpdate cid w =
        . _2
        *~ Q.axisAngle (V3 0 1 0) (pi / 1000)

+updateChaseCrit :: Int -> Creature -> World -> World
+updateChaseCrit cid cr 
+    | SearchForFood <- cr ^?! crActionPlan . apGoal = updateFoodSearchChaseCrit cid cr
+    | Flee <- cr^?!crActionPlan.apGoal
+        , NoAction <- cr^?!crActionPlan.apAction = tocr.crActionPlan.apGoal.~SearchForFood
+    | Flee <- cr^?!crActionPlan.apGoal = id
+    | otherwise = updateCalmChaseCrit cid
+  where
+    tocr = cWorld.lWorld.creatures.ix cid
+
+updateFoodSearchChaseCrit :: Int -> Creature -> World -> World
+updateFoodSearchChaseCrit cid cr w 
+    | (tcr:_) <- sortOn f . IM.elems . IM.filter avoidcr $ crsNearCirc cxy 60 w 
+        = let p = fleePoint cr cxy (20 *^ normalize (cxy - tcr^.crPos._xy)) w
+          in w &tocr.crActionPlan.apAction.~PathTo p NoAction
+                &tocr.crActionPlan.apGoal.~Flee
+    | CloseToMelee i<-cr^?!crActionPlan.apStrategy 
+        ,Just tcr <-w^?cWorld.lWorld.creatures.ix i
+        ,distance cxy (tcr^.crPos._xy) < 11 = w
+            & tocr.crActionPlan.apAction.~NoAction
+            & tocr.crActionPlan.apStrategy.~Search
+            & cWorld.lWorld.creatures.at i.~Nothing
+    | CloseToMelee{}<-cr^?!crActionPlan.apStrategy 
+        ,PathTo{}<-cr^?!crActionPlan.apAction= w
+    | xs@(_:_) <- IM.elems . IM.filter istarget $ crsNearCirc cxy 100 w 
+    , (tcr,g) <- runState (takeOne xs) (w ^. randGen) = w&tocr.crActionPlan.apAction.~DoImpulses[MvForward]
+        &tocr.crActionPlan.apStrategy.~CloseToMelee (tcr^.crID)
+        &tocr.crActionPlan.apAction.~PathTo (tcr^.crPos._xy) NoAction
+        &randGen.~g
+    | otherwise = w
+  where
+    f c = fromMaybe 100 $ do
+        s <- cr^?crType.slimeSlime
+        return $ dist cxy (c^.crPos._xy) - sqrt(0.01*fromIntegral s)
+    tocr = cWorld . lWorld . creatures . ix cid
+    cxy = cr ^. crPos . _xy
+    avoidcr c | ct@SlimeCrit{} <- c^.crType = distance cxy (c^.crPos._xy)-crRad ct < 10
+        | otherwise = False
+    istarget tcr 
+        | BeeCrit{} <- tcr^.crType 
+        , CrIsCorpse{} <- tcr^.crHP = True
+        | otherwise = False
+    
+fleePoint :: Creature -> Point2 -> Point2 -> World -> Point2
+fleePoint c p v w = g . minimum $ f <$> [p+v, p+0.9*^vNormal v, p-0.9*^vNormal v]
+  where
+    f ep = let q = walkablePoint c p ep w
+            in Semi.Arg (-distance q p) q
+    g (Semi.Arg _ x) = x
+
+
+updateCalmChaseCrit :: Int -> World -> World
+updateCalmChaseCrit cid w = w
+    & tocr %~ overrideMeleeCloseTarget w
+    & tocr %~ setViewPos w
+    & tocr %~ setMvPosToTargetCr w
+    & tocr %~ chaseCritMv w
+    & tocr %~ perceptionUpdate [0] w
+    & tocr %~ targetYouWhenCognizant w
+    & tocr %~ searchIfDamaged
+    & tocr . crType . meleeCooldown %~ max 0 . subtract 1
+    & tocr . crVocalization %~ updateVocTimer
+  where
+    tocr = cWorld . lWorld . creatures . ix cid
+
+
 hoverCritHoverSound :: Creature -> World -> World
 hoverCritHoverSound cr w
    | d < 100 
@@ -2,12 +2,12 @@
 module Dodge.Creature.Volition (
    holsterWeapon,
    drawWeapon,
-    shootTillEmpty,
+--    shootTillEmpty,
    shootFirstMiss,
 ) where

 import Dodge.Data.Creature
-import Dodge.Data.CreatureEffect
+--import Dodge.Data.CreatureEffect
 import Dodge.SoundLogic.LoadSound
 import Geometry

@@ -15,11 +15,11 @@ holsterWeapon, drawWeapon :: Action
 holsterWeapon = DoImpulses [ChangePosture AtEase, MakeSound whiteNoiseFadeOutS]
 drawWeapon = DoImpulses [ChangePosture Aiming, MakeSound whiteNoiseFadeInS]

-shootTillEmpty :: Action
--shootTillEmpty = (crCanShoot `DoActionWhile` DoImpulses [UseItem])
-shootTillEmpty =
-    (WdCrBlfromCrBl CrCanShoot `DoActionWhile` DoImpulses [UseItem])
-        `DoActionThen` 20 `WaitThen` holsterWeapon
+--shootTillEmpty :: Action
+----shootTillEmpty = (crCanShoot `DoActionWhile` DoImpulses [UseItem])
+--shootTillEmpty =
+--    (WdCrBlfromCrBl CrCanShoot `DoActionWhile` DoImpulses [UseItem])
+--        `DoActionThen` 20 `WaitThen` holsterWeapon

 --advanceShoot :: Int -> Action
 --advanceShoot tcid = lostest `DoActionWhile`