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
@@ -264,7 +264,7 @@ circHitWall sp ep r w =
    xep = ep + x

 -- | note that this does not push the circle away from the wall at all
-collideCircWalls :: Point2 -> Point2 -> Float -> [Wall] -> (Point2, Maybe Wall)
+collideCircWalls :: Foldable t => Point2 -> Point2 -> Float -> t Wall -> (Point2, Maybe Wall)
 {-# INLINE collideCircWalls #-}
 collideCircWalls sp ep rad = foldl' findPoint (ep, Nothing)
  where
@@ -275,14 +275,11 @@ collideCircWalls sp ep rad = foldl' findPoint (ep, Nothing)
            . _wlLine
            $ wl
    shiftbyrad (a, b) =
-        bimap
-            f
-            f
-            ( a +.+ rad *.* normalizeV (a -.- b)
-            , b +.+ rad *.* normalizeV (b -.- a)
+            ( f $ a + rad *^ normalizeV (a - b)
+            , f $ b + rad *^ normalizeV (b - a)
            )
      where
-        f = (+.+) (rad *.* normalizeV (vNormal $ a -.- b))
+        f = (+ rad *^ normalizeV (vNormal $ a - b))

 overlapCircWallsClosest :: Point2 -> Float -> [Wall] -> Maybe (Point2, Wall)
 {-# INLINE overlapCircWallsClosest #-}
@@ -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`
@@ -62,7 +62,7 @@ infixr 9 `WaitThen`

 infixr 9 `DoActionThen`

-infixr 9 `DoActionWhile`
+--infixr 9 `DoActionWhile`

 infixr 9 `DoReplicate`

@@ -74,6 +74,7 @@ data Action
        , _targetSeenAt :: Point2
        }
    | PathTo { _pathToPoint :: Point2, _pathFailAction :: Action }
+    | Eat {_targetID :: Int, _acTimer :: Int}
    | EvadeAim
    | TurnToPoint { _turnToPoint :: Point2 }
    | ImpulsesList { _impulsesListList :: [[Impulse]], _acAction :: Action }
@@ -82,10 +83,10 @@ data Action
        { _waitThenTimer :: Int
        , _waitThenAction :: Action
        }
-    | DoActionWhile
-        { _doActionWhileCondition :: WdCrBl
-        , _doActionWhileAction :: Action
-        }
+--    | DoActionWhile
+--        { _doActionWhileCondition :: WdCrBl
+--        , _doActionWhileAction :: Action
+--        }
    | DoActionWhilePartial
        { _doActionWhilePartial :: Action
        , _doActionWhileCondition :: WdCrBl
@@ -146,7 +147,6 @@ data Strategy
    | Wander
    | CloseToMelee {_meleeTarget :: Int}
    | GetTo Point2
-    | Flee
    | Search
    | SearchTimed {_searchTimer :: Int}
    | ReturnToHive
@@ -157,6 +157,8 @@ data Strategy

 data Goal
    = LiveLongAndProsper
+    | SearchForFood
+    | Flee
    | Kill {_killTarget :: Int}
    | SentinelAt {_sentinelPos :: Point2, _sentinelDir :: Float}
    deriving (Eq, Ord, Show) --Generic, Flat)
@@ -1,27 +1,13 @@
 module Dodge.Humanoid (
-    updateChaseCrit,
    crabCritInternal,
    updateHoverCrit,
+    updateVocTimer,
 ) where

 import Dodge.Creature
 import Dodge.Data.World
 import LensHelp

-updateChaseCrit :: Int -> World -> World
-updateChaseCrit 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
-
 crabCritInternal :: Int -> World -> World
 crabCritInternal cid w = w
    & tocr %~ setViewPos w
@@ -28,8 +28,13 @@ import Geometry.Data
 scrollSelectionSections :: Int -> IMSS a -> Maybe Selection -> Maybe Selection
 scrollSelectionSections yi sss msel
    | yi == 0 = msel
-    | yi > 0 = foldl' (&) msel $ replicate yi (ssScrollUsing ssLookupUp sss)
-    | otherwise = foldl' (&) msel $ replicate (negate yi) (ssScrollUsing ssLookupDown sss)
+    | yi > 0 = g $ foldl' (&) msel $ replicate yi (ssScrollUsing ssLookupUp sss)
+    | otherwise = g $ foldl' (&) msel $ replicate (negate yi) (ssScrollUsing ssLookupDown sss)
+  where
+    g msel' 
+        | msel'^?_Just.slSec /= msel^?_Just.slSec 
+            = msel'&_Just.slSet.~IS.empty
+        | otherwise = msel'

 nextInSectionSS :: IMSS a -> Maybe Selection -> Maybe Selection
 nextInSectionSS = ssScrollUsing ssLookupNextMax
@@ -58,7 +58,7 @@ crs :: Universe -> [Creature]
 crs u = u ^.. uvWorld . cWorld . lWorld . creatures . each

 testStringInit :: Universe -> [String]
-testStringInit _ = mempty
+testStringInit u = u ^. uvWorld . cWorld . lWorld . creatures . ix 5 . crActionPlan . to prettyShort
    --[show . getSum $ foldMap (Sum . crslime) (crs u)]
 --     u ^.. tocrs . each . crType . slimeSplitTimer . to show
 --    u ^.. tocrs . ix 1 . crPos . _xy . to show
@@ -20,6 +20,7 @@ module Dodge.WorldEvent.ThingsHit (
    isWalkable,
    isFlyable,
    crOnSeg,
+    walkablePoint,
 ) where

 import ListHelp
@@ -235,6 +236,10 @@ isFlyable p1 p2 =
        . foldMap (^. _2 . to getWallPathing)
        . wlsHitUnsorted p1 p2

+walkablePoint :: Creature -> Point2 -> Point2 -> World -> Point2
+{-#INLINE walkablePoint#-}
+walkablePoint cr p1 p2 w = fst $ collideCircWalls p1 p2 (crRad (cr^.crType)) (wlsNearSeg p1 p2 w)
+
 isWalkable :: Point2 -> Point2 -> World -> Bool
 {-# INLINE isWalkable #-}
 isWalkable p1 p2 w = isFlyable p1 p2 w && not (any f (w ^. cWorld . cliffs))