Add dust on bullet wall hit

src/Dodge/Data.hs

@@ -181,7 +181,7 @@ data TempLightSource = TLS
     { _tlsPos :: !Point3
     , _tlsRad :: !Float
     , _tlsIntensity :: !Point3
-    , _tlsUpdate :: World -> TempLightSource -> (World, Maybe TempLightSource)
+    , _tlsUpdate :: World -> TempLightSource -> Maybe TempLightSource
     , _tlsTime :: !Int
     }
 data Creature = Creature

src/Dodge/Default.hs

@@ -247,7 +247,7 @@ defaultTLS = TLS
     , _tlsTime = 1
     }
   where
-    f w t 
+    f _ t 
         | _tlsTime t <= 0 
-                    = (w, Nothing)
+                    = Nothing
-        | otherwise = (w, Just $ t & tlsTime -~ 1)
+        | otherwise = Just $ t & tlsTime -~ 1

src/Dodge/Default/World.hs

@@ -98,7 +98,7 @@ youLight =
         ,_tlsRad = 300
         ,_tlsIntensity = 0.1
         --,_tlsUpdate = \w _ -> (w, Nothing)
-        ,_tlsUpdate = \w _ -> (w, Just (youLight {_tlsPos = f $ _crPos (you w)}))
+        ,_tlsUpdate = \w _ -> Just (youLight {_tlsPos = f $ _crPos (you w)})
         ,_tlsTime = 0
         }
   where

src/Dodge/Item/Weapon.hs

@@ -328,7 +328,7 @@ ltAutoGun = defaultAutoGun
         , withRandomDirI 0.1
         , torqueAfterI 0.2
         , withSidePushI 50
-        , withMuzFlareI
+        , modClock 2 withMuzFlareI
         ]
     , _wpSpread = 0.5
     , _wpRange = 20
@@ -388,6 +388,7 @@ miniGun = defaultAutoGun
         , withRandomOffsetI 9
         , withMuzFlareI
         , withOldDir od3
+        , withSmoke 1 black 20 200 5
         ]
     , _wpRange = 20
     , _itFloorPict = onLayer FlItLayer miniGunPict
@@ -948,7 +949,7 @@ moveRemoteShell cid itid pj w
     hitWl    = fst <$> collideCircWalls oldPos newPos 2 (wallsNearPoint newPos w)
     thingHit = hitCr <|> hitWl
     r1 = _randGen w & evalState (randInCirc 10)
-    smokeGen = makeSmokeCloudAt $ addZ 20 $ oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)
+    smokeGen = shellTrailCloud $ addZ 20 $ oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)
     doExplosion = explodeRemoteRocket itid i
 
 explodeRemoteRocket 

src/Dodge/Item/Weapon/AutoGun.hs

@@ -44,6 +44,7 @@ autoGun = defaultAutoGun
         , useAmmo 1
         , withRandomDirI (autogunSpread/2)
         , withMuzFlareI
+        , withSmoke 1 black 20 200 5
         ]
     , _wpSpread = autogunSpread
     , _wpRange = 20

src/Dodge/Item/Weapon/Launcher.hs

@@ -119,7 +119,7 @@ doThrust pj w = w
     (frict,g)  = randomR (0.6,0.9) $ _randGen w
     (sparkD,_) = randomR (-0.2,0.2) $ _randGen w
     r1 = randInCirc 10 & evalState $ _randGen w
-    smokeGen = makeSmokeCloudAt $ addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos))
+    smokeGen = shellTrailCloud $ addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos))
 
 flameLauncher :: Item
 flameLauncher = launcher & wpAmmo . amPayload .~ makeFlameExplosionAt

src/Dodge/Item/Weapon/TriggerType.hs

@@ -15,6 +15,7 @@ module Dodge.Item.Weapon.TriggerType
     , withSoundStart
     , withSoundContinue
     , withSoundForI
+    , withSmoke
     , withThickSmokeI
     , withThinSmokeI
     , withRandomOffsetI
@@ -33,14 +34,15 @@ module Dodge.Item.Weapon.TriggerType
     , useTimeCheckI
     , ammoCheckI
     , randSpreadDir
+    , modClock
     )
     where
 import Dodge.Data
 import Dodge.Data.SoundOrigin
 import Dodge.SoundLogic
 import Dodge.Creature.Action (startReloadingWeapon)
