Separate Clouds and Dust

src/Shader/Poke/Cloud.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE LambdaCase #-}
 
-module Shader.Poke.Cloud (pokeCloud) where
+module Shader.Poke.Cloud (pokeCloud,pokeDust) where
 
 import Dodge.Data.Material
 import Color
@@ -34,11 +34,42 @@ pokeCloudVerx ptr cl nv i (dx, dy) =
 
 clColor :: CloudType -> Color
 clColor = \case
-    FlamerSmokeCloud -> greyN 0.7
-    RocketCloud -> greyN 0.5
+    Smoke -> greyN 0.7
+    RocketSmoke -> greyN 0.5
     CryoReleaseCloud -> white
     GasCloud -> green
-    Dust mt -> materialColor mt
+
+pokeCloudFloat :: Ptr Float -> Int -> Int -> Float -> IO ()
+{-# INLINE pokeCloudFloat #-}
+pokeCloudFloat ptr nv i = pokeElemOff ptr (nv * 16 + i)
+
+pokeCloudIndex :: Ptr GLushort -> Int -> Int -> Int -> Int -> IO ()
+{-# INLINE pokeCloudIndex #-}
+pokeCloudIndex ptr nv ni ioff voff = pokeElemOff ptr (ni + ioff) (fromIntegral $ nv + voff)
+
+pokeDust :: Ptr Float -> Ptr GLushort -> (Int, Int) -> Dust -> IO (Int, Int)
+pokeDust vptr iptr (nv, ni) cl = do
+    UV.imapM_ (pokeDustVerx vptr cl nv) $ UV.fromList [(1, 1), (-1, 1), (-1, -1), (1, -1)]
+    UV.imapM_ (pokeDustIndex iptr nv ni) $ UV.fromList [0, 1, 2, 2, 0, 3]
+    return (nv + 4, ni + 6)
+
+pokeDustVerx :: Ptr Float -> Dust -> Int -> Int -> (Float, Float) -> IO ()
+{-# INLINE pokeDustVerx #-}
+pokeDustVerx ptr cl nv i (dx, dy) =
+    UV.imapM_ (pokeDustFloat 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 = _dsPos cl
+    V2 x y = V2 cx cy - rad *.* V2 dx dy
+    --CloudColor fadet col = _clPict cl
+--    CloudColor fadet = _clPict cl
+    (rad, V4 r g b a') = (20, dustColor cl)
+    --    (rad,V4 r g b a') = (_clRad cl*rad', col)
+    a = a' * min 1 (fromIntegral (_dsTimer cl) / 100)
+
+dustColor :: Dust -> Color
+dustColor = materialColor . _dsType
 
 materialColor :: Material -> Color
 materialColor = withAlpha 0.5 . \case
@@ -52,10 +83,10 @@ materialColor = withAlpha 0.5 . \case
     Electronics-> greyN 0.2
 
 
-pokeCloudFloat :: Ptr Float -> Int -> Int -> Float -> IO ()
-{-# INLINE pokeCloudFloat #-}
-pokeCloudFloat ptr nv i = pokeElemOff ptr (nv * 16 + i)
+pokeDustFloat :: Ptr Float -> Int -> Int -> Float -> IO ()
+{-# INLINE pokeDustFloat #-}
+pokeDustFloat ptr nv i = pokeElemOff ptr (nv * 16 + i)
 
-pokeCloudIndex :: Ptr GLushort -> Int -> Int -> Int -> Int -> IO ()
-{-# INLINE pokeCloudIndex #-}
-pokeCloudIndex ptr nv ni ioff voff = pokeElemOff ptr (ni + ioff) (fromIntegral $ nv + voff)
+pokeDustIndex :: Ptr GLushort -> Int -> Int -> Int -> Int -> IO ()
+{-# INLINE pokeDustIndex #-}
+pokeDustIndex ptr nv ni ioff voff = pokeElemOff ptr (ni + ioff) (fromIntegral $ nv + voff)