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

Fix worldEvent reset space leak

Browse Source
This commit is contained in:
jgk
2021-08-18 13:18:46 +02:00
parent a6f08aef16
commit 910c29a510
12 changed files with 34 additions and 33 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base.hs
+1
View File
@@ -494,4 +494,5 @@ evenOddSplit = foldr f ([],[])
f a (ls,rs) = (rs, a : ls)
dbArg :: (a -> a -> b) -> a -> b
{-# INLINE dbArg #-}
dbArg f x = f x x
src/Dodge/Creature/ArmourChase.hs
+2 -2
View File
@@ -33,14 +33,14 @@ armourChaseCrit = defaultCreature
targetYouWhenCognizantR >=>
flockACCR >=>
overrideMeleeCloseTargetR >=>
return . (crMeleeCooldown . _Just %~ max 0 . subtract 1)
return . (crMeleeCooldown %~ max 0 . subtract 1)
, _crHP = 300
, _crPict = basicCrPict green
, _crInv = IM.fromList
[(0,frontArmour)
,(1,medkit 200)
]
, _crMeleeCooldown = Just 0
, _crMeleeCooldown = 0
, _crGroup = ShieldGroup
}
src/Dodge/Creature/ChaseCrit.hs
+8 -8
View File
@@ -36,16 +36,16 @@ chaseCrit :: Creature
chaseCrit = defaultCreature
{ _crUpdate = stateUpdate $ --dummyUpdate
impulsiveAIR $
--doStrategyActionsR >=>
--performActionsR >=>
--overrideMeleeCloseTargetR >=>
--chaseTargetR targetYouLOS >=>
--basicPerceptionUpdateR [0] >=>
--targetYouWhenCognizantR >=>
return . (crMeleeCooldown . _Just %~ max 0 . subtract 1)
doStrategyActionsR >=>
performActionsR >=>
overrideMeleeCloseTargetR >=>
chaseTargetR targetYouLOS >=>
basicPerceptionUpdateR [0] >=>
targetYouWhenCognizantR >=>
return . (crMeleeCooldown %~ max 0 . subtract 1)
, _crHP = 300
, _crPict = basicCrPict green
, _crInv = IM.fromList [(0,medkit 200)]
, _crMeleeCooldown = Just 0
, _crMeleeCooldown = 0
, _crFaction = ColorFaction green
}
src/Dodge/Creature/ImpulseRat.hs
+3 -3
View File
@@ -32,7 +32,7 @@ meleeHeadingMove
meleeHeadingMove maxta minta tacutoff speed tp cr tcr
| dist tpos cpos < combinedRad + 5
&& abs (_crDir cr - argV (tpos -.- cpos)) < tacutoff
&& _crMeleeCooldown cr == Just 0
&& _crMeleeCooldown cr == 0
= [Melee (_crID tcr), Turn pi]
| dist tpos cpos < combinedRad + 5
&& abs (_crDir cr - argV (tpos -.- cpos)) < tacutoff
@@ -50,7 +50,7 @@ mvPointMeleeTarg :: Point2 -> Creature -> Creature -> [Impulse]
mvPointMeleeTarg p cr crT
| dist tpos cpos < combinedRad + 5
&& abs (_crDir cr - argV (tpos -.- cpos)) < pi/4
&& _crMeleeCooldown cr == Just 0
&& _crMeleeCooldown cr == 0
= [Melee (_crID crT)]
| dist tpos cpos < combinedRad + 5
&& abs (_crDir cr - argV (tpos -.- cpos)) < pi/4
@@ -89,7 +89,7 @@ impulseShootAtTarg :: Creature -> Creature -> [Impulse]
impulseShootAtTarg cr crT
| dist tpos cpos < combinedRad + 5
&& abs (_crDir cr - argV (tpos -.- cpos)) < pi/4
&& _crMeleeCooldown cr == Just 0
&& _crMeleeCooldown cr == 0
= [Melee (_crID crT)]
| dist tpos cpos < combinedRad + 5
&& abs (_crDir cr - argV (tpos -.- cpos)) < pi/4
src/Dodge/Creature/Picture.hs
+1 -3
View File
@@ -142,9 +142,7 @@ naked col cr
aimingOneHand = crIsAiming' cr && crIt ^? itAimStance == Just OneHand
aimingTwist = crIsAiming' cr && crIt ^? itAimStance == Just TwoHandTwist
crIt = _crInv cr IM.! _crInvSel cr
strikeMelee = case _crMeleeCooldown cr of
Nothing -> False
Just x -> x > 5
strikeMelee = _crMeleeCooldown cr > 5
pdam = sum $ concatMap (map _dmAmount) pastDams
crad = _crRad cr
pastDams = _crPastDamage $ _crState cr
src/Dodge/Creature/Rationality.hs
+4 -5
View File
@@ -29,7 +29,7 @@ impulsiveAIR
-> Creature
-> World
-> (Endo World , Maybe Creature)
impulsiveAIR impf cr w = followImpulses w . ($ w) . runReader $ impf cr
impulsiveAIR impf cr w = bimap Endo Just $ followImpulses w . ($ w) . runReader $ impf cr
--impulsiveAI
-- :: (World -> Creature -> Creature) -- ^ Internal AI update, should determine impulses
@@ -43,10 +43,9 @@ impulsiveAIR impf cr w = followImpulses w . ($ w) . runReader $ impf cr
followImpulses
:: World
-> Creature
-> (Endo World, Maybe Creature)
-> (World -> World, Creature)
followImpulses w cr
= (\(f''' ,cr') -> (Endo f''',Just cr'))
$ foldr
= foldr
(\imp (f , cr') -> let (f'', cr'') = followImpulse cr' w imp in (f'' . f , cr''))
(id, cr)
(_crImpulse $ _crActionPlan cr)
@@ -67,7 +66,7 @@ followImpulse cr w imp = case imp of
SwitchToItem i -> (id, cr & crInvSel .~ i)
Melee cid ->
(hitCr cid
, crMvBy (10 *.* normalizeV (posFromID cid -.- cpos)) $ cr & crMeleeCooldown ?~ 20) -- randomise cooldown?
, crMvBy (10 *.* normalizeV (posFromID cid -.- cpos)) $ cr & crMeleeCooldown .~ 20) -- randomise cooldown?
RandomTurn a -> (id, creatureTurn (rr a) cr)
MakeSound sid -> ( soundOnceOrigin sid (CrSound (_crID cr)) (_crPos cr) , cr )
DropItem -> undefined
src/Dodge/Creature/ReaderUpdate.hs
+1 -1
View File
@@ -19,7 +19,7 @@ overrideMeleeCloseTargetR cr = return $ maybe cr (tryMeleeAttack cr) (_crTarget
tryMeleeAttack :: Creature -> Creature -> Creature
tryMeleeAttack cr tcr
| _crMeleeCooldown cr == Just 0
| _crMeleeCooldown cr == 0
&& dist (_crPos tcr) cpos < _crRad cr + _crRad tcr + 5
&& abs (_crDir cr - argV (_crPos tcr -.- cpos)) < pi/4
-- = cr & crActionPlan . crStrategy .~ StrategyActions MeleeStrike meleeActions
src/Dodge/Creature/State.hs
+2 -2
View File
@@ -75,8 +75,8 @@ velocity to carry across frames.
crFriction :: Creature -> Point2 -> Point2
crFriction _ _ = V2 0 0
meleeCooldown :: CRUpdate -> CRUpdate
meleeCooldown u cr = u $ cr & crMeleeCooldown . _Just %~ (max 0 . (\x -> x - 1))
--meleeCooldown :: CRUpdate -> CRUpdate
--meleeCooldown u cr = u $ cr & crMeleeCooldown . _Just %~ (max 0 . (\x -> x - 1))
doDamage :: Creature -> Creature
doDamage cr = set (crState . crDamage) []
src/Dodge/Creature/SwarmCrit.hs
+2 -2
View File
@@ -32,7 +32,7 @@ swarmCrit :: Creature
swarmCrit = defaultCreature
{ _crUpdate = stateUpdate $ impulsiveAIR $
flockToPointUsing (encircleDistP 100) (meleeHeadingMove 0.1 0.1 (pi/4) 3.9)
>=> return . (crMeleeCooldown . _Just %~ max 0 . subtract 1)
>=> return . (crMeleeCooldown %~ max 0 . subtract 1)
>=> basicPerceptionUpdateR [0]
>=> doStrategyActionsR
>=> targetYouWhenCognizantR
@@ -45,7 +45,7 @@ swarmCrit = defaultCreature
, _crPict = basicCrPict yellow
, _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 2
, _crFaction = ColorFaction yellow
, _crMeleeCooldown = Just 0
, _crMeleeCooldown = 0
}
--swarmCritMoveFunc :: Creature -> Point2 -> Creature -> Point2
src/Dodge/Data.hs
+2 -2
View File
@@ -72,7 +72,7 @@ data World = World
, _mousePos :: !Point2
, _testString :: String
, _yourID :: !Int
, _worldEvents :: !(World -> World)
, _worldEvents :: (World -> World)
, _pressPlates :: IM.IntMap PressPlate
, _buttons :: IM.IntMap Button
, _soundQueue :: [(Int,Int16)]
@@ -174,7 +174,7 @@ data Creature = Creature
, _crApplyDamage :: [DamageType] -> Creature -> (World -> World,Creature)
, _crStance :: Stance
, _crActionPlan :: ActionPlan
, _crMeleeCooldown :: Maybe Int
, _crMeleeCooldown :: !Int
, _crAwakeLevel :: AwakeLevel
, _crAttentionDir :: AttentionDir
, _crAwarenessLevel :: IM.IntMap AwarenessLevel
src/Dodge/Default.hs
+1 -1
View File
@@ -47,7 +47,7 @@ defaultCreature = Creature
,_strideLength = 40
}
, _crActionPlan = ActionPlan [] [] WatchAndWait [LiveLongAndProsper]
, _crMeleeCooldown = Nothing
, _crMeleeCooldown = 0
, _crAwakeLevel = Vigilant
, _crAttentionDir = AttentiveTo []
, _crAwarenessLevel = IM.empty
src/Dodge/Update.hs
+7 -4
View File
@@ -33,7 +33,7 @@ import Data.Monoid
--import System.Random
update :: World -> World
update = update' . pushSideEffects
update = functionalUpdate . pushSideEffects
pushSideEffects :: World -> World
pushSideEffects w = w
@@ -42,8 +42,8 @@ pushSideEffects w = w
{- |
The update step.
For most menus the only way to change the world is using event handling. -}
update' :: World -> World
update' w = case _menuLayers w of
functionalUpdate :: World -> World
functionalUpdate w = case _menuLayers w of
(TerminalMessage t xs:mls) -> w & menuLayers .~ (TerminalMessage (max (t-1) 0) xs:mls)
(WaitMessage s i: _)
| i < 1 -> w & dbArg _worldEvents
@@ -64,7 +64,7 @@ update' w = case _menuLayers w of
. simpleCrSprings
. zoneCreatures
. updateWalls
. set worldEvents id
. resetWorldEvents
. dbArg _worldEvents
. updateParticles
. updateProjectiles
@@ -88,6 +88,9 @@ update' w = case _menuLayers w of
where
(x,y) = cloudZoneOfPoint $ _clPos cl
resetWorldEvents :: World -> World
resetWorldEvents w = w {_worldEvents = id}
updateCreatureGroups :: World -> World
updateCreatureGroups w = w & creatureGroups %~
IM.mapMaybe (\cgp -> _crGroupUpdate cgp w cgp)