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

Make _targetCr an Int id rather than a full creature

Browse Source
This commit is contained in:
justin
2025-10-15 20:09:17 +01:00
parent 57ca53638a
commit 5e6ed1d793
13 changed files with 122 additions and 123 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Action.hs
+4 -4
View File
@@ -125,10 +125,10 @@ performAction cr w ac = case ac of
StartSentinelPost -> ([AddGoal $ SentinelAt (cr ^. crPos . _xy) (_crDir cr)], Nothing)
PathTo p -> performPathTo cr w p
TurnToPoint p -> performTurnToA cr p
LeadTarget p -> case cr ^? crIntention . targetCr . _Just of
Just tcr -> ([TurnTo (tcr ^. crPos . _xy +.+ rotateV (_crDir tcr) p)], Nothing)
_ -> ([], Nothing)
UseTarget f -> performAction cr w $ doMCrAc f $ cr ^? crIntention . targetCr . _Just
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)
UseSelf f -> performAction cr w $ doCrAc f cr
UseAheadPos f -> performAction cr w (doP2Ac f (cr ^. crPos . _xy +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
UseMvTargetPos f -> performAction cr w $ doMP2Ac f $ _mvToPoint $ _crIntention cr
src/Dodge/Creature/Boid.hs
+26 -22
View File
@@ -1,5 +1,6 @@
module Dodge.Creature.Boid where
import Data.Maybe
import Linear
import Dodge.Creature.Radius
import Control.Lens
@@ -176,9 +177,10 @@ swarmUsingCenter ::
World ->
Creature ->
Creature
swarmUsingCenter updT upd w cr = case _targetCr $ _crIntention cr of
Nothing -> upd cenp cr
Just tcr -> updT tcr cenp cr
swarmUsingCenter updT upd w cr = fromMaybe (upd cenp cr) $ do
i <- _targetCr $ _crIntention cr
tcr <- w ^? cWorld . lWorld . creatures . ix i
return $ updT tcr cenp cr
where
cid = _crID cr
cenp = _crGroupCenter $ _creatureGroups (_lWorld (_cWorld w)) IM.! _crGroupID (_crGroup $ _creatures (_lWorld (_cWorld w)) IM.! cid)
@@ -191,9 +193,10 @@ flockChaseTarget ::
World ->
Creature ->
Creature
flockChaseTarget updT upd w cr = case _targetCr $ _crIntention cr of
Nothing -> upd crs cr
Just tcr -> updT tcr crs cr
flockChaseTarget updT upd w cr = fromMaybe (upd crs cr) $ do
i <- _targetCr $ _crIntention cr
tcr <- w ^? cWorld . lWorld . creatures . ix i
return $ updT tcr crs cr
where
is = _swarm $ _crGroup cr
crs = IM.restrictKeys (w ^. cWorld . lWorld . creatures) is
@@ -213,18 +216,18 @@ flockPointTarget f targFunc w cr = case targFunc cr w of
crs = IM.restrictKeys (w ^. cWorld . lWorld . creatures) is
p = f crTarg crs cr
flockToPointUsing ::
(Creature -> Point2 -> Creature -> Point2) ->
(Point2 -> Creature -> Creature -> [Impulse]) ->
Creature ->
Reader World Creature
flockToPointUsing pf mvf cr = reader $ \w -> case _targetCr $ _crIntention cr of
Nothing -> cr
Just tcr -> cr & crActionPlan . apImpulse .~ mvf ptarg cr tcr
where
cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter
-- crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr)
ptarg = pf tcr cenp cr
--flockToPointUsing ::
-- (Creature -> Point2 -> Creature -> Point2) ->
-- (Point2 -> Creature -> Creature -> [Impulse]) ->
-- Creature ->
-- Reader World Creature
--flockToPointUsing pf mvf cr = reader $ \w -> case _targetCr $ _crIntention cr of
-- Nothing -> cr
-- Just tcr -> cr & crActionPlan . apImpulse .~ mvf ptarg cr tcr
-- where
-- cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter
-- -- crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr)
-- ptarg = pf tcr cenp cr
flockToPointUsing' ::
(Creature -> Point2 -> Creature -> Point2) ->
@@ -232,12 +235,13 @@ flockToPointUsing' ::
World ->
Creature ->
Creature
flockToPointUsing' pf mvf w cr = case _targetCr $ _crIntention cr of
Nothing -> cr
Just tcr -> cr & crActionPlan . apImpulse .~ mvf ptarg cr tcr
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
where
cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter
ptarg = pf tcr cenp cr
flockFunc ::
(Creature -> Point2 -> Creature -> Point2) ->
src/Dodge/Creature/Impulse.hs
+9 -6
View File
@@ -2,6 +2,7 @@
module Dodge.Creature.Impulse (impulsiveAIBefore) where
import Data.Maybe
import Linear
import NewInt
import Dodge.Creature.MoveType
@@ -64,12 +65,14 @@ followImpulse cr w imp = case imp of
ArbitraryImpulseFunction f -> crup $ doWdCrCr f w cr
ArbitraryImpulse f -> followImpulse cr w (doCrWdImp f cr w)
ArbitraryImpulseEffect f -> (doCrWdWd f cr, cr)
ImpulseUseTargetCID f -> case cr ^? crIntention . targetCr . _Just of
Just tcr -> followImpulse cr w (doIntImp f $ _crID tcr)
_ -> crup cr
ImpulseUseTarget f -> case cr ^? crIntention . targetCr . _Just of
Just tcr -> followImpulse cr w (doCrImp f tcr)
_ -> crup cr
ImpulseUseTargetCID f -> fromMaybe (crup cr) $ do
i <- cr ^? crIntention . targetCr . _Just
tcr <- w ^? cWorld . lWorld . creatures . ix i
return $ followImpulse cr w (doIntImp f $ _crID tcr)
ImpulseUseTarget f -> fromMaybe (crup cr) $ do
i <- cr ^? crIntention . targetCr . _Just
tcr <- w ^? cWorld . lWorld . creatures . ix i
return $ followImpulse cr w (doCrImp f tcr)
ImpulseUseAheadPos f -> followImpulse cr w (doP2Imp f (cr ^. crPos . _xy +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
MvForward -> crup $ crMvForward speed (w ^. cWorld . lWorld) cr
MvTurnToward p ->
src/Dodge/Creature/Perception.hs
+32 -29
View File
@@ -5,19 +5,19 @@ module Dodge.Creature.Perception (
visionCheck,
) where
import Control.Monad
import Dodge.Creature.Radius
import Linear
import Control.Lens
import Control.Monad
import qualified Data.Map.Strict as M
import Data.Maybe
import Dodge.Base.Collide
import Dodge.Creature.Radius
import Dodge.Creature.Vocalization
import Dodge.Data.World
import Dodge.FloatFunction
import Geometry.Data
import Geometry.Vector
import qualified IntMapHelp as IM
import Linear
import RandomHelp
import Sound.Data
@@ -48,17 +48,18 @@ basicAwarenessUpdate cr = case _cpAttention $ _crPerception cr of
& maybeBark
where
oldAwareness = _cpAwareness $ _crPerception cr
newAwareness
= (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
newAwareness =
(IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
oldAwareness
becomesCognizant
= any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness
becomesCognizant =
any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness
thejitter = [RandomImpulse $ RandImpulseCircMove 1]
maybeBark = fromMaybe id $ do
guard becomesCognizant
sid <- vocalizationTest cr
return $ crActionPlan . apAction
.~ [ ImpulsesList ( [Bark sid] : replicate 5 thejitter) ]
return $
crActionPlan . apAction
.~ [ImpulsesList ([Bark sid] : replicate 5 thejitter)]
-- TODO fold in randgen update, requires that this is a world to world function
chaseCritAwarenessUpdate :: World -> Creature -> Creature
@@ -73,26 +74,29 @@ chaseCritAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of
& maybeBark
where
oldAwareness = _cpAwareness $ _crPerception cr
newAwareness = (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
oldAwareness
becomesCognizant = any isCognizant
$ IM.unionWith cogRaised oldAwareness newAwareness
newAwareness =
(IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
oldAwareness
becomesCognizant =
any isCognizant $
IM.unionWith cogRaised oldAwareness newAwareness
thejitter = [RandomImpulse $ RandImpulseCircMove 3]
maybeBark
| becomesCognizant -- && randBool
&& cr ^? crVocalization . vcCoolDown == Just 0 =
let soundid = evalState (takeOne (crWarningSounds cr)) (_randGen w)
numjits = fst $ randomR (15, 25) (_randGen w)
in (crActionPlan . apStrategy .~ WarningCry)
. (crActionPlan . apAction .~
[ ImpulsesList
( [Bark soundid] :
replicate numjits thejitter
++ [[ChangeStrategy $ CloseToMelee 0]]
)
, AimAt 0 (w ^?! cWorld . lWorld . creatures . ix 0 . crPos . _xy)
])
| otherwise = id
maybeBark = fromMaybe id $ do
guard $ becomesCognizant
guard $ cr ^? crVocalization . vcCoolDown == Just 0
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
@@ -153,7 +157,6 @@ visionCheck cr tpos = doFloatFloat (_viFOV vi) ang * doFloatFloat (_viDist vi) d
dirvec = unitVectorAtAngle (_crDir cr)
ang = angleVV dirvec (tpos - (cpos - crRad (cr ^. crType) *^ dirvec))
d = dist tpos cpos
awakeLevelPerception :: Creature -> Float
awakeLevelPerception cr = case _cpVigilance $ _crPerception cr of
src/Dodge/Creature/ReaderUpdate.hs
+30 -27
View File
@@ -32,8 +32,10 @@ import LensHelp
import Linear
import RandomHelp
overrideMeleeCloseTarget :: Creature -> Creature
overrideMeleeCloseTarget cr = maybe cr (tryMeleeAttack cr) (_targetCr $ _crIntention cr)
overrideMeleeCloseTarget :: World -> Creature -> Creature
overrideMeleeCloseTarget w cr = maybe cr (tryMeleeAttack cr) $ do
i <- _targetCr $ _crIntention cr
w ^? cWorld . lWorld . creatures . ix i
tryMeleeAttack :: Creature -> Creature -> Creature
tryMeleeAttack cr tcr
@@ -58,7 +60,8 @@ setMvPos w cr = cr & crIntention . mvToPoint .~ mpos
where
int = _crIntention cr
mtpos = do
tpos <- (^. crPos . _xy) <$> _targetCr int
i <- int ^. targetCr
tpos <- w ^? cWorld . lWorld . creatures . ix i . crPos . _xy
guard $ hasLOSIndirect (cr ^. crPos . _xy) tpos w
return tpos
mpos = mtpos <|> _mvToPoint int
@@ -90,29 +93,29 @@ setTargetMv targFunc w cr =
-- ugly
flockACC :: World -> Creature -> Creature
flockACC w cr = case cr ^? crIntention . targetCr . _Just of
Nothing -> cr
Just tcr ->
let tpos = tcr ^. crPos . _xy
cpos = cr ^. crPos . _xy
isFarACC cr' =
_crGroup cr' == _crGroup cr
&& _crID cr' /= _crID cr
&& dist (cr' ^. crPos . _xy) tpos > dist cpos tpos
macr =
safeMinimumOn (dist cpos . (^. crPos . _xy))
. filter isFarACC
$ crsNearCirc cpos 50 w
in case macr of
Nothing -> cr
Just acr ->
let r = crRad (acr ^. crType) + crRad (cr ^. crType) + 10
horDir = normalizeV (vNormal (cpos -.- tpos))
horShift =
if isLHS tpos cpos (acr ^. crPos . _xy)
then r *.* horDir
else negate r *.* horDir
in cr & crIntention . mvToPoint ?~ tpos +.+ horShift
flockACC w cr = fromMaybe cr $ do
i <- cr ^. crIntention . targetCr
tcr <- w ^? cWorld . lWorld . creatures . ix i
let tpos = tcr ^. crPos . _xy
cpos = cr ^. crPos . _xy
isFarACC cr' =
_crGroup cr' == _crGroup cr
&& _crID cr' /= _crID cr
&& dist (cr' ^. crPos . _xy) tpos > dist cpos tpos
macr =
safeMinimumOn (dist cpos . (^. crPos . _xy))
. filter isFarACC
$ crsNearCirc cpos 50 w
return $ case macr of
Nothing -> cr
Just acr ->
let r = crRad (acr ^. crType) + crRad (cr ^. crType) + 10
horDir = normalizeV (vNormal (cpos -.- tpos))
horShift =
if isLHS tpos cpos (acr ^. crPos . _xy)
then r *.* horDir
else negate r *.* horDir
in cr & crIntention . mvToPoint ?~ tpos +.+ horShift
chaseCritMv :: World -> Creature -> Creature
chaseCritMv w cr = case _apStrategy (_crActionPlan cr) of
@@ -203,7 +206,7 @@ targetYouWhenCognizant w cr = case cr ^? crPerception . cpAwareness . ix 0 of
Just (Cognizant _) ->
(w ^?! cWorld . lWorld . creatures . ix 0)
`seq` cr
& crIntention . targetCr ?~ (w ^?! cWorld . lWorld . creatures . ix 0)
& crIntention . targetCr ?~ 0
& crPerception . cpVigilance .~ Vigilant
_ -> cr & crIntention . targetCr .~ Nothing
src/Dodge/Creature/SentinelAI.hs
+1 -2
View File
@@ -38,10 +38,9 @@ sentinelAI =
]
)
]
-- w
where
advanceShoot = DoImpulses [UseItem, MoveForward 3]
tcid cr = _crID <$> _targetCr (_crIntention cr)
tcid cr = _targetCr (_crIntention cr)
lostest = WdCrLOSTarget -- w' cr = maybe False (\cid -> canSee (_crID cr) cid w') (tcid cr)
--chainCreatureUpdates :: [World -> Creature -> Creature] -> World -> Creature -> Creature
src/Dodge/Creature/SetTarget.hs
+3 -7
View File
@@ -6,11 +6,7 @@ import Dodge.Data.World
--import MaybeHelp
-- | Assumes that you are id 0: if creature is cognizant of you, sets you as target
targetYouWhenCognizant ::
World ->
Creature ->
Creature
targetYouWhenCognizant w cr = case cr ^? crPerception . cpAwareness . ix 0 of
--Just (Cognizant _) -> cr & crIntention . targetCr ?~ _creatures (_cWorld w) IM.! 0
Just (Cognizant _) -> cr & crIntention . targetCr ?~ (w ^?! cWorld . lWorld . creatures . ix 0)
targetYouWhenCognizant :: World -> Creature -> Creature
targetYouWhenCognizant _ cr = case cr ^? crPerception . cpAwareness . ix 0 of
Just (Cognizant _) -> cr & crIntention . targetCr ?~ 0
_ -> cr & crIntention . targetCr .~ Nothing
src/Dodge/Creature/Test.hs
+9 -7
View File
@@ -66,14 +66,16 @@ crHasTarget :: Creature -> Bool
crHasTarget cr = isJust $ cr ^? crIntention . targetCr . _Just
crHasTargetLOS :: World -> Creature -> Bool
crHasTargetLOS w cr = case cr ^? crIntention . targetCr . _Just of
Just i -> crCanSeeCr i (w, cr)
Nothing -> False
crHasTargetLOS w cr = fromMaybe False $ do
i <- cr ^. crIntention . targetCr
tcr <- w ^? cWorld . lWorld . creatures . ix i
return $ crCanSeeCr tcr (w, cr)
crSafeDistFromTarg :: Float -> Creature -> Bool
crSafeDistFromTarg d cr = case cr ^? crIntention . targetCr . _Just of
Just tcr -> dist (cr ^. crPos . _xy) (tcr ^. crPos . _xy) > d
Nothing -> True
crSafeDistFromTarg :: World -> Float -> Creature -> Bool
crSafeDistFromTarg w d cr = fromMaybe True $ do
i <- cr ^? crIntention . targetCr . _Just
tcr <- w ^? cWorld . lWorld . creatures . ix i
return $ dist (cr ^. crPos . _xy) (tcr ^. crPos . _xy) > d
crStratConMatches :: Strategy -> Creature -> Bool
crStratConMatches strat cr = strat == _apStrategy (_crActionPlan cr)
src/Dodge/CreatureEffect.hs
+5 -9
View File
@@ -44,8 +44,8 @@ doWdCrBl wcb = case wcb of
maybe
False
(\cid -> canSee (_crID cr) cid w)
(_crID <$> _targetCr (_crIntention cr))
WdCrSafeDistFromTarget x -> \_ -> crSafeDistFromTarg x -- currently ignores walls etc
(_targetCr (_crIntention cr))
WdCrSafeDistFromTarget x -> \w -> crSafeDistFromTarg w x -- currently ignores walls etc
doCrBl :: CrBl -> Creature -> Bool
doCrBl cb = case cb of
@@ -55,18 +55,14 @@ doCrBl cb = case cb of
CrIsAiming -> crIsAiming
CrIsAnimate -> isAnimate
doMCrAc :: MCrAc -> Maybe Creature -> Action
doMCrAc mca = case mca of
MCrNoAction -> const ActionNothing
doCrAc :: CrAc -> Creature -> Action
doCrAc ca = case ca of
CrTurnAround -> \cr -> TurnToPoint
(cr ^. crPos . _xy -.- 10 *.* unitVectorAtAngle (_crDir cr))
CrFleeFromTarget -> fleeFromTarget
-- CrFleeFromTarget -> fleeFromTarget
fleeFromTarget :: Creature -> Action
fleeFromTarget cr = fleeFrom cr (_targetCr (_crIntention cr))
--fleeFromTarget :: Creature -> Action
--fleeFromTarget cr = fleeFrom cr (_targetCr (_crIntention cr))
doP2Ac :: P2Ac -> Point2 -> Action
doP2Ac p2a = case p2a of
src/Dodge/Data/ActionPlan.hs
-3
View File
@@ -149,9 +149,6 @@ data Action
}
| NoAction
| StartSentinelPost
| UseTarget
{ _useTarget :: MCrAc
}
| UseSelf
{ _useSelf :: CrAc
}
src/Dodge/Data/Creature.hs
+1 -1
View File
@@ -74,7 +74,7 @@ data CrHP
| CrIsPitted
data Intention = Intention
{ _targetCr :: Maybe Creature
{ _targetCr :: Maybe Int
, _mvToPoint :: Maybe Point2
, _viewPoint :: Maybe Point2
}
src/Dodge/Data/CreatureEffect.hs
+1 -5
View File
@@ -42,12 +42,9 @@ data CrBl
| CrIsAnimate
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data MCrAc = MCrNoAction
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data CrAc
= CrTurnAround
| CrFleeFromTarget
-- | CrFleeFromTarget
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data P2Ac = P2NoAction
@@ -70,7 +67,6 @@ deriveJSON defaultOptions ''CrImp
deriveJSON defaultOptions ''P2Imp
deriveJSON defaultOptions ''CrBl
deriveJSON defaultOptions ''WdCrBl
deriveJSON defaultOptions ''MCrAc
deriveJSON defaultOptions ''CrAc
deriveJSON defaultOptions ''P2Ac
deriveJSON defaultOptions ''MP2Ac
src/Dodge/Humanoid.hs
+1 -1
View File
@@ -17,7 +17,7 @@ updateHumanoid cr = case cr ^?! crType of
humanoidAIList
[ const doStrategyActions
, performActions
, const overrideMeleeCloseTarget
, overrideMeleeCloseTarget
, setViewPos
, setMvPos
, chaseCritMv