justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Use vertex pulling for clouds

Browse Source
This commit is contained in:
justin
2025-11-12 19:57:07 +00:00
parent ce1937c78e
commit 409180959c
11 changed files with 202 additions and 107 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Shader/Poke/Cloud.hs
+47 -28
View File
@@ -4,19 +4,21 @@ module Shader.Poke.Cloud (pokeCloud, pokeDust) where
import Color
import Control.Lens
import qualified Data.Vector.Unboxed as UV
--import qualified Data.Vector.Unboxed as UV
import Dodge.Data.Cloud
import Dodge.Material.Color
import Foreign
import Geometry.Data
import Graphics.GL.Core45
import Linear
--import Graphics.GL.Core45
--import Linear
pokeCloud :: Ptr Float -> Ptr GLuint -> (Int, Int) -> Cloud -> IO (Int, Int)
pokeCloud vptr iptr (nv, ni) = pokeCloudLike vptr iptr (nv, ni) . mkCloudCloudLike
pokeCloud :: Ptr Float -> Int -> Cloud -> IO Int
pokeCloud vptr nv = pokeCloudLike vptr nv . mkCloudCloudLike
--pokeCloud :: Ptr Float -> Ptr GLuint -> (Int, Int) -> Cloud -> IO (Int, Int)
--pokeCloud vptr iptr (nv, ni) = pokeCloudLike vptr iptr (nv, ni) . mkCloudCloudLike
pokeDust :: Ptr Float -> Ptr GLuint -> (Int, Int) -> Dust -> IO (Int, Int)
pokeDust vptr iptr (nv, ni) = pokeCloudLike vptr iptr (nv, ni) . mkDustCloudLike
pokeDust :: Ptr Float -> Int -> Dust -> IO Int
pokeDust vptr nv = pokeCloudLike vptr nv . mkDustCloudLike
mkCloudCloudLike :: Cloud -> (Point3, Point4)
mkCloudCloudLike x = (x ^. clPos, V4 r g b a)
@@ -30,21 +32,38 @@ mkDustCloudLike x = (x ^. dsPos, V4 r g b a)
(V4 r g b a') = dustColor x
a = a' * min 1 (fromIntegral (_dsTimer x) / 100)
pokeCloudLike ::
Ptr Float -> Ptr GLuint -> (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)
--pokeCloudLike ::
-- Ptr Float -> Ptr GLuint -> (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)
pokeCloudLike :: Ptr Float -> Int -> (Point3, Point4) -> IO Int
pokeCloudLike ptr nv (V3 x y z, V4 r g b a) = do
pokeElemOff ptr (nv * 8) x
pokeElemOff ptr (nv * 8 + 1) y
pokeElemOff ptr (nv * 8 + 2) z
pokeElemOff ptr (nv * 8 + 3) 1
pokeElemOff ptr (nv * 8 + 4) r
pokeElemOff ptr (nv * 8 + 5) g
pokeElemOff ptr (nv * 8 + 6) b
pokeElemOff ptr (nv * 8 + 7) a
return $ nv + 1
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
--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
--pokeCloudLikeVerx :: Ptr Float -> (Point3, Point4) -> Int -> Int -> (Float, Float) -> IO ()
--{-# INLINE pokeCloudLikeVerx #-}
--pokeCloudLikeVerx ptr (V3 x y z, V4 r g b a) nv i (dx, dy) =
-- UV.imapM_ (pokeCloudFloat ptr (nv + i)) $
-- UV.fromList [x, y, z, 1, r, g, b, a]
clColor :: CloudType -> Color
clColor = \case
@@ -53,13 +72,13 @@ clColor = \case
CryoReleaseCloud -> white
GasCloud -> green
pokeCloudFloat :: Ptr Float -> Int -> Int -> Float -> IO ()
{-# INLINE pokeCloudFloat #-}
pokeCloudFloat ptr nv i = pokeElemOff ptr (nv * 12 + i)
pokeCloudIndex :: Ptr GLuint -> Int -> Int -> Int -> Int -> IO ()
{-# INLINE pokeCloudIndex #-}
pokeCloudIndex ptr nv ni ioff voff = pokeElemOff ptr (ni + ioff) (fromIntegral $ nv + voff)
--pokeCloudFloat :: Ptr Float -> Int -> Int -> Float -> IO ()
--{-# INLINE pokeCloudFloat #-}
--pokeCloudFloat ptr nv i = pokeElemOff ptr (nv * 12 + i)
--
--pokeCloudIndex :: Ptr GLuint -> Int -> Int -> Int -> Int -> IO ()
--{-# INLINE pokeCloudIndex #-}
--pokeCloudIndex ptr nv ni ioff voff = pokeElemOff ptr (ni + ioff) (fromIntegral $ nv + voff)
dustColor :: Dust -> Color
dustColor = materialColor . _dsType