-import Dodge.WorldEvent (tempLightForAt)
+import Dodge.WorldEvent
-import Dodge.WorldEvent.Cloud
+--import Dodge.WorldEvent.Cloud
 import Dodge.RandomHelp
 import Dodge.Item.Attachment.Data
 import Dodge.Item.Data
@@ -69,6 +71,15 @@ trigDoAlso
     -> ChainEffect
 trigDoAlso afterEff eff item cr = afterEff item cr . eff item cr
 
+withSmoke :: Int -> Point4 -> Float -> Int -> Float -> ChainEffect
+withSmoke num col rad t alt eff item cr w 
+    = eff item cr 
+    $ foldl' (flip $ smokeCloudAt col rad t alt . (+.+.+ pos) . (*8)) w ps
+  where
+    dir = _crDir cr
+    pos = addZ 0 $ _crPos cr +.+ (_crRad cr + 15) *.* unitVectorAtAngle dir
+    ps = replicateM num randOnUnitSphere & evalState $ _randGen w
+
 withThinSmokeI :: ChainEffect
 withThinSmokeI eff item cr w = eff item cr $ foldl' (flip $ makeThinSmokeAt . (+.+.+ pos) . (* 8)) w ps
   where
@@ -295,8 +306,14 @@ withTempLight time rad col eff item cr = eff item cr
         }
     V2 x y = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
 
+modClock :: Int -> ChainEffect -> ChainEffect
+modClock n chainEff eff it cr w
+    | _frameClock w `mod` n == 0 = (chainEff eff) it cr w
+    | otherwise = eff it cr w
+
 withMuzFlareI :: ChainEffect
-withMuzFlareI f it cr w = tempLightForAt 3 pos2 -- . muzzleFlashAt pos2 
+withMuzFlareI f it cr w = 
+    makeTLight 3 100 (V3 1 1 0.5) pos2 -- . muzzleFlashAt pos2 
     $ f it cr w
   where 
     --pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)

src/Dodge/LightSources.hs

@@ -1,12 +1,15 @@
-module Dodge.LightSources where
+module Dodge.LightSources 
+    ( tLightTimedIntensity
+    , tLight
+    , lightAt
+    , colorLightAt
+    )
+    where
 import Dodge.Data
---import Dodge.Base
---import Dodge.Picture.Layer
---import Dodge.LevelGen.Data
---import Geometry
---import Picture
 import Geometry.Data
 
+import Control.Lens
+
 colorLightAt :: Point3 -> Point3 -> Int -> LightSource
 colorLightAt col pos i = 
     LS {_lsID = i
@@ -19,46 +22,38 @@ colorLightAt col pos i =
 lightAt :: Point3 -> Int -> LightSource
 lightAt = colorLightAt 0.75
 
-tLightFade :: Int -> Float -> (Int -> Float) -> Point2 -> TempLightSource
+tLightTimedIntensity :: Int -> Float -> (Int -> Float) -> Point2 -> TempLightSource
-tLightFade 0 rmax intensityF (V2 x y) = TLS 
+tLightTimedIntensity t rmax intensityF (V2 x y) = TLS 
     { _tlsPos = V3 x y 0
     , _tlsRad = rmax
-    , _tlsIntensity = f $ intensityF 0
+    , _tlsIntensity = f $ intensityF t
-    , _tlsUpdate = \w _ -> (w, Nothing)
+    , _tlsUpdate = upF
-    , _tlsTime = 0
+    , _tlsTime = t
-    }
-  where
-    f x' = V3 x' x' x'
-tLightFade i rmax intensityF p@(V2 x y) = TLS 
-    { _tlsPos = V3 x y 0
-    , _tlsRad = rmax
-    , _tlsIntensity = f $ intensityF i
-    , _tlsUpdate = \w _ -> (w, Just $ tLightFade (i-1) rmax intensityF p)
-    , _tlsTime = 0
     }
   where
+    upF _ tls 
+        | _tlsTime tls <= 0 = Nothing
+        | otherwise         = Just $ tls    
+            & tlsTime -~ 1
+            & tlsIntensity .~ f (intensityF (_tlsTime tls) )
     f x' = V3 x' x' x'
 
-tLightRad 
+tLight
     :: Int 
     -> Float -- ^ maximal radius
-    -> Float -- ^ minimal radius (unused)
+    -> Point3
     -> Point2 
     -> TempLightSource
-tLightRad 0 rmax _ (V2 x y) = TLS 
+tLight t rmax col (V2 x y) = TLS 
     { _tlsPos = V3 x y 1
     , _tlsRad = rmax
-    , _tlsIntensity = 0.5
+    , _tlsIntensity = col
-    , _tlsUpdate = \w _ -> (w, Nothing)
+    , _tlsUpdate = upF
-    , _tlsTime = 0
+    , _tlsTime = t
-    }
-tLightRad i rmax rmin p@(V2 x y) = TLS 
-    { _tlsPos = V3 x y 0
-    , _tlsRad = rmax
-    , _tlsIntensity = V3 0.5 0.5 0
-    , _tlsUpdate = \w _ -> (w, Just $ tLightRad (i-1) rmax rmin p)
-    , _tlsTime = 0
     }
+  where
+    upF _ tls 
+        | _tlsTime tls <= 0 = Nothing
+        | otherwise         = Just $ tls    
+            & tlsTime -~ 1
 
-tLightAt :: Int -> Point2 -> TempLightSource
-tLightAt i = tLightRad i 100 0

src/Dodge/Particle/Bullet/HitEffect.hs

@@ -17,6 +17,7 @@ import Dodge.WorldEvent.Shockwave
 import Dodge.Creature.State.Data
 import Dodge.Creature.Property
 import Geometry
+import Geometry.Vector3D
 import Picture
 
 import System.Random
@@ -137,11 +138,13 @@ bulConCr' bt p cr w
     mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white)
 {- | Hitting wall effects: create a spark, damage blocks.  -}
 bulHitWall' :: Particle -> Point2 -> Wall -> World -> World
