Cleanup and reorganise

src/Dodge/Creature/Inanimate.hs

@@ -3,8 +3,14 @@
 Inanimate objects such as lamps, barrels, etc
 -}
 module Dodge.Creature.Inanimate
-  where
+    ( lamp
+    , colorLamp
+    , barrel
+    , explosiveBarrel
+    ) where
 import Dodge.Data
+import Dodge.Data.DamageType
+import Dodge.WorldEvent.Explosion
 import Dodge.Creature.Picture
 --import Dodge.Creature.Stance.Data
 import Dodge.Creature.State.Data
@@ -22,10 +28,14 @@ import Geometry
 import Geometry.Vector3D
 import Polyhedra
 import Shape
+import Dodge.WorldEvent
+import Dodge.SoundLogic
+import Dodge.Data.SoundOrigin
+import Dodge.SoundLogic.LoadSound
 
+import System.Random
+import Data.List
 import Control.Lens
-import qualified Control.Foldl as L
---import qualified Data.Vector.Fusion.Stream.Monadic as VS
 import Data.Monoid
 
 defaultInanimate :: Creature
@@ -60,18 +70,18 @@ lampCrPic h = pictures
   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 _ = []
+--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
@@ -130,3 +140,59 @@ 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
+
+-- should generate the sparks externally using new random generators
+updateExpBarrel 
+    :: Creature 
+    -> World
+    -> (Endo World, Maybe Creature)
+updateExpBarrel cr w 
+    | _crHP cr > 0 = (Endo $ foldr (.) id pierceSparks . hiss, newCr)
+    | otherwise    = (Endo $ makeExplosionAt (_crPos cr) . stopSounds , Nothing)
+  where 
+    g = _randGen w
+    damages = _crDamage $ _crState cr
+    pierceSparks :: [World -> World]
+    pierceSparks 
+      = zipWith4 (\p a -> createBarrelSpark (_crPos cr +.+ p) (a + argV p) (Just $ _crID cr))
+                            poss as times colids
+    as =  randomRs (-0.7,0.7) g
+    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
+         | otherwise  = soundMultiFrom [BarrelHiss 0,BarrelHiss 1] (_crPos cr) foamSprayLoopS (Just 1)
+    stopSounds = stopSoundFrom (BarrelHiss 0) . stopSoundFrom (BarrelHiss 1)
+
+damToExpBarrel :: [DamageType] -> Creature -> Creature
+damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam
+  where 
+    (pierceDam,otherDam) = partition isPierce ds
+    isPierce Piercing{} = True
+    isPierce _             = False
+
+damToExpBarrel' :: DamageType -> Creature -> Creature
+damToExpBarrel' (Piercing amount _ int _) cr 
+    = over (crState . crSpState . piercedPoints) ((:) $ int -.- _crPos cr) 
+        $ over crHP (\hp -> hp - div amount 200) cr
+damToExpBarrel' PoisonDam {} cr = cr
+damToExpBarrel' SparkDam {}  cr = cr
+damToExpBarrel' PushDam{_dmPushBack = v} cr = cr Control.Lens.& crPos %~ (+.+) (1 / _crMass cr *.* v)
+damToExpBarrel' dt             cr = cr Control.Lens.& crHP -~ _dmAmount dt