Unify dust and cloud poking
This commit is contained in:
+48
-35
@@ -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
|
||||
UV.imapM_ (pokeCloudVerx vptr cl nv) $ UV.fromList [(1, 1), (-1, 1), (-1, -1), (1, -1)]
|
||||
pokeCloud vptr iptr (nv, ni) = pokeCloudLike vptr iptr (nv,ni) . mkCloudCloudLike
|
||||
|
||||
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
|
||||
--[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]
|
||||
UV.fromList [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
|
||||
--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)
|
||||
V2 x y = V2 cx cy - 20 *^ V2 dx dy
|
||||
( V4 r g b a') = ( clColor $ cl ^. clType)
|
||||
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 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)
|
||||
--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_ (pokeCloudIndex 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]
|
||||
[x, y, cz, 1, r, g, b, a, dx, dy, 0, 0]
|
||||
UV.imapM_ (pokeCloudFloat ptr (nv + i)) $
|
||||
UV.fromList [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
|
||||
--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)
|
||||
V2 x y = V2 cx cy - 20 *^ V2 dx dy
|
||||
( V4 r g b a') = ( dustColor cl)
|
||||
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)
|
||||
|
||||
Reference in New Issue
Block a user