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

Cleanup creature update slightly, add show instance for impulses

Browse Source
This commit is contained in:
justin
2022-03-26 08:08:16 +00:00
parent ae7fbe29c2
commit 3698a738f3
17 changed files with 158 additions and 198 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Action.hs
+1 -1
View File
@@ -85,7 +85,7 @@ performTurnToA cr p
jit = _mvTurnJit $ _crMvType cr
{- | Performing an action means that a creature has some impulses for a frame, and
updates or deletes the action itself.
updates or deletes the action itself.
-- doAction -}
performAction :: Creature -> World -> Action -> OutAction
performAction cr w ac = case ac of
src/Dodge/Creature/ArmourChase.hs
+11 -11
View File
@@ -19,17 +19,17 @@ import Control.Lens
armourChaseCrit :: Creature
armourChaseCrit = defaultCreature
{ _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdatesLR
[ Left $ watchUpdateStrat []
, Right doStrategyActions
, Left performActions
, Left targetYouWhenCognizant
, Left $ setTargetMv (\_ -> _targetCr . _crIntention)
, Left flockACC
, Left $ perceptionUpdate' [0]
, Left goToTarget
, Right overrideMeleeCloseTarget
, Right (crMeleeCooldown %~ max 0 . subtract 1)
{ _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdates
[ watchUpdateStrat []
, const doStrategyActions
, performActions
, targetYouWhenCognizant
, setTargetMv (\_ -> _targetCr . _crIntention)
, flockACC
, perceptionUpdate [0]
, goToTarget
, const overrideMeleeCloseTarget
, const (crMeleeCooldown %~ max 0 . subtract 1)
]
, _crHP = 300
, _crPict = basicCrPict green
src/Dodge/Creature/ChainUpdates.hs
+4 -12
View File
@@ -2,18 +2,10 @@ module Dodge.Creature.ChainUpdates where
import Dodge.Data
import Data.Foldable
chainCreatureUpdatesLR'
:: [Either (World -> Creature -> Creature) (Creature -> Creature)]
-> World -> Creature -> Creature
chainCreatureUpdatesLR' ls w cr = foldr unf cr ls
where
unf (Left g) = g w
unf (Right g) = g
chainCreatureUpdatesLR
:: [Either (World -> Creature -> Creature) (Creature -> Creature)]
chainCreatureUpdates
:: [World -> Creature -> Creature]
-> World -> Creature -> Creature
chainCreatureUpdatesLR ls w cr = foldl' unf cr ls
chainCreatureUpdates ls w cr = foldl' unf cr ls
where
unf cr' (Left g) = g w cr'
unf cr' (Right g) = g cr'
unf cr' g = g w cr'
src/Dodge/Creature/ChaseCrit.hs
+10 -10
View File
@@ -33,16 +33,16 @@ smallChaseCrit = chaseCrit
}
chaseCrit :: Creature
chaseCrit = defaultCreature
{ _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdatesLR
[ Right doStrategyActions
, Left performActions
, Right overrideMeleeCloseTarget
, Right setViewPos
, Right setMvPos
, Left goToTarget
, Left $ perceptionUpdate' [0]
, Left targetYouWhenCognizant
, Right (crMeleeCooldown %~ max 0 . subtract 1)
{ _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdates
[ const doStrategyActions
, performActions
, const overrideMeleeCloseTarget
, const setViewPos
, const setMvPos
, goToTarget
, perceptionUpdate [0]
, targetYouWhenCognizant
, const (crMeleeCooldown %~ max 0 . subtract 1)
]
, _crHP = 150
, _crPict = basicCrPict green
src/Dodge/Creature/Impulse.hs
+3 -2
View File
@@ -17,7 +17,8 @@ import System.Random
import Data.Bifunctor
--import Data.Maybe
impulsiveAI :: (World -> Creature -> Creature)
impulsiveAI
:: (World -> Creature -> Creature) -- | internal creature update
-> Creature
-> World
-> (World -> World , Creature)
@@ -61,7 +62,7 @@ followImpulse cr w imp = case imp of
_ -> crup cr
ImpulseUseAheadPos f -> followImpulse cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
MvForward -> crup $ crMvForward speed cr
MvTurnToward p -> crup
MvTurnToward p -> crup
$ creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr
where
crup = (id,)
src/Dodge/Creature/LauncherCrit.hs
+8 -8
View File
@@ -24,17 +24,17 @@ import Control.Lens
launcherCrit :: Creature
launcherCrit = defaultCreature
{ _crPict = basicCrPict red
, _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdatesLR
[ Left performActions
, Left $ watchUpdateStrat
, _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdates
[ performActions
, watchUpdateStrat
[ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) [retreatFire])
, (const crAwayFromPost, const goToPostStrat)
]
, Left $ perceptionUpdate' [0]
, Right doStrategyActions
, Right reloadOverride
, Left targetYouWhenCognizant
, Right $ overrideInternal
, perceptionUpdate [0]
, const doStrategyActions
, const reloadOverride
, targetYouWhenCognizant
, const $ overrideInternal
(\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr)
(crActionPlan . crStrategy .~ WatchAndWait)
]
src/Dodge/Creature/LtAutoCrit.hs
+8 -8
View File
@@ -26,9 +26,9 @@ import Control.Lens
ltAutoCrit :: Creature
ltAutoCrit = defaultCreature
{ _crPict = basicCrPict red
, _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdatesLR
[ Left performActions
, Left $ watchUpdateStrat
, _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdates
[ performActions
, watchUpdateStrat
[ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0)
[DoActionIf (const $ not . crIsAiming) drawWeapon
,DoActionThen
@@ -38,11 +38,11 @@ ltAutoCrit = defaultCreature
)
, (const crAwayFromPost, const goToPostStrat)
]
, Left $ perceptionUpdate' [0]
, Right doStrategyActions
, Right reloadOverride
, Left targetYouWhenCognizant
, Right $ overrideInternal
, perceptionUpdate [0]
, const doStrategyActions
, const reloadOverride
, targetYouWhenCognizant
, const $ overrideInternal
(\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr)
(crActionPlan . crStrategy .~ WatchAndWait)
]
src/Dodge/Creature/Perception.hs
+9 -65
View File
@@ -1,11 +1,8 @@
--{-# LANGUAGE TupleSections #-}
module Dodge.Creature.Perception
( perceptionUpdate
, perceptionUp
, perceptionUpdate'
, newSounds
)
where
) where
import Dodge.Data
import Dodge.Creature.Vocalization
import Dodge.Base.Collide
@@ -18,39 +15,21 @@ import Sound.Data
import Data.Maybe
import Control.Lens
import Control.Monad.Reader
import qualified Data.IntMap.Strict as IM
import qualified Data.Map.Strict as M
{- | Ties together (currently) an awareness and attention update -}
perceptionUpdate
:: [Int] -- ^ List of creature ids that may direct attention and awareness
-> Creature
-> Reader World Creature
perceptionUpdate is cr = basicAttentionUpdate is cr
>>= basicAwarenessUpdate
>>= rememberSounds
perceptionUpdate'
:: [Int] -- ^ List of creature ids that may direct attention and awareness
-> World
-> Creature
-> Creature
perceptionUpdate' is w cr = rememberSounds' w $ basicAwarenessUpdate' $ basicAttentionUpdate' is w cr
--perceptionUpdate' is w cr = basicAwarenessUpdate' $ basicAttentionUpdate' is w cr
perceptionUp :: Int -> World -> Creature -> Creature
perceptionUp i w cr | canSee i (_crID cr) w = cr & crPerception . crAwarenessLevel . at i ?~ Cognizant 100
| otherwise = cr & crPerception . crAwarenessLevel . at i .~ Nothing
perceptionUpdate is w = rememberSounds w . basicAwarenessUpdate . basicAttentionUpdate is w
{- | Update a creatures awareness based upon the creatures' current direction
of attention -}
basicAwarenessUpdate'
:: Creature
-> Creature
basicAwarenessUpdate' cr = case _crAttentionDir $ _crPerception cr of
AttentiveTo is -> cr
basicAwarenessUpdate :: Creature -> Creature
basicAwarenessUpdate cr = case _crAttentionDir $ _crPerception cr of
AttentiveTo is -> cr
& crPerception . crAwarenessLevel
%~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
& maybeBark
@@ -64,25 +43,6 @@ basicAwarenessUpdate' cr = case _crAttentionDir $ _crPerception cr of
| otherwise = id
Fixated i -> cr & crPerception . crAwarenessLevel
%~ ( IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
{- | Update a creatures awareness based upon the creatures' current direction
of attention -}
basicAwarenessUpdate
:: Creature -> Reader World Creature
basicAwarenessUpdate cr = case _crAttentionDir $ _crPerception cr of
AttentiveTo is -> pure $ cr
& crPerception . crAwarenessLevel
%~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
& maybeBark
where
oldAwareness = _crAwarenessLevel $ _crPerception cr
newAwareness = (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) oldAwareness
becomesCognizant = any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness
maybeBark | becomesCognizant = case vocalizationTest cr of
Just sid -> crActionPlan . crImpulse .~ [Bark sid]
Nothing -> id
| otherwise = id
Fixated i -> pure $ cr & crPerception . crAwarenessLevel
%~ ( IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
cogRaised :: AwarenessLevel -> AwarenessLevel -> AwarenessLevel
cogRaised Suspicious{} Cognizant{} = Cognizant 100
@@ -111,22 +71,11 @@ decreaseAwareness (Cognizant x) = Just $ Cognizant $ x - 50
{- | Given a fixed group of creatures, direct attention to those of them that
- are in view. -}
basicAttentionUpdate
:: [Int] -- ^ Creatures that may attract this creature's attention
-> Creature
-> Reader World Creature
basicAttentionUpdate cids cr = do
w <- ask
pure $ cr & crPerception . crAttentionDir .~
AttentiveTo (IM.mapMaybe (newExtraAwareness cr w) $ IM.fromList $ zip cids cids)
{- | Given a fixed group of creatures, direct attention to those of them that
- are in view. -}
basicAttentionUpdate'
:: [Int] -- ^ Creatures that may attract this creature's attention
-> World
-> Creature
-> Creature
basicAttentionUpdate' cids w cr = cr & crPerception . crAttentionDir .~
basicAttentionUpdate cids w cr = cr & crPerception . crAttentionDir .~
AttentiveTo (IM.mapMaybe (newExtraAwareness cr w) $ IM.fromList $ zip cids cids)
newExtraAwareness
@@ -159,14 +108,9 @@ newSounds = mapMaybe f . M.elems . _playingSounds
JustStartedPlaying -> Just (_soundPos s, _soundVolume s)
_ -> Nothing
rememberSounds :: Creature -> Reader World Creature
rememberSounds cr = do
sList <- asks newSounds
return $ cr & crMemory . soundsToInvestigate .~ map fst (filter (soundIsClose cr) sList)
-- return $ cr & crMemory . soundsToInvestigate .~ [V2 0 0]
--
rememberSounds' :: World -> Creature -> Creature
rememberSounds' w cr = cr & crMemory . soundsToInvestigate .~ map fst (filter (soundIsClose cr) (newSounds w))
rememberSounds :: World -> Creature -> Creature
rememberSounds w cr = cr
& crMemory . soundsToInvestigate .~ map fst (filter (soundIsClose cr) (newSounds w))
soundIsClose :: Creature -> (Point2,Float) -> Bool
soundIsClose cr (pos,vol) = vol > (_auDist . _crAudition $ _crPerception cr) (dist pos (_crPos cr))
src/Dodge/Creature/PistolCrit.hs
+8 -8
View File
@@ -29,18 +29,18 @@ import Control.Monad.State
pistolCrit :: Creature
pistolCrit = defaultCreature
{ _crPict = basicCrPict red
, _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdatesLR
[Left performActions
,Left $ watchUpdateStrat
, _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdates
[ performActions
, watchUpdateStrat
[ (crHasTargetLOS, \w cr -> StrategyActions (ShootAt 0)
[DoActionIf (const $ not . crIsAiming) drawWeapon,chooseMovement cr w])
, (const crAwayFromPost, const goToPostStrat)
]
,Left $ perceptionUpdate' [0]
,Right doStrategyActions
,Right reloadOverride
,Left targetYouWhenCognizant
,Right $ overrideInternal
, perceptionUpdate [0]
, const doStrategyActions
, const reloadOverride
, targetYouWhenCognizant
, const $ overrideInternal
(\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr)
(crActionPlan . crStrategy .~ WatchAndWait)
]
src/Dodge/Creature/ReaderUpdate.hs
+20 -20
View File
@@ -34,7 +34,7 @@ tryMeleeAttack cr tcr
| _crMeleeCooldown cr == 0
&& dist (_crPos tcr) cpos < _crRad cr + _crRad tcr + 5
&& abs (_crDir cr - argV (_crPos tcr -.- cpos)) < pi/4
= cr & crActionPlan . crImpulse .~ [Melee $ _crID tcr]
= cr & crActionPlan . crImpulse .~ [Melee $ _crID tcr]
| otherwise = cr
where
cpos = _crPos cr
@@ -59,27 +59,27 @@ setTargetMv targFunc w cr = maybe
(\ctarg -> cr & crIntention . mvToPoint ?~ _crPos ctarg)
(targFunc w cr)
-- fugly
-- ugly
flockACC :: World -> Creature -> Creature
flockACC w cr = case cr ^? crIntention . targetCr . _Just of
Nothing -> cr
Just tcr ->
let tpos = _crPos tcr
cpos = _crPos cr
isFarACC cr' = _crGroup cr' == _crGroup cr
&& _crID cr' /= _crID cr
&& dist (_crPos cr') tpos > dist cpos tpos
nearACCs = IM.filter isFarACC $ creaturesNearPointI 5 cpos w
macr = safeMinimumOn (dist cpos . _crPos) nearACCs
in case macr of
Nothing -> cr
Just acr ->
let r = _crRad acr + _crRad cr + 10
horDir = normalizeV (vNormal (cpos -.- tpos))
horShift = if isLHS tpos cpos (_crPos acr)
then r *.* horDir
else negate r *.* horDir
in cr & crIntention . mvToPoint ?~ tpos +.+ horShift
Nothing -> cr
Just tcr ->
let tpos = _crPos tcr
cpos = _crPos cr
isFarACC cr' = _crGroup cr' == _crGroup cr
&& _crID cr' /= _crID cr
&& dist (_crPos cr') tpos > dist cpos tpos
nearACCs = IM.filter isFarACC $ creaturesNearPointI 5 cpos w
macr = safeMinimumOn (dist cpos . _crPos) nearACCs
in case macr of
Nothing -> cr
Just acr ->
let r = _crRad acr + _crRad cr + 10
horDir = normalizeV (vNormal (cpos -.- tpos))
horShift = if isLHS tpos cpos (_crPos acr)
then r *.* horDir
else negate r *.* horDir
in cr & crIntention . mvToPoint ?~ tpos +.+ horShift
goToTarget :: World -> Creature -> Creature
goToTarget w cr =
src/Dodge/Creature/SentinelAI.hs
+15 -15
View File
@@ -45,9 +45,9 @@ sentinelAI w = reloadOverride .
sentinelFireType :: (Int -> Action) -> World -> Creature -> Creature
sentinelFireType f = chainCreatureUpdatesLR
[ Left performActions
, Left $ watchUpdateStrat
sentinelFireType f = chainCreatureUpdates
[ performActions
, watchUpdateStrat
[ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0)
[ drawwp `DoActionThen` f 0 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
, aiming
@@ -55,12 +55,12 @@ sentinelFireType f = chainCreatureUpdatesLR
)
, (const crAwayFromPost, const goToPostStrat)
]
, Left $ perceptionUpdate' [0]
, perceptionUpdate [0]
-- , Left $ perceptionUp 0
, Right doStrategyActions
, Right reloadOverride
, Left targetYouWhenCognizant
, Right $ overrideInternal
, const doStrategyActions
, const reloadOverride
, targetYouWhenCognizant
, const $ overrideInternal
(\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr)
(crActionPlan . crStrategy .~ WatchAndWait)
]
@@ -76,14 +76,14 @@ sentinelExtraWatchUpdate
-> World
-> Creature
-> Creature
sentinelExtraWatchUpdate xs = chainCreatureUpdatesLR
[ Left performActions
, Left $ watchUpdateStrat
sentinelExtraWatchUpdate xs = chainCreatureUpdates
[ performActions
, watchUpdateStrat
( xs ++ [(const crAwayFromPost, const goToPostStrat)] )
, Left $ perceptionUpdate' [0]
, Right doStrategyActions
, Left targetYouWhenCognizant
, Right $ overrideInternal
, perceptionUpdate [0]
, const doStrategyActions
, targetYouWhenCognizant
, const $ overrideInternal
(\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr)
(crActionPlan . crStrategy .~ WatchAndWait)
]
src/Dodge/Creature/SpreadGunCrit.hs
+8 -8
View File
@@ -27,9 +27,9 @@ import Control.Lens
spreadGunCrit :: Creature
spreadGunCrit = defaultCreature
{ _crPict = basicCrPict red
, _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdatesLR
[Left performActions
,Left $ watchUpdateStrat
, _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdates
[performActions
,watchUpdateStrat
[ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0)
[DoActionIf (const $ not . crIsAiming) drawWeapon
,DoActionThen
@@ -39,11 +39,11 @@ spreadGunCrit = defaultCreature
)
, (const crAwayFromPost, const goToPostStrat)
]
,Left $ perceptionUpdate' [0]
,Right doStrategyActions
,Right reloadOverride
,Left targetYouWhenCognizant
,Right $ overrideInternal
,perceptionUpdate [0]
,const doStrategyActions
,const reloadOverride
,targetYouWhenCognizant
,const $ overrideInternal
(\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr)
(\ cr -> cr & crActionPlan . crStrategy .~ WatchAndWait)
]
src/Dodge/Creature/State.hs
+14 -15
View File
@@ -35,8 +35,8 @@ import Control.Monad.State
import System.Random
--import qualified Data.Set as S
--import qualified Data.Map as M
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV
--import qualified Data.Vector as V
--import qualified Data.Vector.Mutable as MV
-- | The movement is updated before the ai in order to correctly set the oldpos.
-- This should be made more sensible: should the movement side effects apply to
@@ -49,18 +49,17 @@ stateUpdate = stateUpdateDamage doDamage
stateUpdateDamage :: (Creature -> World -> World)
-> (Creature -> World -> (World -> World, Creature))
-- -> CRUpdate
-> Creature -> World -> World
stateUpdateDamage damageupdate u cr w = damageupdate cr $
mvcrhammerup . invSideEff upcr . movementSideEff cr . deathEff . f $ w
& creatures . at (_crID cr) .~ (stepReloading <$> crOrCorpse upcr)
invSideEff upcr . movementSideEff cr . deathEff . f $ w
& creatures . at (_crID cr) .~ (mvcrhammerup . stepReloading <$> crOrCorpse upcr)
where
(f,upcr) = u (updateMovement cr) w
mvcrhammerup = creatures . ix (_crID cr) . crHammerPosition %~ moveHammerUp
crOrCorpse cr'
mvcrhammerup = crHammerPosition %~ moveHammerUp
crOrCorpse cr'
| cr' ^. crHP > 0 = Just cr'
| otherwise = Nothing
deathEff
deathEff
| cr ^.crHP > 0 = id
| otherwise = stopSoundFrom (CrWeaponSound (_crID cr) 0)
. over decorations addCorpse
@@ -87,18 +86,18 @@ clearDamage cr = creatures . ix (_crID cr) . crState . crDamage .~ []
doDamage :: Creature -> World -> World
doDamage cr w = w
& creatures . ix (_crID cr) . crState . crDamage .~ []
& creatures . ix (_crID cr) . crState . crPastDamage %~ advancePastDamages dams
-- & creatures . ix (_crID cr) . crState . crPastDamage %~ advancePastDamages dams
& _crApplyDamage cr dams cr
where
dams = _crDamage $ _crState cr
advancePastDamages :: [Damage] -> V.Vector [Damage] -> V.Vector [Damage]
advancePastDamages newDs v = f $ V.backpermute v bpVector
where
f = V.modify $ \v' -> MV.write v' 0 newDs
--advancePastDamages :: [Damage] -> V.Vector [Damage] -> V.Vector [Damage]
--advancePastDamages newDs v = f $ V.backpermute v bpVector
-- where
-- f = V.modify $ \v' -> MV.write v' 0 newDs
bpVector :: V.Vector Int
bpVector = V.fromList $ 0 : [0 .. 18]
--bpVector :: V.Vector Int
--bpVector = V.fromList $ 0 : [0 .. 18]
movementSideEff :: Creature -> World -> World
movementSideEff cr w
src/Dodge/Creature/SwarmCrit.hs
+6 -6
View File
@@ -18,12 +18,12 @@ import Control.Lens
swarmCrit :: Creature
swarmCrit = defaultCreature
{ _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdatesLR
[ Left $ flockToPointUsing' (encircleDistP 100) (meleeHeadingMove 0.1 0.1 (pi/4) 3.9)
, Right (crMeleeCooldown %~ max 0 . subtract 1)
, Left $ perceptionUpdate' [0]
, Right doStrategyActions
, Left targetYouWhenCognizant
{ _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdates
[ flockToPointUsing' (encircleDistP 100) (meleeHeadingMove 0.1 0.1 (pi/4) 3.9)
, const (crMeleeCooldown %~ max 0 . subtract 1)
, perceptionUpdate [0]
, const doStrategyActions
, targetYouWhenCognizant
]
-- , doStrategyActions
-- , targetYouWhenCognizant