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