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

Broken implementation of window colours, move towards stencil ceilings

Browse Source
This commit is contained in:
justin
2025-10-29 21:48:09 +00:00
parent 40c1907689
commit c2e5aaa7a0
17 changed files with 76 additions and 85 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Shader/Poke/Cloud.hs
+17 -16
View File
@@ -1,45 +1,46 @@
{-# LANGUAGE LambdaCase #-}
module Shader.Poke.Cloud (pokeCloud,pokeDust) where
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 Dodge.Material.Color
import Foreign
import Geometry.Data
import Graphics.GL.Core45
import Linear
pokeCloud :: Ptr Float -> Ptr GLushort -> (Int, Int) -> Cloud -> IO (Int, Int)
pokeCloud vptr iptr (nv, ni) = pokeCloudLike vptr iptr (nv,ni) . mkCloudCloudLike
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
pokeDust vptr iptr (nv, ni) = pokeCloudLike vptr iptr (nv, ni) . mkDustCloudLike
mkCloudCloudLike :: Cloud -> (Point3,Point4)
mkCloudCloudLike x = (x ^. clPos,V4 r g b a)
mkCloudCloudLike :: Cloud -> (Point3, Point4)
mkCloudCloudLike x = (x ^. clPos, V4 r g b a)
where
( V4 r g b a') = ( clColor $ x ^. clType)
(V4 r g b a') = clColor $ x ^. clType
a = a' * min 1 (fromIntegral (_clTimer x) / 100)
mkDustCloudLike :: Dust -> (Point3,Point4)
mkDustCloudLike :: Dust -> (Point3, Point4)
mkDustCloudLike x = (x ^. dsPos, V4 r g b a)
where
( V4 r g b a') = ( dustColor x)
(V4 r g b a') = dustColor x
a = a' * min 1 (fromIntegral (_dsTimer x) / 100)
pokeCloudLike :: Ptr Float -> Ptr GLushort -> (Int, Int) -> (Point3,Point4) -> IO (Int, Int)
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_ (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)
pokeCloudLikeVerx :: Ptr Float -> (Point3,Point4) -> Int -> Int -> (Float, Float) -> IO ()
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) =
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