Implement smoke as clouds, mask colors when rendering framebuf texture

src/Dodge/Item/Weapon.hs

@@ -790,13 +790,14 @@ moveShell time i cid rot accel w
                         _ -> 0
               (v1:v2:v3:_) = fst $ runState ((sequence . repeat . randInCirc) 0.1) $ _randGen w
               (r1:r2:r3:_) = map ((*.*) 100) (v2:v3:v1:[])
-              (t1:t2:t3:_) = randomRs ( 15,20) $ _randGen w
-              (s1:s2:s3:_) = map (\s -> fromIntegral s * 0.1 - 1) (t3:t2:t1:[])
               -- ((r1:r2:r3:_),_) = runState ((sequence . repeat . randInCirc)  10) $ _randGen w
               -- v1 = fst $ runState (randInCirc 0.5) $ _randGen w
-              smokeGen =  makeSmokeAt'' v1 s1 t1 (newPos +.+ r1)
-                                   . makeSmokeAt'' v2 s2 t2 (newPos +.+ r2)
-                           --        . makeSmokeAt'' v3 s3 t3 (newPos +.+ r3)
+              smokeGen = makeSmokeCloud (oldPos +.+ r1 +.+ 30 *.* (normalizeV (oldPos -.- newPos)))
+--              (t1:t2:t3:_) = randomRs ( 15,20) $ _randGen w
+--              (s1:s2:s3:_) = map (\s -> fromIntegral s * 0.1 - 1) (t3:t2:t1:[])
+--              smokeGen =  makeSmokeAt'' v1 s1 t1 (newPos +.+ r1)
+--                                   . makeSmokeAt'' v2 s2 t2 (newPos +.+ r2)
+--                           --        . makeSmokeAt'' v3 s3 t3 (newPos +.+ r3)
 
 
 normalizeAnglePi angle | normalizeAngle angle > pi = normalizeAngle angle - 2*pi
@@ -984,11 +985,12 @@ moveFlame rotd w pt =
                 scaleChange | time < 80 = 3
                             | otherwise = 3 - (fromIntegral time - 80) * 0.2
                 g       = _randGen w
-                tms     = randomRs (15,20) g
-                scs     = randomRs (0.1,0.5) g
+ --               tms     = randomRs (15,20) g
+--                scs     = randomRs (0.1,0.5) g
                 (rs,g1) = runState ((sequence . take 5 . repeat . randInCirc) 20) $ _randGen w
                 f sc tm r = makeColorSmokeAt (greyN 0.3) (0.5 *.* vel) sc tm (ep +.+ r)
-                smokeGen w = set randGen g1 $ foldr ($) w (zipWith3 f scs tms rs)
+               -- smokeGen w = set randGen g1 $ foldr ($) w (zipWith3 f scs tms rs)
+                smokeGen = makeFlamerSmoke ep
 
     
 flamerAngle = 0.3

src/Dodge/LevelGen/WindowBlock.hs

@@ -17,7 +17,7 @@ basePane :: Wall
 basePane = Block
     { _wlLine = []
     , _wlID = 0
-    , _wlColor = withAlpha 0.5 cyan
+    , _wlColor = withAlpha 0.2 cyan
     , _wlDraw = Nothing
     , _wlSeen = False
     , _blIDs = []

src/Dodge/WorldEvent.hs

@@ -5,6 +5,7 @@ module Dodge.WorldEvent
     , module Dodge.WorldEvent.ThingsHit
     , module Dodge.WorldEvent.HelperParticle
     , module Dodge.WorldEvent.Projectile
+    , module Dodge.WorldEvent.Cloud
     )
     where
 
@@ -13,6 +14,7 @@ import Dodge.WorldEvent.Bullet
 import Dodge.WorldEvent.Flash
 import Dodge.WorldEvent.ThingsHit
 import Dodge.WorldEvent.HelperParticle
+import Dodge.WorldEvent.Cloud
 import Dodge.LightSources
 
 import Dodge.Data

src/Dodge/WorldEvent/Cloud.hs

@@ -0,0 +1,41 @@
+module Dodge.WorldEvent.Cloud
+    where
+
+import Dodge.Data
+import Dodge.Base
+
+import Geometry
+
+import Picture
+
+import Control.Lens
+import qualified Data.IntMap as IM
+
+makeSmokeCloud :: Point2 -> World -> World
+makeSmokeCloud pos w = w & clouds %~ IM.insert i theCloud
+    where i = newKey $ _clouds w
+          theCloud = Cloud { _clID = i
+                           , _clPos = pos
+                           , _clVel = (0,0)
+                           , _clPict = fadeOutPict (-0.5)
+                           , _clRad = 10
+                           , _clTimer = 200
+                           , _clEffect = const id
+                           }
+
+fadeOutPict :: Float -> Cloud -> Picture
+fadeOutPict dpth cl = setLayer 2 . setDepth dpth . color (withAlpha a $ greyN 0.5) $ circleSolid (2 * _clRad cl)
+    where a = fromIntegral (_clTimer cl) / 200
+
+makeFlamerSmoke :: Point2 -> World -> World
+makeFlamerSmoke pos w = w & clouds %~ IM.insert i theCloud
+    where i = newKey $ _clouds w
+          theCloud = Cloud { _clID = i
+                           , _clPos = pos
+                           , _clVel = (0,0)
+                           , _clPict = fadeOutPict 0
+                           , _clRad = 5
+                           , _clTimer = 200
+                           , _clEffect = const id
+                           }
+

src/Picture/Render.hs

@@ -62,11 +62,12 @@ renderPicture' pdata rot zoom trans@(tranx,trany) wins@(winx,winy) wallPointsCol
     renderFoldable pdata $ picToLTree (Just 0) pic
 
 -- reset blend so that light map doesn't apply
-    blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
+--    blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
+    blendFuncSeparate $= ((SrcAlpha,OneMinusSrcAlpha) , (Zero,One))
     renderFoldable pdata $ picToLTree (Just 1) pic
 
 -- set drawing for on top
---    blendFuncSeparate    $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
+    blendFuncSeparate    $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
 
     renderFoldable pdata $ picToLTree (Just 2) pic
 
@@ -190,6 +191,8 @@ createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
 
 --    blendFunc $= (Zero,One)
     bindFramebuffer Framebuffer $= defaultFramebufferObject
+
+    colorMask $= (Color4 Disabled Disabled Disabled Enabled)
 --
 --    blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
     bindShaderBuffers [_fullscreenShader pdata] [4]
@@ -197,6 +200,8 @@ createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
 --    blendFunc $= (One, Zero)
     drawShader (_fullscreenShader pdata) 4
 
+    colorMask $= (Color4 Enabled Enabled Enabled Enabled)
+
     blend $= Enabled
 
 renderBackground :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) -> IO ()