-bulHitWall' bt p x w = damageBlocksBy 5 x
+bulHitWall' bt p wl w = damageBlocksBy 5 wl
-    $ createSparkCol 8 theCol pOut (reflectDir x)
+    . smokeCloudAt dustcol 20 200 1 (addZ 20 pOut)
+    $ createSparkCol 8 theCol pOut (reflectDir wl)
     $ set randGen g
     w
   where 
+    dustcol = _wlColor wl & _4 .~ 1
     theCol = brightX 100 1.5 white
     sp = head $ _btTrail' bt
     pOut = p +.+ safeNormalizeV (sp -.- p)

src/Dodge/Render.hs

@@ -131,8 +131,8 @@ doDrawing pdata w = do
     clearColor $= Color4 0.5 0.5 0.5 0
     --blendFunc $= (SrcAlphaSaturate,One)
     --blendColor $= Color4 0.5 0.5 0.5 0.5
-    blendFuncSeparate $= ((SrcAlphaSaturate,One) , (One,OneMinusSrcAlpha))
+    --blendFuncSeparate $= ((SrcAlphaSaturate,One) , (One,OneMinusSrcAlpha))
-    --blendFuncSeparate $= ((SrcAlpha,OneMinusSrcAlpha),(One,OneMinusSrcAlpha))
+    blendFuncSeparate $= ((SrcAlpha,OneMinusSrcAlpha),(One,OneMinusSrcAlpha))
     drawBuffers $= [FBOColorAttachment 0,NoBuffers]
     clear [ColorBuffer]
     renderLayer 2 shadV layerCounts

src/Dodge/Render/MenuScreen.hs

@@ -6,8 +6,6 @@ module Dodge.Render.MenuScreen
     )
     where
 import Dodge.Data
---import Dodge.Config.Update
---import Dodge.Config.Data
 import Dodge.Base.Window
 import Picture
 import Dodge.Menu

src/Dodge/Update.hs

@@ -124,9 +124,9 @@ updateSoundQueue :: World -> World
 updateSoundQueue = set sounds M.empty
 
 updateLightSources :: World -> World
-updateLightSources w = set tempLightSources (catMaybes tlss) w'
+updateLightSources w = set tempLightSources tlss w
   where 
