Remove reified impulses from creature record

This commit is contained in:
2025-10-18 15:42:35 +01:00
parent b43168ae33
commit 4ee389efb1
16 changed files with 155 additions and 191 deletions
+4 -6
View File
@@ -33,11 +33,9 @@ import Geometry
import qualified IntMapHelp as IM
import LensHelp
performActions :: World -> Creature -> Creature
performActions w cr =
cr
& crActionPlan . apImpulse .~ concat iss
& crActionPlan . apAction .~ catMaybes mayas
performActions :: World -> Creature -> ([Impulse],Creature)
performActions w cr = (concat iss
, cr & crActionPlan . apAction .~ catMaybes mayas)
where
(iss, mayas) = unzip $ map (performAction cr w) $ cr ^. crActionPlan . apAction
@@ -125,7 +123,7 @@ performAction cr w ac = case ac of
LeadTarget p -> fromMaybe ([],Nothing) $ do
i <- cr ^? crIntention . targetCr . _Just
tcr <- w ^? cWorld . lWorld . creatures . ix i
return $ ([TurnTo (tcr ^. crPos . _xy +.+ rotateV (_crDir tcr) p)], Nothing)
return ([TurnTo (tcr ^. crPos . _xy +.+ rotateV (_crDir tcr) p)], Nothing)
UseSelf f -> performAction cr w $ doCrAc f cr
ArbitraryAction f -> performAction cr w (doCrWdAc f cr w)
DoImpulsesAlongside sideImp mainAc -> case performAction cr w mainAc of
+1 -2
View File
@@ -22,8 +22,7 @@ flockArmourChaseCrit =
-- ]
, _crActionPlan =
ActionPlan
{ _apImpulse = []
, _apAction = []
{ _apAction = []
, _apStrategy = FollowImpulses
, _apGoal = [Kill 0]
}
+5 -5
View File
@@ -210,7 +210,7 @@ flockPointTarget ::
Creature
flockPointTarget f targFunc w cr = case targFunc cr w of
Nothing -> cr
Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
Just crTarg -> cr -- & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
where
is = _swarm $ _crGroup cr
crs = IM.restrictKeys (w ^. cWorld . lWorld . creatures) is
@@ -239,7 +239,7 @@ flockToPointUsing' pf mvf w cr = fromMaybe cr $ do
i <- _targetCr $ _crIntention cr
tcr <- w ^? cWorld . lWorld . creatures . ix i
let ptarg = pf tcr cenp cr
return $ cr & crActionPlan . apImpulse .~ mvf ptarg cr tcr
return $ cr -- & crActionPlan . apImpulse .~ mvf ptarg cr tcr
where
cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter
@@ -251,7 +251,7 @@ flockFunc ::
Reader World Creature
flockFunc f targFunc cr = reader $ \w -> case targFunc cr w of
Nothing -> cr
Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
Just crTarg -> cr -- & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
where
cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter
p = f crTarg cenp cr
@@ -264,7 +264,7 @@ flockCenterFunc ::
Reader World Creature
flockCenterFunc f targFunc cr = reader $ \w -> case targFunc cr w of
Nothing -> cr
Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
Just crTarg -> cr -- & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
where
cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter
p = f crTarg cenp cr
@@ -277,7 +277,7 @@ flockPointTargetR ::
Reader World Creature
flockPointTargetR f targFunc cr = reader $ \w -> case targFunc cr w of
Nothing -> cr
Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
Just crTarg -> cr -- & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
where
is = _swarm $ _crGroup cr
--crs = IM.restrictKeys (_creatures (_cWorld w)) is
+5 -8
View File
@@ -1,7 +1,8 @@
{-# LANGUAGE TupleSections #-}
--{-# LANGUAGE TupleSections #-}
module Dodge.Creature.Impulse (followImpulses) where
import Dodge.Creature.Action
import Data.Maybe
import NewInt
import Linear
@@ -20,14 +21,10 @@ import Geometry
import LensHelp
import System.Random
--followImpulses :: World -> Creature -> (World -> World, Creature)
--followImpulses w cr = foldl' (flip f) (id, cr) (reverse $ _apImpulse $ _crActionPlan cr)
-- where
-- f imp (theupdate, cr') = first (. theupdate) $ followImpulse cr' w imp
followImpulses :: Int -> World -> World
followImpulses cid w = foldl' (followImpulse cid) w
(reverse $ w ^?! cWorld . lWorld . creatures . ix cid . crActionPlan . apImpulse)
followImpulses cid w = let (is,cr) = performActions w (w ^?! cWorld . lWorld . creatures . ix cid)
in foldl' (followImpulse cid) (w & cWorld . lWorld . creatures . ix cid .~ cr)
(reverse is)
-- note SwitchToItem doesn't necessarily update the root item correctly
followImpulse :: Int -> World -> Impulse -> World
+1 -1
View File
@@ -82,7 +82,7 @@ chaseCritAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of
IM.unionWith cogRaised oldAwareness newAwareness
thejitter = [RandomImpulse $ RandImpulseCircMove 3]
maybeBark = fromMaybe id $ do
guard $ becomesCognizant
guard becomesCognizant
guard $ cr ^? crVocalization . vcCoolDown == Just 0
let soundid = evalState (takeOne (crWarningSounds cr)) (_randGen w)
numjits = fst $ randomR (15, 25) (_randGen w)
+3 -3
View File
@@ -43,9 +43,9 @@ tryMeleeAttack cr tcr
&& Just (_crID tcr) == cr ^? crActionPlan . apStrategy . meleeTarget
&& dist tpos cpos < crRad (cr ^. crType) + crRad (tcr ^. crType) + 5
&& abs (_crDir cr - argV (tpos -.- cpos)) < pi / 4 =
cr & crActionPlan . apImpulse .~ [Melee $ _crID tcr]
& crActionPlan . apAction
.~ [ DoReplicate 10 NoAction
cr & crActionPlan . apAction
.~ [ DoImpulses [Melee $ _crID tcr] `DoActionThen`
DoReplicate 10 NoAction
`DoActionThen` DoImpulses
[ChangeStrategy (CloseToMelee $ _crID tcr)]
]
+2 -4
View File
@@ -49,8 +49,7 @@ sentinelAI =
sentinelFireType :: (Int -> Action) -> World -> Creature -> Creature
sentinelFireType f =
chainCreatureUpdates
[ performActions
, watchUpdateStrat
[ watchUpdateStrat
[
( crHasTargetLOS
, \_ _ ->
@@ -86,8 +85,7 @@ sentinelExtraWatchUpdate ::
Creature
sentinelExtraWatchUpdate xs =
chainCreatureUpdates
[ performActions
, watchUpdateStrat
[ watchUpdateStrat
(xs ++ [(const crAwayFromPost, const goToPostStrat)])
, perceptionUpdate [0]
, const doStrategyActions
+4 -2
View File
@@ -1,5 +1,6 @@
module Dodge.Creature.Update (updateCreature) where
import Dodge.Creature.Impulse
import Linear
import NewInt
import Color
@@ -47,8 +48,9 @@ updateCreature' cr =
LampCrit{} -> updateLampoid cr
BarrelCrit bt -> updateBarreloid bt cr
AvatarDead -> id
ChaseCrit {} -> crUpdate cid . updateHumanoid cr
_ -> crUpdate cid . updateHumanoid cr
ChaseCrit {} -> \w -> crUpdate cid . followImpulses cid
$ over (cWorld . lWorld . creatures . ix cid) (chaseCritInternal w) w
_ -> crUpdate cid
where
cid = cr ^. crID