Fix worldEvent reset space leak

src/Dodge/Base.hs

@@ -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

@@ -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

@@ -36,16 +36,16 @@ chaseCrit :: Creature
 chaseCrit = defaultCreature
     { _crUpdate = stateUpdate $ --dummyUpdate
         impulsiveAIR $ 
-        --doStrategyActionsR >=>
+        doStrategyActionsR >=>
-        --performActionsR >=>
+        performActionsR >=>
-        --overrideMeleeCloseTargetR >=>
+        overrideMeleeCloseTargetR >=>
-        --chaseTargetR targetYouLOS >=>
+        chaseTargetR targetYouLOS >=>
-        --basicPerceptionUpdateR [0] >=>
+        basicPerceptionUpdateR [0] >=>
-        --targetYouWhenCognizantR >=>
+        targetYouWhenCognizantR >=>
-        return . (crMeleeCooldown . _Just %~ max 0 . subtract 1)
+        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

@@ -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

@@ -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
+    strikeMelee = _crMeleeCooldown cr > 5
-        Nothing -> False
-        Just x  -> x > 5
     pdam = sum $ concatMap (map _dmAmount) pastDams
     crad = _crRad cr
     pastDams = _crPastDamage $ _crState cr

src/Dodge/Creature/Rationality.hs

@@ -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

@@ -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

@@ -75,8 +75,8 @@ velocity to carry across frames.
 crFriction :: Creature -> Point2 -> Point2
 crFriction _ _ = V2 0 0
 
-meleeCooldown :: CRUpdate -> CRUpdate
+--meleeCooldown :: CRUpdate -> CRUpdate
-meleeCooldown u cr = u $ cr & crMeleeCooldown . _Just %~ (max 0 . (\x -> x - 1))
+--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

@@ -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

@@ -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

@@ -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

@@ -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
+functionalUpdate :: World -> World
-update' w = case _menuLayers w of
+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)