Cleanup, trying to diagnose space leak in crit update

src/Dodge/Creature/Inanimate.hs

@@ -3,13 +3,12 @@
 Inanimate objects such as lamps, barrels, etc
 -}
 module Dodge.Creature.Inanimate
-    ( lamp
-    , colorLamp
-    , barrel
+    ( barrel
     , explosiveBarrel
+    , module Dodge.Creature.Lamp
     ) where
 import Dodge.Data
-import Dodge.RemoveCreatureEndo
+import Dodge.Creature.Lamp
 import Dodge.WorldEvent.Explosion
 import Dodge.Creature.Picture
 --import Dodge.Creature.Stance.Data
@@ -17,100 +16,21 @@ import Dodge.Picture.Layer
 import Dodge.Particle.Spark
 import Dodge.Default
 import Dodge.Creature.State
-import Dodge.LightSource
-import Dodge.WorldEvent.Flash
-import Dodge.WorldEvent.Sound
-import Dodge.Creature.Update
 import Picture
 import qualified IntMapHelp as IM
 import Geometry
 --import Geometry.Data
 --import Geometry.Vector3D
-import Polyhedra
 import Shape
 import Dodge.SoundLogic
 
 import System.Random
 import Data.List
 import Control.Lens
-import Data.Monoid
-
-defaultInanimate :: Creature
-defaultInanimate = defaultCreature & crActionPlan .~ Inanimate
-
-colorLamp 
-    :: Point3   -- color of lamp
-    -> Float    -- height of lamp
-    -> Creature
-colorLamp col h = defaultInanimate
-    { _crUpdate = toCrUpdate $ initialiseColorLamp col h
-    , _crHP = 100
-    , _crPict = picAtCrPosNoRot (lampCrPic h)
-    , _crRad = 3
-    , _crMass = 3
-    }
-
-lamp :: Float -> Creature
-lamp h = defaultInanimate
-    { _crUpdate = toCrUpdate $ initialiseLamp h
-    , _crHP = 100
-    , _crPict = picAtCrPosNoRot (lampCrPic h)
-    , _crRad = 3
-    , _crMass = 3
-    }
--- it is not clear that any of the attempts with Foldl help at all here
-lampCrPic :: Float -> Picture
-lampCrPic h = pictures 
-    [ setLayer 1 (setDepth h . color white $ circleSolid 3)
-    , concatMap (polyToTris . map f) $ boxXYZnobase 5 5 (h-1)
-    ]
-  where
-    f pos = Verx (pos -.-.- V3 2.5 2.5 0) blue [] 0 polyNum
-
---lTriFold :: a -> a -> L.Fold a [a]
---lTriFold s x = L.Fold (f s) (x,[]) snd
---  where
---    f s' (x1,l) x2 = (x2,s':x1:x2:l)
---
---preTriFold :: (a -> b) -> [a] -> [b]
---preTriFold f (s:x:xs) = L.fold (L.premap f $ lTriFold (f s) (f x)) xs
---preTriFold _ _ = []
---
---polyToTriFold :: [a] -> [a]
---polyToTriFold (s:x:xs) = L.fold (lTriFold s x) xs
---polyToTriFold _ = []
-
-initialiseLamp :: Float -> CRUpdate
-initialiseLamp = initialiseColorLamp 0.75
-
-initialiseColorLamp :: Point3 -> Float -> CRUpdate
-initialiseColorLamp col h cr _ = ( Endo addLS , Just $ cr & crUpdate .~ toCrUpdate (updateLamp h i))
-  where
-    i = _crID cr
-    addLS w = w
-        & lightSources %~ IM.insert lsid (lsColPosID col (V3 x y h) lsid)
-        & creatures . ix i . crUpdate .~ toCrUpdate (updateLamp h lsid)
-      where
-        lsid = IM.newKey $ _lightSources w
-    (V2 x y) = _crPos cr
-
-updateLamp :: Float -> Int -> CRUpdate
-updateLamp h i = unrandUpdate handleLS internalUpdate
-  where
-    handleLS cr w 
-        | _crHP cr < 0 = explosionFlashAt cPos 
-                        $ mkSoundBreakGlass cPos w & lightSources %~ IM.delete i
-        | otherwise    = w & lightSources . ix i . lsParam . lsPos .~ f cPos
-      where
-        cPos = _crPos cr
-        f (V2 x y) = V3 x y h
-    internalUpdate cr 
-        | _crHP cr < 0 = Nothing
-        | otherwise    = Just $ doDamage cr
 
 barrel :: Creature
 barrel = defaultInanimate
-    { _crUpdate = toCrUpdate updateBarrel
+    { _crUpdate = updateBarrel
     , _crHP = 500
     , _crPict = picAtCrPos $ onLayer CrLayer $ pictures 
         [ color orange $ circleSolid 10
@@ -125,7 +45,7 @@ barrel = defaultInanimate
 
 explosiveBarrel :: Creature
 explosiveBarrel = defaultInanimate
-    { _crUpdate = toCrUpdate updateExpBarrel
+    { _crUpdate = updateExpBarrel
     , _crHP = 400
     , _crPict = shapeAtCrPos
         . colorSH orange
@@ -137,24 +57,16 @@ explosiveBarrel = defaultInanimate
     , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
     ,_crApplyDamage = \_ c -> (id, c)
     }
-updateBarrel 
-    :: Creature 
-    -> World
-    -> (Endo World, Maybe Creature)
-updateBarrel cr _
-    | _crHP cr > 0 = (Endo id, newCr)
-    | otherwise    = (Endo id, Nothing)
-  where 
-    newCr = Just $ doDamage cr
+updateBarrel :: Creature -> World -> World
+updateBarrel cr
+    | _crHP cr > 0 = creatures . ix (_crID cr) %~ doDamage
+    | otherwise    = creatures . at (_crID cr) .~ Nothing
 
 -- should generate the sparks externally using new random generators
-updateExpBarrel 
-    :: Creature 
-    -> World
-    -> (Endo World, Maybe Creature)
+updateExpBarrel :: Creature -> World -> World
 updateExpBarrel cr w 
-    | _crHP cr > 0 = (Endo $ foldr (.) id pierceSparks . hiss, newCr)
-    | otherwise    = (Endo $ makeExplosionAt (_crPos cr) . stopSounds , Nothing)
+    | _crHP cr > 0 = foldr (.) id pierceSparks $ hiss w & creatures . at (_crID cr) .~ newCr
+    | otherwise    = makeExplosionAt (_crPos cr) $ stopSounds w & creatures . at (_crID cr) .~ Nothing
   where 
     g = _randGen w
     damages = _crDamage $ _crState cr
@@ -166,12 +78,7 @@ updateExpBarrel cr w
     colids = randomRs (0,11) g
     times = randomRs (2,5) g
     poss = _piercedPoints $ _crSpState $ _crState cr
-    --newCr = Just $ doDamage $ applyFuseDamage cr -- $ foldr perforate cr damages
     newCr = Just $ applyFuseDamage $ set (crState . crDamage) [] $ damToExpBarrel damages cr
-    --perforate :: DamageType -> Creature -> Creature
-    --perforate (Piercing amount sp int ep) cr = over (crState . crSpState . piercedPoints)
-    --                                                  ((:) $ int -.- _crPos cr) cr
-    --perforate _ cr = cr
     applyFuseDamage cr' = cr' & crHP %~ 
         subtract (length . _piercedPoints . _crSpState $ _crState cr')
     hiss | null poss = id