Add new smoke module

src/Dodge/WorldEvent/Smoke.hs

@@ -0,0 +1,47 @@
+module Dodge.WorldEvent.Smoke
+    where
+import Dodge.Data
+import Dodge.Base
+
+import Picture
+import Geometry
+
+import Control.Lens
+
+import qualified Data.IntMap.Strict as IM
+
+makeColorSmokeAt :: Color -> Point2 -> Float -> Int -> Point2 -> World -> World
+makeColorSmokeAt col vel scal time p w = over projectiles (IM.insert n smP) w
+    where n = newProjectileKey w
+          smP = Projectile
+                { _ptPos = p
+                , _ptStartPos = p
+                , _ptVel = vel
+                , _ptPict = setLayer 2 . setDepth 0 . uncurry translate p $ color col $ circleSolid 1
+                , _ptID = n
+                , _ptUpdate = moveColorSmoke col scal time n
+                }
+
+moveColorSmoke :: Color -> Float -> Int -> Int -> World -> World
+moveColorSmoke col scal time i w
+    | time > 0 
+        = set (projectiles . ix i . ptPict) pic 
+            . set (projectiles . ix i . ptUpdate) (moveColorSmoke col scal (time-1) i)
+            . set (projectiles . ix i . ptPos) newPos
+            . setVel
+            $ w
+    | time > -50 
+        = set (projectiles . ix i . ptPict) pi1 
+            . set (projectiles . ix i . ptUpdate) (moveColorSmoke col scal (time-1) i)
+            . set (projectiles . ix i . ptPos) newPos
+            . setVel
+            $ w
+    | otherwise 
+        = over projectiles (IM.delete i) w
+    where oldPos = _ptPos $ _projectiles w IM.! i
+          newPos = oldPos +.+ (_ptVel $ _projectiles w IM.! i)
+          setVel = over (projectiles . ix i . ptVel) $ (*.*) 0.99
+          pic = setLayer 2 . setDepth 0 . uncurry translate newPos $ color col $ circleSolid $ (21 - fromIntegral time) * scal
+          pi1 = setLayer 2 . setDepth 0 . uncurry translate newPos 
+                    $ color (withAlpha (1 + fromIntegral time /50) col) 
+                    $ circleSolid $ 21 * scal