Improve low level flamer

src/Dodge/WorldEvent/Explosion.hs

@@ -20,13 +20,12 @@ import Dodge.WorldEvent.Shockwave
 import Geometry
 --import Geometry.Vector3D
 import Picture
+import LensHelp
 
 import Control.Monad.State
 import Data.List
 --import Data.Maybe
 import System.Random
---import qualified Data.IntMap.Strict as IM
-import Control.Lens
 
 makePoisonExplosionAt 
     :: Point2   -- ^ Position
@@ -71,24 +70,28 @@ makeFlameExplosionAt p w
     -- particle passes through for the first frame of its existence
 
 makeExplosionAt :: Point2 -> World -> World
-makeExplosionAt p w 
-    = soundMultiFrom [Explosion 0,Explosion 1] p bangS Nothing
-    . addFlames 
-    -- . explosionFlashAt p
-    . over tempLightSources (theTLS :)
-    $ makeShockwaveAt [] p 50 50 1 white w
+makeExplosionAt p w = w
+    & soundMultiFrom [Explosion 0,Explosion 1] p bangS Nothing
+    & addFlames 
+    & tempLightSources .:~ theTLS
+    & makeShockwaveAt [] p 50 50 1 white
   where 
     theTLS = tlsTimeRadColPos 20 150 (V3 1 0.5 0) (addZ 20 p) 
-    fVs  = replicateM 15 (randInCirc 1)  & evalState $ _randGen w
-    fPs'' = replicateM 15 (fmap (15 *.*.*) randInHemisphere) & evalState $ _randGen w
+    fVs  = replicateM 100 (randInCirc 1)  & evalState $ _randGen w
+    --fPs'' = replicateM 100 (fmap (15 *.*.*) randInHemisphere) & evalState $ _randGen w
+    fPs'' = replicateM 100 (fmap (15 *.*.*) randInHemisphere) & evalState $ _randGen w
     (fPs',zs) = let (a,b,c) = unzip3 $ map fromV3 fPs''
                 in (zipWith V2 a b, c)
-    fPs  = map (pushAgainstWalls . (+.+) p . (*.*) 0.5) fPs'
+    --fPs  = map (pushAgainstWalls . (+.+) p . (*.*) 0.5) fPs'
+    fPs  = map (pushAgainstWalls . (+.+) p) fPs'
     inversePushOut v = (15 - magV v) * 0.01 *.* v
     fVs' = zipWith (+.+) fVs $ map inversePushOut fPs'
     sizes = randomRs (2,9) $ _randGen w
-    times = randomRs (20,25) $ _randGen w
+    --times = randomRs (20,25) $ _randGen w
+    times = randomRs (15,20) $ _randGen w
     mF q z v size time = makeFlamelet q z v Nothing size time
     newFs = zipWith5 mF fPs zs (fmap (3 *.*) fVs') sizes times
     addFlames w' = foldr ($) w' newFs
-    pushAgainstWalls q = maybe q (uncurry (+.+)) $ reflectPointWalls p q $ wallsNearPoint q w
+    --pushAgainstWalls q = maybe q (uncurry (+.+)) $ reflectPointWalls p q wls
+    pushAgainstWalls q = maybe q fst $ reflectPointWalls p q wls
+    wls = wallsNearPoint p w

src/Dodge/WorldEvent/Flash.hs

@@ -63,8 +63,6 @@ explosionFlashAt p = tempLightSources .:~ tlsTimeRadFunPos 20 150 intensityFunc
 
 flameFlicker :: Particle -> World -> World
 flameFlicker pt 
-    | _ptTimer pt `mod` 5 == 0 = tempLightSources 
-        .:~ tlsTimeRadColPos 1 70 (V3 0.5 0 0) (V3 x y 10)
+    | _ptTimer pt `mod` 7 == 0 = tempLightSources 
+        .:~ tlsTimeRadColPos 1 70 (V3 0.5 0 0) (addZ 10 $ _ptPos pt)
     | otherwise = id
-  where
-    V2 x y = _ptPos pt

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -80,7 +80,7 @@ moveFlame rotd w pt
     | time <= 0 = (makeFlamerSmokeAt (addZ 20 ep) w, Nothing)
     | otherwise = case thingsHitExceptCr (_ptCrIgnore pt) sp ep w of
         ((_,Left _):_)      -> (doSound $ damwls damcrs             , mvPt 0.7)
-        (th@(p,Right wl):_) -> (doSound . fst $ hiteff [th] damcrs  , rfl wl p)
+        ((p,Right wl):_) -> (doSound $ damwls damcrs  , rfl wl p)
         _                   -> (flameFlicker pt . damwls $ doSound damcrs    , mvPt 0.98)
   where 
     time = _ptTimer pt