Fix space leak when assigning targeted creature
This commit is contained in:
@@ -69,7 +69,7 @@ spawnerCrit = defaultCreature
|
||||
miniGunCrit :: Creature
|
||||
miniGunCrit = defaultCreature
|
||||
{ _crPict = basicCrPict red
|
||||
, _crUpdate = stateUpdate' $ impulsiveAI' $
|
||||
, _crUpdate = stateUpdate' $ impulsiveAI $
|
||||
sentinelFireType (const shootTillEmpty)
|
||||
, _crActionPlan = ActionPlan
|
||||
{ _crImpulse = []
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
module Dodge.Creature.Impulse
|
||||
( impulsiveAIR
|
||||
-- , impulsiveAI
|
||||
, impulsiveAI
|
||||
, impulsiveAI'
|
||||
) where
|
||||
import Dodge.Data
|
||||
import Dodge.Creature.Vocalization
|
||||
@@ -15,6 +15,7 @@ import System.Random
|
||||
import Control.Lens
|
||||
import Control.Monad.Reader
|
||||
import Data.Bifunctor
|
||||
--import Data.Maybe
|
||||
|
||||
impulsiveAIR
|
||||
:: (Creature -> Reader World Creature)
|
||||
@@ -23,17 +24,17 @@ impulsiveAIR
|
||||
-> (World -> World , Maybe Creature)
|
||||
impulsiveAIR impf cr w = second Just $ followImpulses w . ($ w) . runReader $ impf cr
|
||||
|
||||
--impulsiveAI :: (World -> Creature -> Creature)
|
||||
-- -> Creature
|
||||
-- -> World
|
||||
-- -> (World -> World , Maybe Creature)
|
||||
--impulsiveAI impf cr w = second Just $ followImpulses w $ impf w cr
|
||||
|
||||
impulsiveAI :: (World -> Creature -> Creature)
|
||||
-> Creature
|
||||
-> World
|
||||
-> (World -> World , Maybe Creature)
|
||||
impulsiveAI impf cr w = second Just $ followImpulses w $ impf w cr
|
||||
|
||||
impulsiveAI' :: (World -> Creature -> Creature)
|
||||
-> Creature
|
||||
-> World
|
||||
-> (World -> World , Creature)
|
||||
impulsiveAI' impf cr w = followImpulses w $ impf w cr
|
||||
impulsiveAI impf cr w = followImpulses w $ impf w cr
|
||||
|
||||
followImpulses :: World -> Creature -> (World -> World, Creature)
|
||||
followImpulses w cr = foldr
|
||||
@@ -70,6 +71,10 @@ followImpulse cr w imp = case imp of
|
||||
ImpulseUseTarget f -> case cr ^? crIntention . targetCr . _Just of
|
||||
Just tcr -> followImpulse cr w (f tcr)
|
||||
_ -> (id,cr)
|
||||
-- ImpulseUseTarget f -> fromMaybe (id,cr) $ do
|
||||
-- cid <- cr ^? crIntention . targetCr . _Just
|
||||
-- tcr <- w ^? creatures . ix cid
|
||||
-- return $ followImpulse cr w (f tcr)
|
||||
ImpulseUseAheadPos f -> followImpulse cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
|
||||
MvForward -> (id, crMvForward speed cr)
|
||||
MvTurnToward p -> (id, creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr)
|
||||
@@ -86,4 +91,3 @@ followImpulse cr w imp = case imp of
|
||||
hitCr i = over (creatures . ix i . crState . crDamage) (addDam i)
|
||||
. soundStart (CrSound cid) cpos hitS Nothing
|
||||
addDam i dams = Blunt 100 cpos (posFromID i) (posFromID i) : dams
|
||||
|
||||
|
||||
@@ -8,7 +8,7 @@ import Dodge.Data
|
||||
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import Control.Lens
|
||||
--import Data.Maybe
|
||||
import Data.Maybe
|
||||
|
||||
useItem :: Int -> World -> World
|
||||
useItem cid w = itemEffect cr it w
|
||||
@@ -17,9 +17,10 @@ useItem cid w = itemEffect cr it w
|
||||
it = _crInv cr IM.! _crInvSel cr
|
||||
|
||||
tryUseItem :: Creature -> World -> World
|
||||
tryUseItem cr' w = case w ^? creatures . ix (_crID cr') of
|
||||
Just cr -> itemEffect cr (_crInv cr IM.! _crInvSel cr) w
|
||||
Nothing -> w
|
||||
tryUseItem cr' w = fromMaybe w $ do
|
||||
cr <- w ^? creatures . ix (_crID cr')
|
||||
it <- cr ^? crInv . ix (_crInvSel cr)
|
||||
return $ itemEffect cr it w
|
||||
|
||||
itemEffect :: Creature -> Item -> World -> World
|
||||
itemEffect cr it w = case it ^? itUse of
|
||||
|
||||
@@ -1,6 +1,7 @@
|
||||
--{-# LANGUAGE TupleSections #-}
|
||||
module Dodge.Creature.Perception
|
||||
( perceptionUpdate
|
||||
, perceptionUp
|
||||
, perceptionUpdate'
|
||||
, newSounds
|
||||
)
|
||||
@@ -36,6 +37,12 @@ perceptionUpdate'
|
||||
-> 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
|
||||
|
||||
|
||||
{- | Update a creatures awareness based upon the creatures' current direction
|
||||
of attention -}
|
||||
|
||||
@@ -201,5 +201,6 @@ targetYouWhenCognizantR cr = reader $ \w -> case cr ^? crPerception . crAwarenes
|
||||
|
||||
targetYouWhenCognizant :: World -> Creature -> Creature
|
||||
targetYouWhenCognizant w cr = case cr ^? crPerception . crAwarenessLevel . ix 0 of
|
||||
Just (Cognizant _) -> cr & crIntention . targetCr ?~ _creatures w IM.! 0
|
||||
-- so this caused a space leak: be careful with ?~
|
||||
Just (Cognizant _) -> _creatures w IM.! 0 `seq` cr & crIntention . targetCr ?~ _creatures w IM.! 0
|
||||
_ -> cr & crIntention . targetCr .~ Nothing
|
||||
|
||||
@@ -63,7 +63,8 @@ sentinelFireType f = chainCreatureUpdatesLR
|
||||
)
|
||||
, (crAwayFromPost, goToPostStrat)
|
||||
]
|
||||
, Left $ perceptionUpdate' [0]
|
||||
-- , Left $ perceptionUpdate' [0]
|
||||
, Left $ perceptionUp 0
|
||||
, Right doStrategyActions
|
||||
, Right reloadOverride
|
||||
, Left targetYouWhenCognizant
|
||||
|
||||
@@ -46,7 +46,8 @@ stateUpdate :: CRUpdate -> Creature -> World -> World
|
||||
stateUpdate f cr w = let (fw,mcr) = stateUpdateDamage doDamage f cr w
|
||||
in fw $ w & creatures . at (_crID cr) .~ mcr
|
||||
|
||||
stateUpdate' :: CRUpdate' -> Creature -> World -> World
|
||||
stateUpdate' :: (Creature -> World -> (World -> World, Creature))
|
||||
-> Creature -> World -> World
|
||||
stateUpdate' f cr w = let (fw,mcr) = stateUpdateDamage' doDamage f cr w
|
||||
in fw $ w & creatures . at (_crID cr) .~ mcr
|
||||
|
||||
@@ -73,7 +74,7 @@ stateUpdateDamage' :: (Creature -> Creature) -> CRUpdate' -> CRUpdate
|
||||
stateUpdateDamage' damageupdate u cr w = case u (updateMovement cr) w of
|
||||
(f, upcr) ->
|
||||
( invSideEff upcr . movementSideEff cr . deathEff . f
|
||||
, (stepReloading . damageupdate) <$> crOrCorpse upcr
|
||||
, stepReloading . damageupdate <$> crOrCorpse upcr
|
||||
)
|
||||
where
|
||||
crOrCorpse cr'
|
||||
|
||||
Reference in New Issue
Block a user