Remove list layer while poking

This commit is contained in:
2021-06-12 02:08:42 +02:00
parent 0cb0c752e2
commit 02a2d3920d
4 changed files with 45 additions and 45 deletions
+29 -29
View File
@@ -59,24 +59,24 @@ preloadRender = do
>>= addTexture "data/texture/charMap.png" >>= addTexture "data/texture/charMap.png"
-- texture shaders, no textures attached -- texture shaders, no textures attached
fsShad <- makeShader "texture/simple" [vert,frag] [2,2] TriangleStrip $ const fsShad <- makeShader "texture/simple" [vert,frag] [2,2] TriangleStrip $ const
[[[-1, 1],[0,1]] [[-1, 1,0,1]
,[[ 1, 1],[1,1]] ,[ 1, 1,1,1]
,[[-1,-1],[0,0]] ,[-1,-1,0,0]
,[[ 1,-1],[1,0]] ,[ 1,-1,1,0]
] ]
_ <- F.foldM (pokeShader' fsShad) [RenderConst] -- fix fullscreen vertex positions now _ <- F.foldM (pokeShader' fsShad) [RenderConst] -- fix fullscreen vertex positions now
boxBlurShad <- makeShader "texture/boxBlur" [vert,frag] [2,2] TriangleStrip $ const boxBlurShad <- makeShader "texture/boxBlur" [vert,frag] [2,2] TriangleStrip $ const
[[[-1, 1],[0,1]] [[-1, 1,0,1]
,[[ 1, 1],[1,1]] ,[ 1, 1,1,1]
,[[-1,-1],[0,0]] ,[-1,-1,0,0]
,[[ 1,-1],[1,0]] ,[ 1,-1,1,0]
] ]
_ <- F.foldM (pokeShader' boxBlurShad) [RenderConst] -- fix fullscreen vertex positions now _ <- F.foldM (pokeShader' boxBlurShad) [RenderConst] -- fix fullscreen vertex positions now
grayscaleShad <- makeShader "texture/grayscale" [vert,frag] [2,2] TriangleStrip $ const grayscaleShad <- makeShader "texture/grayscale" [vert,frag] [2,2] TriangleStrip $ const
[[[-1, 1],[0,1]] [[-1, 1,0,1]
,[[ 1, 1],[1,1]] ,[ 1, 1,1,1]
,[[-1,-1],[0,0]] ,[-1,-1,0,0]
,[[ 1,-1],[1,0]] ,[ 1,-1,1,0]
] ]
_ <- F.foldM (pokeShader' grayscaleShad) [RenderConst] -- fix fullscreen vertex positions now _ <- F.foldM (pokeShader' grayscaleShad) [RenderConst] -- fix fullscreen vertex positions now
-- background shader -- background shader
@@ -184,31 +184,31 @@ cleanUpRenderPreload pd = do
freeShaderPointers $ _fullscreenShader pd freeShaderPointers $ _fullscreenShader pd
{-# INLINE pokeBezQStrat #-} {-# INLINE pokeBezQStrat #-}
pokeBezQStrat :: RenderType -> [[[Float]]] pokeBezQStrat :: RenderType -> [[Float]]
pokeBezQStrat (RenderBezQ vs) = fmap (\((x,y,z),(r,g,b,a),(s,t,u,v)) -> [[x,y,z],[r,g,b,a],[s,t,u,v]] pokeBezQStrat (RenderBezQ vs) = fmap (\((x,y,z),(r,g,b,a),(s,t,u,v)) -> [x,y,z,r,g,b,a,s,t,u,v]
) )
vs vs
pokeBezQStrat _ = [] pokeBezQStrat _ = []
{-# INLINE pokeTriStrat #-} {-# INLINE pokeTriStrat #-}
pokeTriStrat,pokeCharStrat,pokeArcStrat,pokeLineStrat,pokeEllStrat :: RenderType -> [[[Float]]] pokeTriStrat,pokeCharStrat,pokeArcStrat,pokeLineStrat,pokeEllStrat :: RenderType -> [[Float]]
pokeTriStrat (RenderPoly vs) = fmap (\(p,co) -> [flat3 p,flat4 co]) vs pokeTriStrat (RenderPoly vs) = fmap (\(p,co) -> concat [flat3 p,flat4 co]) vs
pokeTriStrat _ = [] pokeTriStrat _ = []
pokeLightingFloorStrat :: RenderType -> [[[Float]]] pokeLightingFloorStrat :: RenderType -> [[Float]]
pokeLightingFloorStrat Render1111{_unRender1111=x} = [[flat4 x]] pokeLightingFloorStrat Render1111{_unRender1111=x} = [flat4 x]
pokeLightingFloorStrat _ = undefined pokeLightingFloorStrat _ = undefined
pokeCharStrat (RenderText vs) = fmap (\(a,b,c) -> [flat3 a, flat4 b, flat3 c]) vs pokeCharStrat (RenderText vs) = fmap (\(a,b,c) -> concat [flat3 a, flat4 b, flat3 c]) vs
pokeCharStrat _ = [] pokeCharStrat _ = []
pokeArcStrat (RenderArc (a,b,c)) = [[flat3 a, flat4 b, flat4 c]] pokeArcStrat (RenderArc (a,b,c)) = [concat [flat3 a, flat4 b, flat4 c]]
pokeArcStrat _ = [] pokeArcStrat _ = []
pokeLineStrat (RenderLine vs) = fmap (\((x,y,z),(r,g,b,a)) -> [[x,y,z],[r,g,b,a]]) vs pokeLineStrat (RenderLine vs) = fmap (\((x,y,z),(r,g,b,a)) -> [x,y,z,r,g,b,a]) vs
pokeLineStrat _ = [] pokeLineStrat _ = []
pokeEllStrat (RenderEllipse vs) = fmap (\((x,y,z),(r,g,b,a)) -> [[x,y,z],[r,g,b,a]]) vs pokeEllStrat (RenderEllipse vs) = fmap (\((x,y,z),(r,g,b,a)) -> [x,y,z,r,g,b,a]) vs
pokeEllStrat _ = [] pokeEllStrat _ = []
vert, geom, frag :: ShaderType vert, geom, frag :: ShaderType
@@ -216,16 +216,16 @@ vert = VertexShader
geom = GeometryShader geom = GeometryShader
frag = FragmentShader frag = FragmentShader
pokeWPStrat :: RenderType -> [[[Float]]] pokeWPStrat :: RenderType -> [[Float]]
pokeWPStrat Render22{_unRender22 = ((x,y),(z,w))} = [[[x,y,z,w]]] pokeWPStrat Render22{_unRender22 = ((x,y),(z,w))} = [[x,y,z,w]]
pokeWPStrat _ = undefined pokeWPStrat _ = undefined
pokeWPColStrat :: RenderType -> [[[Float]]] pokeWPColStrat :: RenderType -> [[Float]]
pokeWPColStrat Render22x4{_unRender22x4=(((x,y),(z,w)),(r,g,b,a))} = [[[x,y,z,w],[r,g,b,a]]] pokeWPColStrat Render22x4{_unRender22x4=(((x,y),(z,w)),(r,g,b,a))} = [[x,y,z,w,r,g,b,a]]
pokeWPColStrat _ = undefined pokeWPColStrat _ = undefined
poke32 :: (Point3,Point2) -> [[[Float]]] poke32 :: (Point3,Point2) -> [[Float]]
poke32 ((x,y,z),(a,b)) = [[[x,y,z],[a,b]]] poke32 ((x,y,z),(a,b)) = [[x,y,z,a,b]]
pokeBGStrat :: a -> [[[Float]]] pokeBGStrat :: a -> [[Float]]
pokeBGStrat = const [] pokeBGStrat = const []
+5 -6
View File
@@ -33,7 +33,6 @@ extractProgAndUnis s = (_shaderProgram s, _shaderMatrixUniform s)
pokeShaders :: [FullShader] -> F.FoldM IO RenderType [Int] pokeShaders :: [FullShader] -> F.FoldM IO RenderType [Int]
pokeShaders = traverse pokeShader' pokeShaders = traverse pokeShader'
--pokeShaders = traverse pokeShader
pokeShader' :: FullShader -> F.FoldM IO RenderType Int pokeShader' :: FullShader -> F.FoldM IO RenderType Int
pokeShader' fs = F.FoldM (pokeRender' fls ptr stride) (return 0) return pokeShader' fs = F.FoldM (pokeRender' fls ptr stride) (return 0) return
@@ -44,7 +43,7 @@ pokeShader' fs = F.FoldM (pokeRender' fls ptr stride) (return 0) return
fls = _shaderPokeStrategy fs fls = _shaderPokeStrategy fs
pokeRender' pokeRender'
:: (RenderType -> [[[Float]]]) :: (RenderType -> [[Float]])
-> Ptr Float -> Ptr Float
-> Int -- ^ stride -> Int -- ^ stride
-> Int -> Int
@@ -52,12 +51,12 @@ pokeRender'
-> IO Int -> IO Int
pokeRender' toFs ptr stride n rt = pokeList' ptr stride n (toFs rt) pokeRender' toFs ptr stride n rt = pokeList' ptr stride n (toFs rt)
pokeList' :: Ptr Float -> Int -> Int -> [[[Float]]] -> IO Int pokeList' :: Ptr Float -> Int -> Int -> [[Float]] -> IO Int
pokeList' ptr stride = foldM (pokePtrs' ptr stride) pokeList' ptr stride = foldM (pokePtrs' ptr stride)
pokePtrs' :: Ptr Float -> Int -> Int -> [[Float]] -> IO Int pokePtrs' :: Ptr Float -> Int -> Int -> [Float] -> IO Int
pokePtrs' ptr stride n fss = do pokePtrs' ptr stride n fs = do
pokeArrayOff ptr (stride * n) (concat fss) pokeArrayOff ptr (stride * n) fs
return $ n + 1 return $ n + 1
pokeArrayOff :: Storable a => Ptr a -> Int -> [a] -> IO () pokeArrayOff :: Storable a => Ptr a -> Int -> [a] -> IO ()
+10 -9
View File
@@ -22,19 +22,20 @@ makeShader
-> [ShaderType] -- ^ Filetype extensions -> [ShaderType] -- ^ Filetype extensions
-> [Int] -- ^ The input vertex sizes -> [Int] -- ^ The input vertex sizes
-> PrimitiveMode -> PrimitiveMode
-> (RenderType -> [[[Float]]]) -- ^ Poke strategy: method for creating a list of vertex data to be bound -> (RenderType -> [[Float]]) -- ^ Poke strategy: method for creating a list of vertex data to be bound
-> IO (FullShader) -> IO (FullShader)
makeShader s shaderlist sizes pm renStrat = do makeShader s shaderlist sizes pm renStrat = do
(prog,unis) <- makeSourcedShader s shaderlist (prog,unis) <- makeSourcedShader s shaderlist
vaob <- setupVAO sizes vaob <- setupVAO sizes
return $ FullShader { _shaderProgram = prog return $ FullShader
, _shaderMatrixUniform = unis { _shaderProgram = prog
, _shaderVAO = vaob , _shaderMatrixUniform = unis
, _shaderPokeStrategy = renStrat , _shaderVAO = vaob
, _shaderDrawPrimitive = pm , _shaderPokeStrategy = renStrat
, _shaderTexture = Nothing , _shaderDrawPrimitive = pm
, _shaderCustomUnis = [] , _shaderTexture = Nothing
} , _shaderCustomUnis = []
}
-- | Compile shader and get its uniform locations. -- | Compile shader and get its uniform locations.
-- supposes the shader code is in the shader folder, with the string names -- supposes the shader code is in the shader folder, with the string names
+1 -1
View File
@@ -47,7 +47,7 @@ data FullShader = FullShader
{ _shaderProgram :: Program { _shaderProgram :: Program
, _shaderMatrixUniform :: UniformLocation , _shaderMatrixUniform :: UniformLocation
, _shaderVAO :: VAO , _shaderVAO :: VAO
, _shaderPokeStrategy :: RenderType -> [[[Float]]]-- -> F.FoldM IO RenderType Int , _shaderPokeStrategy :: RenderType -> [[Float]]-- -> F.FoldM IO RenderType Int
, _shaderDrawPrimitive :: PrimitiveMode , _shaderDrawPrimitive :: PrimitiveMode
, _shaderTexture :: Maybe ShaderTexture , _shaderTexture :: Maybe ShaderTexture
, _shaderCustomUnis :: [UniformLocation] , _shaderCustomUnis :: [UniformLocation]