Implement smoke as clouds, mask colors when rendering framebuf texture

2021-03-23 23:24:40 +01:00
parent 3aeea1c60f
commit 3f86b0cda0
5 changed files with 61 additions and 11 deletions
@@ -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
+                           }
+