-    (w',tlss) = mapAccumR (\a b -> _tlsUpdate b a b) w $ _tempLightSources w
+    tlss = mapMaybe (\b -> _tlsUpdate b w b) $ _tempLightSources w
 
 updateProjectiles :: World -> World
 updateProjectiles w = IM.foldl' (flip $ dbArg _pjUpdate) w $ _projectiles w

src/Dodge/WorldEvent.hs

@@ -58,5 +58,5 @@ damCrsOnLine dam p1 p2 = over creatures (IM.map damIfOnLine)
                                      = over crHP (\hp -> hp - dam) cr
                          | otherwise = cr
 
-tempLightForAt :: Int -> Point2 -> World -> World
+makeTLight :: Int -> Float -> Point3 -> Point2 -> World -> World
-tempLightForAt i p w = w & tempLightSources %~ (tLightAt i p :)
+makeTLight i rad col p = tempLightSources %~ (tLight i rad col p :)

src/Dodge/WorldEvent/Cloud.hs

@@ -10,14 +10,14 @@ import Picture
 import Control.Lens
 
 makeCloudAt 
-    :: Float    -- ^ radius
+    :: (Cloud -> Picture) -- ^ draw function
+    -> Float    -- ^ radius
     -> Int      -- ^ timer
     -> Float    -- ^ resting altitude
-    -> (Cloud -> Picture) -- ^ draw function
     -> Point3   -- start position
     -> World 
     -> World
-makeCloudAt rad t alt drawFunc p w = w & clouds %~ (theCloud :)
+makeCloudAt drawFunc rad t alt p w = w & clouds %~ (theCloud :)
   where 
     theCloud = Cloud 
         { _clPos = p
@@ -30,6 +30,16 @@ makeCloudAt rad t alt drawFunc p w = w & clouds %~ (theCloud :)
         , _clEffect = const id
         }
 
+smokeCloudAt 
+    :: Color  
+    -> Float    -- ^ radius
+    -> Int      -- ^ timer
+    -> Float    -- ^ resting altitude
+    -> Point3   -- start position
+    -> World 
+    -> World
+smokeCloudAt col = makeCloudAt (drawCloudWith (4/3) 800 col)
+
 drawCloudWith :: Float -> Float -> Color -> Cloud -> Picture
 drawCloudWith radMult fadet col cl 
     = setLayer 2 
@@ -39,23 +49,23 @@ drawCloudWith radMult fadet col cl
     a = min 1 $ fromIntegral (_clTimer cl) / fadet
 
 makeThickSmokeAt :: Point3 -> World -> World
-makeThickSmokeAt = makeCloudAt 3 50 30 (drawCloudWith 4 50 black)
+makeThickSmokeAt = makeCloudAt (drawCloudWith 4 50 black) 3 50 30
 
 makeThinSmokeAt :: Point3 -> World -> World
-makeThinSmokeAt = makeCloudAt 5 400 50 (drawCloudWith 4 400 (withAlpha 0.05 black))
+makeThinSmokeAt = makeCloudAt (drawCloudWith 4 400 (withAlpha 0.05 black)) 5 400 50
 
 makeStartCloudAt :: Point3 -> World -> World
 --makeSmokeCloudAt = makeCloudAt 10 200 (drawCloudWith 2 200 (greyN 0.5))
-makeStartCloudAt = makeCloudAt 10 400 5 (drawCloudWith 2 800 white)
+makeStartCloudAt = makeCloudAt (drawCloudWith 2 800 white) 10 400 5
 
-makeSmokeCloudAt :: Point3 -> World -> World
+shellTrailCloud :: Point3 -> World -> World
---makeSmokeCloudAt = makeCloudAt 10 200 (drawCloudWith 2 200 (greyN 0.5))
+----makeSmokeCloudAt = makeCloudAt 10 200 (drawCloudWith 2 200 (greyN 0.5))
-makeSmokeCloudAt = makeCloudAt 15 400 40 (drawCloudWith (4/3) 800 (greyN 0.5))
+shellTrailCloud = makeCloudAt (drawCloudWith (4/3) 800 (greyN 0.5)) 15 400 40
 
 makeFlamerSmokeAt :: Float -> Point3 -> World -> World
-makeFlamerSmokeAt x = makeCloudAt 6 200 40 (drawCloudWith 4 300 (greyN x))
+makeFlamerSmokeAt x = makeCloudAt (drawCloudWith 4 300 (greyN x)) 6 200 40
 
 spawnSmokeAtCursor :: World -> World
-spawnSmokeAtCursor w = makeSmokeCloudAt (V3 x y 20) w
+spawnSmokeAtCursor w = shellTrailCloud (V3 x y 20) w
   where
     V2 x y = mouseWorldPos w

src/Dodge/WorldEvent/Flash.hs

@@ -85,7 +85,7 @@ flashFlareAt col alphax (V2 x y) = Particle
     }
 
 explosionFlashAt :: Point2 -> World -> World
-explosionFlashAt p =  over tempLightSources ((:) $ tLightFade 20 150 intensityFunc p)
+explosionFlashAt p =  over tempLightSources ((:) $ tLightTimedIntensity 20 150 intensityFunc p)
   where 
     intensityFunc x 
         | x < 10 = 1 / (10 - fromIntegral x)