justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Remove reified impulses from creature record

Browse Source
This commit is contained in:
justin
2025-10-18 15:42:35 +01:00
parent b43168ae33
commit 4ee389efb1
16 changed files with 155 additions and 191 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Action.hs
+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
src/Dodge/Creature/ArmourChase.hs
+1 -2
View File
@@ -22,8 +22,7 @@ flockArmourChaseCrit =
-- ]
, _crActionPlan =
ActionPlan
{ _apImpulse = []
, _apAction = []
{ _apAction = []
, _apStrategy = FollowImpulses
, _apGoal = [Kill 0]
}
src/Dodge/Creature/Boid.hs
+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
src/Dodge/Creature/Impulse.hs
+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
src/Dodge/Creature/Perception.hs
+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)
src/Dodge/Creature/ReaderUpdate.hs
+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)]
]
src/Dodge/Creature/SentinelAI.hs
+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
src/Dodge/Creature/Update.hs
+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
src/Dodge/Data/ActionPlan.hs
+2 -9
View File
@@ -16,8 +16,8 @@ import Sound.Data
data ActionPlan
= Inanimate
| ActionPlan
{ _apImpulse :: [Impulse] -- done per frame
, _apAction :: [Action] -- updated per frame, likely persist across frames
{ -- _apImpulse :: [Impulse] -- done per frame
_apAction :: [Action] -- updated per frame, likely persist across frames
, _apStrategy :: Strategy -- current strategy
, _apGoal :: [Goal] -- particular ordered goals
}
@@ -187,13 +187,6 @@ concat <$> mapM (deriveJSON defaultOptions)
, ''Goal
]
--deriveJSON defaultOptions ''Impulse
--deriveJSON defaultOptions ''RandImpulse
--deriveJSON defaultOptions ''Action
--deriveJSON defaultOptions ''Strategy
--deriveJSON defaultOptions ''ActionPlan
--deriveJSON defaultOptions ''Goal
makeLenses ''ActionPlan
makeLenses ''Impulse
makeLenses ''Action
src/Dodge/Debug.hs
+2 -2
View File
@@ -84,7 +84,7 @@ succB x
debugWritableValues :: Universe -> Maybe [DebugItem]
debugWritableValues u =
Just $
mapMaybe f $
mapMaybe f
[ (uvDebugV2_1, uvDebugV2_1)
, (uvDebugV2_2, uvDebugV2_2)
]
@@ -151,7 +151,7 @@ drawCrInfo u = foldMap f . IM.elems $ w ^. cWorld . lWorld . creatures
, g "crPos" $ cr ^? crPos . _xy
, g "cpVigilance" $ cr ^? crPerception . cpVigilance
, g "crAction" $ cr ^? crActionPlan . apAction
, g "crImpulse" $ cr ^? crActionPlan . apImpulse
-- , g "crImpulse" $ cr ^? crActionPlan . apImpulse
, g "crName" $ cr ^? crName
, g "crIntention" $ cr ^? crIntention
]
src/Dodge/Default/Creature.hs
+1 -1
View File
@@ -43,7 +43,7 @@ defaultCreature =
, _strideLength = yourDefaultStrideLength
}
, _crVocalization = Mute
, _crActionPlan = ActionPlan [] [] (StrategyActions WatchAndWait [StartSentinelPost]) [LiveLongAndProsper]
, _crActionPlan = ActionPlan [] (StrategyActions WatchAndWait [StartSentinelPost]) [LiveLongAndProsper]
, _crPerception = defaultPerceptionState
, _crMemory = defaultCreatureMemory
, _crFaction = NoFaction
src/Dodge/Humanoid.hs
+104 -120
View File
@@ -1,34 +1,24 @@
module Dodge.Humanoid where
module Dodge.Humanoid (chaseCritInternal) where
import Dodge.Creature.Impulse
import Linear
import Data.Maybe
import Dodge.Creature.Action
import Dodge.Creature
import Dodge.Data.CreatureEffect
import Dodge.Data.World
import Geometry
import LensHelp
import RandomHelp
updateHumanoid :: Creature -> World -> World
updateHumanoid cr = case cr ^?! crType of
ChaseCrit {} ->
humanoidAIList
[ const doStrategyActions
, performActions
, overrideMeleeCloseTarget
, setViewPos
, setMvPos
, chaseCritMv
, chaseCritPerceptionUpdate [0]
, targetYouWhenCognizant
, const searchIfDamaged
, const (crType . meleeCooldown %~ max 0 . subtract 1)
, const (crVocalization . vcCoolDown %~ max 0 . subtract 1)
]
cr
_ -> id
chaseCritInternal :: World -> Creature -> Creature
chaseCritInternal =
chainCreatureUpdates
[ const doStrategyActions
, overrideMeleeCloseTarget
, setViewPos
, setMvPos
, chaseCritMv
, chaseCritPerceptionUpdate [0]
, targetYouWhenCognizant
, const searchIfDamaged
, const (crType . meleeCooldown %~ max 0 . subtract 1)
, const (crVocalization . vcCoolDown %~ max 0 . subtract 1)
]
-- SpreadGunAI ->
-- defaultImpulsive
-- [ performActions
@@ -180,97 +170,91 @@ updateHumanoid cr = case cr ^?! crType of
-- , WaitThen 1 $ (DoImpulses [ChangeStrategy WatchAndWait])
-- ]
humanoidAIList :: [World -> Creature -> Creature] -> Creature -> World -> World
humanoidAIList l cr w = followImpulses cid $
w & cWorld . lWorld . creatures . ix cid %~ chainCreatureUpdates l w
where
cid = cr ^. crID
chooseMovementPistol :: Creature -> World -> Action
chooseMovementPistol cr w =
chooseMovementPistol' cr w
`DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
chooseMovementPistol' :: Creature -> World -> Action
chooseMovementPistol' cr w =
takeOneWeighted
[chargeProb, retreatProb, strafeProb, strafeProb]
[ chargeActions
, retreatActionsPistol ycr cr
, strafeLeftActions
, strafeRightActions
]
& evalState
$ g
where
g = _randGen w
cpos = cr ^. crPos . _xy
ycr = w ^?! cWorld . lWorld . creatures . ix 0
ypos = ycr ^. crPos . _xy
chargeProb
| dist cpos ypos > 300 = 5
| dist cpos ypos > 150 = 1
| otherwise = 0
strafeProb
| dist cpos ypos > 150 = 1
| otherwise = 0
retreatProb
| dist cpos ypos < 200 = 1 :: Float
| otherwise = 0
chargeActions =
[TurnToward ypos 0.1]
`DoImpulsesAlongside` 3
`DoReplicate` ImpulsesList (replicate 9 [Move (V2 3 0)] ++ [[Move (V2 3 0), UseItem]])
strafeLeftActions =
DoImpulses [TurnToward yposr (2 * pi)]
`DoActionThen` 3
`DoReplicate` ImpulsesList (replicate 9 [Move (V2 0 3)] ++ [[Move (V2 0 3), UseItem]])
strafeRightActions =
DoImpulses [TurnToward yposl (2 * pi)]
`DoActionThen` 3
`DoReplicate` ImpulsesList (replicate 9 [Move (V2 0 (-3))] ++ [[Move (V2 0 (-3)), UseItem]])
yposl = ypos -.- 100 *.* vNormal (normalizeV $ ypos -.- cpos)
yposr = ypos +.+ 100 *.* vNormal (normalizeV $ ypos -.- cpos)
retreatActionsPistol :: Creature -> Creature -> Action
retreatActionsPistol tcr cr =
[TurnToward retreatOffset 0.2]
`DoImpulsesAlongside` 3
`DoReplicate` ImpulsesList (replicate 9 [Move (V2 (-3) 0)] ++ [[UseItem]])
where
cpos = cr ^. crPos . _xy
tpos = tcr ^. crPos . _xy
retreatOffset =
let a
| dist cpos tpos < 50 = 0
| isLeftOfA (_crDir cr) (argV $ tpos -.- cpos) =
-0.7
| otherwise = 0.7
in fromMaybe tpos $
intersectLineLine
cpos
(cpos +.+ rotateV a (tpos -.- cpos))
tpos
(tpos +.+ vNormal (cpos -.- tpos))
retreatFireLauncher :: Action
retreatFireLauncher =
ImpulsesList ([UseItem] : replicate 20 [Turn 0.16])
`DoActionThen` holsterWeapon
`DoActionThen` ImpulsesList (replicate 30 [MoveForward 3])
`DoActionThen` drawWeapon
`DoActionThen` ImpulsesList ([UseItem] : replicate 20 [Turn $ negate 0.16])
`DoActionThen` holsterWeapon
`DoActionThen` ImpulsesList (replicate 15 [MoveForward 3])
`DoActionThen` drawWeapon
`DoActionThen` ImpulsesList
( replicate
100
[ UseItem
, ImpulseUseTarget (TurnTowardCr (pi / 16))
]
)
`DoActionThen` 20
`WaitThen` holsterWeapon
`DoActionThen` ImpulsesList (replicate 15 [MoveForward 3])
`DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
--chooseMovementPistol :: Creature -> World -> Action
--chooseMovementPistol cr w =
-- chooseMovementPistol' cr w
-- `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
--
--chooseMovementPistol' :: Creature -> World -> Action
--chooseMovementPistol' cr w =
-- takeOneWeighted
-- [chargeProb, retreatProb, strafeProb, strafeProb]
-- [ chargeActions
-- , retreatActionsPistol ycr cr
-- , strafeLeftActions
-- , strafeRightActions
-- ]
-- & evalState
-- $ g
-- where
-- g = _randGen w
-- cpos = cr ^. crPos . _xy
-- ycr = w ^?! cWorld . lWorld . creatures . ix 0
-- ypos = ycr ^. crPos . _xy
-- chargeProb
-- | dist cpos ypos > 300 = 5
-- | dist cpos ypos > 150 = 1
-- | otherwise = 0
-- strafeProb
-- | dist cpos ypos > 150 = 1
-- | otherwise = 0
-- retreatProb
-- | dist cpos ypos < 200 = 1 :: Float
-- | otherwise = 0
-- chargeActions =
-- [TurnToward ypos 0.1]
-- `DoImpulsesAlongside` 3
-- `DoReplicate` ImpulsesList (replicate 9 [Move (V2 3 0)] ++ [[Move (V2 3 0), UseItem]])
-- strafeLeftActions =
-- DoImpulses [TurnToward yposr (2 * pi)]
-- `DoActionThen` 3
-- `DoReplicate` ImpulsesList (replicate 9 [Move (V2 0 3)] ++ [[Move (V2 0 3), UseItem]])
-- strafeRightActions =
-- DoImpulses [TurnToward yposl (2 * pi)]
-- `DoActionThen` 3
-- `DoReplicate` ImpulsesList (replicate 9 [Move (V2 0 (-3))] ++ [[Move (V2 0 (-3)), UseItem]])
-- yposl = ypos -.- 100 *.* vNormal (normalizeV $ ypos -.- cpos)
-- yposr = ypos +.+ 100 *.* vNormal (normalizeV $ ypos -.- cpos)
--
--retreatActionsPistol :: Creature -> Creature -> Action
--retreatActionsPistol tcr cr =
-- [TurnToward retreatOffset 0.2]
-- `DoImpulsesAlongside` 3
-- `DoReplicate` ImpulsesList (replicate 9 [Move (V2 (-3) 0)] ++ [[UseItem]])
-- where
-- cpos = cr ^. crPos . _xy
-- tpos = tcr ^. crPos . _xy
-- retreatOffset =
-- let a
-- | dist cpos tpos < 50 = 0
-- | isLeftOfA (_crDir cr) (argV $ tpos -.- cpos) =
-- -0.7
-- | otherwise = 0.7
-- in fromMaybe tpos $
-- intersectLineLine
-- cpos
-- (cpos +.+ rotateV a (tpos -.- cpos))
-- tpos
-- (tpos +.+ vNormal (cpos -.- tpos))
--
--retreatFireLauncher :: Action
--retreatFireLauncher =
-- ImpulsesList ([UseItem] : replicate 20 [Turn 0.16])
-- `DoActionThen` holsterWeapon
-- `DoActionThen` ImpulsesList (replicate 30 [MoveForward 3])
-- `DoActionThen` drawWeapon
-- `DoActionThen` ImpulsesList ([UseItem] : replicate 20 [Turn $ negate 0.16])
-- `DoActionThen` holsterWeapon
-- `DoActionThen` ImpulsesList (replicate 15 [MoveForward 3])
-- `DoActionThen` drawWeapon
-- `DoActionThen` ImpulsesList
-- ( replicate
-- 100
-- [ UseItem
-- , ImpulseUseTarget (TurnTowardCr (pi / 16))
-- ]
-- )
-- `DoActionThen` 20
-- `WaitThen` holsterWeapon
-- `DoActionThen` ImpulsesList (replicate 15 [MoveForward 3])
-- `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
src/Dodge/Path.hs
+1 -1
View File
@@ -57,7 +57,7 @@ walkableNodeNear w p = fmap fst . find (flip (isWalkable p) w . snd) $ nodesNear
nodesNear = zonesExtract (w ^. pnZoning) . snailAround $ zoneOfPoint pnZoneSize p
snailAround :: Int2 -> [Int2]
snailAround x = fmap (x+) $ smallSnailInt2
snailAround x = (x+) <$> smallSnailInt2
smallSnailInt2 :: [Int2]
smallSnailInt2 = sortOn (distance (V2 0 (0::Float)) . fmap fromIntegral)
src/Dodge/Projectile/Update.hs
+1 -1
View File
@@ -97,7 +97,7 @@ shellHitFloor p pj =
. (topj . pjVel . _z %~ bouncez)
. (topj . pjVel . _xy %~ decvel)
. (topj . pjSpin *~ 0.9)
. (bounceSound pj)
. bounceSound pj
where
bouncez x = max 0 (-0.5 * x)
topj = cWorld . lWorld . projectiles . ix (pj ^. pjID)
src/Dodge/Render/ShapePicture.hs
+1 -1
View File
@@ -1,4 +1,4 @@
{-# LANGUAGE LambdaCase #-}
--{-# LANGUAGE LambdaCase #-}
module Dodge.Render.ShapePicture (worldSPic) where
import Dodge.Debug