Unify dust and cloud poking

src/Shader/Poke/Cloud.hs

@@ -2,18 +2,43 @@
 
 module Shader.Poke.Cloud (pokeCloud,pokeDust) where
 
+import Geometry.Data
+import Linear
 import Dodge.Material.Color
 import Color
 import Control.Lens
 import qualified Data.Vector.Unboxed as UV
 import Dodge.Data.Cloud
 import Foreign
-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) = pokeCloudLike vptr iptr (nv,ni) . mkCloudCloudLike
-    UV.imapM_ (pokeCloudVerx vptr cl nv) $ UV.fromList [(1, 1), (-1, 1), (-1, -1), (1, -1)]
+
+pokeDust :: Ptr Float -> Ptr GLushort -> (Int, Int) -> Dust -> IO (Int, Int)
+pokeDust vptr iptr (nv, ni) = pokeCloudLike vptr iptr (nv,ni) . mkDustCloudLike
+
+mkCloudCloudLike :: Cloud -> (Point3,Point4)
+mkCloudCloudLike x = (x ^. clPos,V4 r g b a)
+  where
+    ( V4 r g b a') = ( clColor $ x ^. clType)
+    a = a' * min 1 (fromIntegral (_clTimer x) / 100)
+
+mkDustCloudLike :: Dust -> (Point3,Point4)
+mkDustCloudLike x = (x ^. dsPos, V4 r g b a)
+  where
+    ( V4 r g b a') = ( dustColor x)
+    a = a' * min 1 (fromIntegral (_dsTimer x) / 100)
+
+--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)
+
+pokeCloudLike :: Ptr Float -> Ptr GLushort -> (Int, Int) -> (Point3,Point4) -> IO (Int, Int)
+pokeCloudLike vptr iptr (nv, ni) x = do
+    UV.imapM_ (pokeCloudLikeVerx vptr x 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)
 
@@ -21,18 +46,21 @@ 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
+        UV.fromList [x, y, cz, 1, r, g, b, a, dx, dy, 0, 0]
-            --[x, y, cz, 1, r, g, b, a, cx, cy, cz, rad, dx, dy, 0, 0]
-            [x, y, cz, 1, r, g, b, a, dx, dy, 0, 0]
   where
     V3 cx cy cz = _clPos cl
-    V2 x y = V2 cx cy - rad *.* V2 dx dy
+    V2 x y = V2 cx cy - 20 *^ V2 dx dy
-    --CloudColor fadet col = _clPict cl
+    ( V4 r g b a') = ( clColor $ cl ^. clType)
---    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)
 
+pokeCloudLikeVerx :: Ptr Float -> (Point3,Point4) -> Int -> Int -> (Float, Float) -> IO ()
+{-# INLINE pokeCloudLikeVerx #-}
+pokeCloudLikeVerx ptr (V3 cx cy cz,V4 r g b a) nv i (dx, dy) =
+    UV.imapM_ (pokeCloudFloat ptr (nv + i)) $
+        UV.fromList [x, y, cz, 1, r, g, b, a, dx, dy, 0, 0]
+  where
+    V2 x y = V2 cx cy - 20 *^ V2 dx dy
+
 clColor :: CloudType -> Color
 clColor = \case
     Smoke -> greyN 0.7
@@ -42,43 +70,28 @@ clColor = \case
 
 pokeCloudFloat :: Ptr Float -> Int -> Int -> Float -> IO ()
 {-# INLINE pokeCloudFloat #-}
---pokeCloudFloat ptr nv i = pokeElemOff ptr (nv * 16 + i)
 pokeCloudFloat ptr nv i = pokeElemOff ptr (nv * 12 + 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 :: Ptr Float -> Ptr GLushort -> (Int, Int) -> Dust -> IO (Int, Int)
-pokeDust vptr iptr (nv, ni) cl = do
+--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_ (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]
+--    UV.imapM_ (pokeCloudIndex iptr nv ni) $ UV.fromList [0, 1, 2, 2, 0, 3]
-    return (nv + 4, ni + 6)
+--    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.imapM_ (pokeCloudFloat ptr (nv + i)) $
-        UV.fromList
+        UV.fromList [x, y, cz, 1, r, g, b, a, dx, dy, 0, 0]
-            --[x, y, cz, 1, r, g, b, a, cx, cy, cz, rad, dx, dy, 0, 0]
-            [x, y, cz, 1, r, g, b, a, dx, dy, 0, 0]
   where
     V3 cx cy cz = _dsPos cl
-    V2 x y = V2 cx cy - rad *.* V2 dx dy
+    V2 x y = V2 cx cy - 20 *^ V2 dx dy
-    --CloudColor fadet col = _clPict cl
+    ( V4 r g b a') = ( dustColor 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
-
-pokeDustFloat :: Ptr Float -> Int -> Int -> Float -> IO ()
-{-# INLINE pokeDustFloat #-}
---pokeDustFloat ptr nv i = pokeElemOff ptr (nv * 16 + i)
-pokeDustFloat ptr nv i = pokeElemOff ptr (nv * 12 + i)
-
-pokeDustIndex :: Ptr GLushort -> Int -> Int -> Int -> Int -> IO ()
-{-# INLINE pokeDustIndex #-}
-pokeDustIndex ptr nv ni ioff voff = pokeElemOff ptr (ni + ioff) (fromIntegral $ nv + voff)