Unify some perception updates

This commit is contained in:
2026-04-03 12:13:29 +01:00
parent b7b42f50a5
commit 4e415a41ed
4 changed files with 81 additions and 65 deletions
+62 -47
View File
@@ -1,10 +1,10 @@
--{-# LANGUAGE TupleSections #-}
module Dodge.Creature.Perception (
perceptionUpdate,
chaseCritPerceptionUpdate,
visionCheck,
) where
import Dodge.SoundLogic.ExternallyGeneratedSounds
import Dodge.Creature.Vocalization
import Control.Lens
import Control.Monad
@@ -27,17 +27,17 @@ perceptionUpdate ::
World ->
Creature ->
Creature
perceptionUpdate is w = rememberSounds w . basicAwarenessUpdate . basicAttentionUpdate is w
perceptionUpdate is w = rememberSounds w . basicAwarenessUpdate w . basicAttentionUpdate is w
chaseCritPerceptionUpdate :: [Int] -> World -> Creature -> Creature
chaseCritPerceptionUpdate is w =
rememberSounds w . chaseCritAwarenessUpdate w . basicAttentionUpdate is w
--chaseCritPerceptionUpdate :: [Int] -> World -> Creature -> Creature
--chaseCritPerceptionUpdate is w =
-- rememberSounds w . chaseCritAwarenessUpdate w . basicAttentionUpdate is w
{- | Update a creatures awareness based upon the creatures' current direction
of attention
-} -- TODO delete?
basicAwarenessUpdate :: Creature -> Creature
basicAwarenessUpdate cr = case _cpAttention $ _crPerception cr of
basicAwarenessUpdate :: World -> Creature -> Creature
basicAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of
Fixated i ->
cr & crPerception . cpAwareness
%~ (IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
@@ -45,7 +45,7 @@ basicAwarenessUpdate cr = case _cpAttention $ _crPerception cr of
cr
& crPerception . cpAwareness
%~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
& maybeBark
& maybeBecomeCognizant
where
oldAwareness = _cpAwareness $ _crPerception cr
newAwareness =
@@ -53,50 +53,65 @@ basicAwarenessUpdate cr = case _cpAttention $ _crPerception cr of
oldAwareness
becomesCognizant =
any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness
thejitter = [RandomImpulse $ RandImpulseCircMove 1]
maybeBark = fromMaybe id $ do
maybeBecomeCognizant = fromMaybe id $ do
guard becomesCognizant
sid <- crVocalizationSound cr
return $
crActionPlan . apAction
.~ [ImpulsesList ([Bark sid] : replicate 5 thejitter)]
.~ [ImpulsesList (crImpulsesOnCognizant w cr)
, AimAt 0 (w ^?! cWorld . lWorld . creatures . ix 0 . crPos . _xy)
]
crImpulsesOnCognizant :: World -> Creature -> [[Impulse]]
crImpulsesOnCognizant w cr = case cr ^. crType of
ChaseCrit {} | Just sid <- cognizantVoc w cr -> [Bark sid]: replicate 5 [RandomImpulse $ RandImpulseCircMove 3]
<> [[ChangeStrategy $ CloseToMelee 0]]
HoverCrit {} | Just sid <- cognizantVoc w cr -> [[Bark sid]]
<> [[ChangeStrategy $ CloseToMelee 0]]
_ | Just sid <- cognizantVoc w cr -> [Bark sid]: replicate 5 [RandomImpulse $ RandImpulseCircMove 1]
_ -> replicate 5 [RandomImpulse $ RandImpulseCircMove 3]
cognizantVoc :: World -> Creature -> Maybe SoundID
cognizantVoc w cr = case cr ^. crType of
ChaseCrit {} -> Just (evalState (takeOne (crWarningSounds cr)) (_randGen w))
HoverCrit {} -> Just beep3QuickS
_ -> Nothing
-- TODO fold in randgen update, requires that this is a world to world function
chaseCritAwarenessUpdate :: World -> Creature -> Creature
chaseCritAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of
Fixated i ->
cr & crPerception . cpAwareness
%~ (IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
AttentiveTo is ->
cr
& crPerception . cpAwareness
%~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
& maybeBark
where
oldAwareness = _cpAwareness $ _crPerception cr
newAwareness =
(IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
oldAwareness
becomesCognizant =
any isCognizant $
IM.unionWith cogRaised oldAwareness newAwareness
thejitter = [RandomImpulse $ RandImpulseCircMove 3]
maybeBark = fromMaybe id $ do
guard becomesCognizant
guard $ cr ^. crVocalization == VocReady
let soundid = evalState (takeOne (crWarningSounds cr)) (_randGen w)
numjits = fst $ randomR (15, 25) (_randGen w)
return $
(crActionPlan . apStrategy .~ WarningCry)
. ( crActionPlan . apAction
.~ [ ImpulsesList
( [Bark soundid] :
replicate numjits thejitter
++ [[ChangeStrategy $ CloseToMelee 0]]
)
, AimAt 0 (w ^?! cWorld . lWorld . creatures . ix 0 . crPos . _xy)
]
)
--chaseCritAwarenessUpdate :: World -> Creature -> Creature
--chaseCritAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of
-- Fixated i ->
-- cr & crPerception . cpAwareness
-- %~ (IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
-- AttentiveTo is ->
-- cr
-- & crPerception . cpAwareness
-- %~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
-- & maybeBark
-- where
-- oldAwareness = _cpAwareness $ _crPerception cr
-- newAwareness =
-- (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
-- oldAwareness
-- becomesCognizant =
-- any isCognizant $
-- IM.unionWith cogRaised oldAwareness newAwareness
-- thejitter = [RandomImpulse $ RandImpulseCircMove 3]
-- maybeBark = fromMaybe id $ do
-- guard becomesCognizant
-- guard $ cr ^. crVocalization == VocReady
-- let soundid = evalState (takeOne (crWarningSounds cr)) (_randGen w)
-- numjits = fst $ randomR (15, 25) (_randGen w)
-- return $
-- (crActionPlan . apStrategy .~ WarningCry)
-- . ( crActionPlan . apAction
-- .~ [ ImpulsesList
-- ( [Bark soundid] :
-- replicate numjits thejitter
-- ++ [[ChangeStrategy $ CloseToMelee 0]]
-- )
-- , AimAt 0 (w ^?! cWorld . lWorld . creatures . ix 0 . crPos . _xy)
-- ]
-- )
cogRaised :: Awareness -> Awareness -> Awareness
cogRaised Suspicious{} Cognizant{} = Cognizant 100
+1 -1
View File
@@ -18,7 +18,7 @@ chaseCritInternal w cr =
, setViewPos
, setMvPos
, chaseCritMv
, chaseCritPerceptionUpdate [0]
, perceptionUpdate [0]
, targetYouWhenCognizant
, const searchIfDamaged
, const (crType . meleeCooldown %~ max 0 . subtract 1)
+2 -2
View File
@@ -339,8 +339,8 @@ chasmSpitTerminal = do
tToBTree "chasmTerm" $
Node
(addDoorToggleTerminal' i1 (PS 150 0) y')
--[ treePost [triggerDoorRoom i1, deadEndPSType (PutCrit chaseCrit)]
[ treePost [triggerDoorRoom i1, deadEndPSType (PutCrit hoverCrit)]
[ treePost [triggerDoorRoom i1, deadEndPSType (PutCrit chaseCrit)]
--[ treePost [triggerDoorRoom i1, deadEndPSType (PutCrit hoverCrit)]
--[ treePost [triggerDoorRoom i1, deadEndRoom]
, treePost [triggerDoorRoom i1, deadEndPSType (PutCrit hoverCrit)]
, return $ cleatOnward $ triggerDoorRoom i1
+16 -15
View File
@@ -2664,7 +2664,7 @@ autoCrit src/Dodge/Creature/AutoCrit.hs 10;" f
autoGunS src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs 554;" f
autoPistol src/Dodge/Item/Held/Stick.hs 21;" f
autoRifle src/Dodge/Item/Held/Cane.hs 27;" f
awakeLevelPerception src/Dodge/Creature/Perception.hs 161;" f
awakeLevelPerception src/Dodge/Creature/Perception.hs 168;" f
axisInt src/Geometry/Intersect.hs 246;" f
azure src/Color.hs 49;" f
bQuadToF src/Geometry/Bezier.hs 37;" f
@@ -2695,7 +2695,7 @@ baseShoulder src/Dodge/Creature/Picture.hs 161;" f
baseStickShape src/Dodge/Item/Draw/SPic.hs 301;" f
baseStickShapeX src/Dodge/Item/Draw/SPic.hs 293;" f
baseStickSpread src/Dodge/HeldUse.hs 346;" f
basicAttentionUpdate src/Dodge/Creature/Perception.hs 127;" f
basicAttentionUpdate src/Dodge/Creature/Perception.hs 134;" f
basicAwarenessUpdate src/Dodge/Creature/Perception.hs 39;" f
basicCrPict src/Dodge/Creature/Picture.hs 33;" f
basicCrShape src/Dodge/Creature/Picture.hs 39;" f
@@ -2813,7 +2813,7 @@ charToTuple src/Picture/Base.hs 312;" f
charToTupleGrad src/Picture/Text.hs 18;" f
chartreuse src/Color.hs 51;" f
chaseCrit src/Dodge/Creature/ChaseCrit.hs 28;" f
chaseCritAwarenessUpdate src/Dodge/Creature/Perception.hs 65;" f
chaseCritAwarenessUpdate src/Dodge/Creature/Perception.hs 72;" f
chaseCritInternal src/Dodge/Humanoid.hs 11;" f
chaseCritMv src/Dodge/Creature/ReaderUpdate.hs 123;" f
chaseCritPerceptionUpdate src/Dodge/Creature/Perception.hs 32;" f
@@ -2886,7 +2886,7 @@ clsNearCirc src/Dodge/Zoning/Cloud.hs 21;" f
clsNearPoint src/Dodge/Zoning/Cloud.hs 9;" f
clsNearRect src/Dodge/Zoning/Cloud.hs 18;" f
clsNearSeg src/Dodge/Zoning/Cloud.hs 15;" f
cogRaised src/Dodge/Creature/Perception.hs 101;" f
cogRaised src/Dodge/Creature/Perception.hs 108;" f
colCrWall src/Dodge/WallCreatureCollisions.hs 27;" f
colCrsWalls src/Dodge/WallCreatureCollisions.hs 19;" f
collectDamageTypes src/Dodge/Damage.hs 54;" f
@@ -2908,7 +2908,7 @@ colorLamp src/Dodge/Creature/Lamp.hs 10;" f
colorSH src/Shape.hs 234;" f
combinationsOf src/Multiset.hs 46;" f
combinationsTrie src/Dodge/Combine.hs 44;" f
combineAwareness src/Dodge/Creature/Perception.hs 109;" f
combineAwareness src/Dodge/Creature/Perception.hs 116;" f
combineFloors src/Dodge/Room/Procedural.hs 154;" f
combineInventoryExtra src/Dodge/Render/HUD.hs 340;" f
combineItemListYouX src/Dodge/Combine.hs 36;" f
@@ -2969,6 +2969,7 @@ crHeight src/Dodge/Base/Collide.hs 175;" f
crHit src/Dodge/WorldEvent/ThingsHit.hs 137;" f
crIXsNearCirc src/Dodge/Zoning/Creature.hs 33;" f
crIXsNearPoint src/Dodge/Zoning/Creature.hs 15;" f
crImpulsesOnAlert src/Dodge/Creature/Perception.hs 64;" f
crInAimStance src/Dodge/Creature/Test.hs 91;" f
crIntelligence src/Dodge/Creature/Statistics.hs 39;" f
crIsAiming src/Dodge/Creature/Test.hs 58;" f
@@ -3126,7 +3127,7 @@ decomposeTree src/Dodge/Tree/Compose.hs 59;" f
decontamRoom src/Dodge/Room/Airlock.hs 37;" f
decoratedBlock src/Dodge/Placement/Instance/Block.hs 14;" f
decorationToShape src/Dodge/Placement/TopDecoration.hs 16;" f
decreaseAwareness src/Dodge/Creature/Perception.hs 118;" f
decreaseAwareness src/Dodge/Creature/Perception.hs 125;" f
decrementTimer src/Sound.hs 104;" f
dedaS src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs 560;" f
dededaS src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs 682;" f
@@ -3732,7 +3733,7 @@ handleMouseButtonEvent src/Dodge/Event/Input.hs 59;" f
handleMouseMotionEvent src/Dodge/Event/Input.hs 47;" f
handleMouseWheelEvent src/Dodge/Event/Input.hs 54;" f
handleOrient src/Dodge/Item/HeldOffset.hs 32;" f
handlePos src/Dodge/Item/HeldOffset.hs 94;" f
handlePos src/Dodge/Item/HeldOffset.hs 92;" f
handleResizeEvent src/Dodge/Event.hs 53;" f
handleTextInput src/Dodge/Event/Input.hs 19;" f
handleWindowMoveEvent src/Dodge/Event.hs 44;" f
@@ -3756,7 +3757,7 @@ heldAimStance src/Dodge/Item/AimStance.hs 28;" f
heldAimZoom src/Dodge/Update/Camera.hs 158;" f
heldEffect src/Dodge/HeldUse.hs 64;" f
heldEffectMuzzles src/Dodge/HeldUse.hs 135;" f
heldHandlePos src/Dodge/Item/HeldOffset.hs 100;" f
heldHandlePos src/Dodge/Item/HeldOffset.hs 98;" f
heldInfo src/Dodge/Item/Info.hs 92;" f
heldItemAmmoSlots src/Dodge/Item/AmmoSlots.hs 20;" f
heldItemBulkiness src/Dodge/Creature/YourControl.hs 170;" f
@@ -3881,7 +3882,7 @@ invisibleChaseCrit src/Dodge/Creature/ChaseCrit.hs 22;" f
invisibleWall src/Dodge/Placement/Instance/Wall.hs 27;" f
isAmmoIntLink src/Dodge/HeldUse.hs 738;" f
isAnimate src/Dodge/Creature/Test.hs 132;" f
isCognizant src/Dodge/Creature/Perception.hs 105;" f
isCognizant src/Dodge/Creature/Perception.hs 112;" f
isConnected src/Dodge/Inventory/Swap.hs 77;" f
isCornerLink src/Dodge/RoomLink.hs 66;" f
isFlyable src/Dodge/WorldEvent/ThingsHit.hs 192;" f
@@ -4317,9 +4318,9 @@ nearRect src/Dodge/Zoning/Common.hs 16;" f
nearSeg src/Dodge/Zoning/Common.hs 12;" f
nearZeroAngle src/Geometry/Vector.hs 140;" f
nearestAngleRep src/Geometry.hs 148;" f
newExtraAwareness src/Dodge/Creature/Perception.hs 137;" f
newExtraAwareness src/Dodge/Creature/Perception.hs 144;" f
newKey src/IntMapHelp.hs 61;" f
newSounds src/Dodge/Creature/Perception.hs 169;" f
newSounds src/Dodge/Creature/Perception.hs 176;" f
newSoundsToPlay src/Dodge/SoundSelection.hs 8;" f
newTextureFramebuffer src/Framebuffer/Setup.hs 16;" f
nextArc src/Dodge/Tesla.hs 60;" f
@@ -4697,7 +4698,7 @@ reload1S src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs 706;" f
reloadFailS src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs 804;" f
reloadLevelStart src/Dodge/Save.hs 71;" f
reloadS src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs 534;" f
rememberSounds src/Dodge/Creature/Perception.hs 176;" f
rememberSounds src/Dodge/Creature/Perception.hs 183;" f
remoteDetonator src/Dodge/Item/Scope.hs 152;" f
remoteScreen src/Dodge/Item/Scope.hs 146;" f
removeAimPosture src/Dodge/Creature/YourControl.hs 136;" f
@@ -5066,7 +5067,7 @@ someCrits src/Dodge/LockAndKey.hs 122;" f
soundAngle src/Dodge/SoundLogic.hs 163;" f
soundContinue src/Dodge/SoundLogic.hs 131;" f
soundContinueVol src/Dodge/SoundLogic.hs 145;" f
soundIsClose src/Dodge/Creature/Perception.hs 182;" f
soundIsClose src/Dodge/Creature/Perception.hs 189;" f
soundMenu src/Dodge/Menu.hs 158;" f
soundMenuOptions src/Dodge/Menu.hs 161;" f
soundMultiFrom src/Dodge/SoundLogic.hs 187;" f
@@ -5394,7 +5395,7 @@ twinSlowDoorChasers src/Dodge/Room/LongDoor.hs 83;" f
twinSlowDoorRoom src/Dodge/Room/LongDoor.hs 39;" f
twists src/Dodge/Creature/Test.hs 101;" f
twoFlat src/Dodge/Creature/Test.hs 98;" f
twoFlatHRot src/Dodge/Item/HeldOffset.hs 91;" f
twoFlatHRot src/Dodge/Item/HeldOffset.hs 89;" f
twoHandOffY src/Dodge/Creature/HandPos.hs 130;" f
twoHandTwistAmount src/Dodge/Creature/YourControl.hs 142;" f
twoRoomPoss src/Dodge/PlacementSpot.hs 148;" f
@@ -5610,7 +5611,7 @@ viewRoomBoundaries src/Dodge/Debug/Picture.hs 341;" f
viewTarget src/Dodge/Creature/ReaderUpdate.hs 171;" f
violet src/Color.hs 48;" f
visibleWalls src/Dodge/Base/Collide.hs 218;" f
visionCheck src/Dodge/Creature/Perception.hs 152;" f
visionCheck src/Dodge/Creature/Perception.hs 159;" f
volleyGun src/Dodge/Item/Held/Cane.hs 15;" f
volleyGunShape src/Dodge/Item/Draw/SPic.hs 355;" f
walkNozzle src/Dodge/HeldUse.hs 826;" f