Simplify clouds

src/Shader/Poke/Cloud.hs

@@ -1,7 +1,9 @@
-module Shader.Poke.Cloud (
-    pokeCloud,
-) where
+{-# LANGUAGE LambdaCase #-}
 
+module Shader.Poke.Cloud (pokeCloud) where
+
+import Color
+import Control.Lens
 import qualified Data.Vector.Unboxed as UV
 import Dodge.Data.Cloud
 import Foreign
@@ -9,7 +11,7 @@ import Geometry
 import Graphics.GL.Core45
 
 pokeCloud :: Ptr Float -> Ptr GLushort -> (Int, Int) -> Cloud -> IO (Int, Int)
-pokeCloud vptr iptr (nv,ni) cl = do
+pokeCloud vptr iptr (nv, ni) cl = do
     UV.imapM_ (pokeCloudVerx vptr cl nv) $ UV.fromList [(1, 1), (-1, 1), (-1, -1), (1, -1)]
     UV.imapM_ (pokeCloudIndex iptr nv ni) $ UV.fromList [0, 1, 2, 2, 0, 3]
     return (nv + 4, ni + 6)
@@ -17,14 +19,26 @@ pokeCloud vptr iptr (nv,ni) cl = do
 pokeCloudVerx :: Ptr Float -> Cloud -> Int -> Int -> (Float, Float) -> IO ()
 {-# INLINE pokeCloudVerx #-}
 pokeCloudVerx ptr cl nv i (dx, dy) =
-    UV.imapM_ (pokeCloudFloat ptr (nv + i)) $ UV.fromList 
-        [x, y, cz, 1, r, g, b, a, cx, cy, cz, rad, dx, dy, 0, 0]
+    UV.imapM_ (pokeCloudFloat ptr (nv + i)) $
+        UV.fromList
+            [x, y, cz, 1, r, g, b, a, cx, cy, cz, rad, dx, dy, 0, 0]
   where
     V3 cx cy cz = _clPos cl
     V2 x y = V2 cx cy - rad *.* V2 dx dy
-    CloudColor rad' fadet col = _clPict cl
-    (rad,V4 r g b a') = (rad'*_clRad cl, col)
-    a = a' * min 1 (fromIntegral (_clTimer cl) / fadet)
+    --CloudColor fadet col = _clPict cl
+--    CloudColor fadet = _clPict cl
+    (rad, V4 r g b a') = (20, clColor $ cl ^. clType)
+    --    (rad,V4 r g b a') = (_clRad cl*rad', col)
+    a = a' * min 1 (fromIntegral (_clTimer cl) / 100)
+
+clColor :: CloudType -> Color
+clColor = \case
+    SmokeCloud -> white
+    FlamerSmokeCloud -> black
+    RocketCloud -> greyN 0.5
+    CryoReleaseCloud -> blue
+    GasCloud -> green
+    StoneDust -> white
 
 pokeCloudFloat :: Ptr Float -> Int -> Int -> Float -> IO ()
 {-# INLINE pokeCloudFloat #-}