diff --git a/src/Shader/Poke/Cloud.hs b/src/Shader/Poke/Cloud.hs index 4012d3624..18e4822ed 100644 --- a/src/Shader/Poke/Cloud.hs +++ b/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 - 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)