From 02a2d3920d1affc05b1dec1652c66750bca4f209 Mon Sep 17 00:00:00 2001 From: jgk Date: Sat, 12 Jun 2021 02:08:42 +0200 Subject: [PATCH] Remove list layer while poking --- src/Picture/Preload.hs | 58 +++++++++++++++++++++--------------------- src/Shader.hs | 11 ++++---- src/Shader/Compile.hs | 19 +++++++------- src/Shader/Data.hs | 2 +- 4 files changed, 45 insertions(+), 45 deletions(-) diff --git a/src/Picture/Preload.hs b/src/Picture/Preload.hs index 98c3d2d93..ac9ae01e2 100644 --- a/src/Picture/Preload.hs +++ b/src/Picture/Preload.hs @@ -59,24 +59,24 @@ preloadRender = do >>= addTexture "data/texture/charMap.png" -- texture shaders, no textures attached fsShad <- makeShader "texture/simple" [vert,frag] [2,2] TriangleStrip $ const - [[[-1, 1],[0,1]] - ,[[ 1, 1],[1,1]] - ,[[-1,-1],[0,0]] - ,[[ 1,-1],[1,0]] + [[-1, 1,0,1] + ,[ 1, 1,1,1] + ,[-1,-1,0,0] + ,[ 1,-1,1,0] ] _ <- F.foldM (pokeShader' fsShad) [RenderConst] -- fix fullscreen vertex positions now boxBlurShad <- makeShader "texture/boxBlur" [vert,frag] [2,2] TriangleStrip $ const - [[[-1, 1],[0,1]] - ,[[ 1, 1],[1,1]] - ,[[-1,-1],[0,0]] - ,[[ 1,-1],[1,0]] + [[-1, 1,0,1] + ,[ 1, 1,1,1] + ,[-1,-1,0,0] + ,[ 1,-1,1,0] ] _ <- F.foldM (pokeShader' boxBlurShad) [RenderConst] -- fix fullscreen vertex positions now grayscaleShad <- makeShader "texture/grayscale" [vert,frag] [2,2] TriangleStrip $ const - [[[-1, 1],[0,1]] - ,[[ 1, 1],[1,1]] - ,[[-1,-1],[0,0]] - ,[[ 1,-1],[1,0]] + [[-1, 1,0,1] + ,[ 1, 1,1,1] + ,[-1,-1,0,0] + ,[ 1,-1,1,0] ] _ <- F.foldM (pokeShader' grayscaleShad) [RenderConst] -- fix fullscreen vertex positions now -- background shader @@ -184,31 +184,31 @@ cleanUpRenderPreload pd = do freeShaderPointers $ _fullscreenShader pd {-# INLINE pokeBezQStrat #-} -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 :: 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] ) vs pokeBezQStrat _ = [] {-# INLINE pokeTriStrat #-} -pokeTriStrat,pokeCharStrat,pokeArcStrat,pokeLineStrat,pokeEllStrat :: RenderType -> [[[Float]]] -pokeTriStrat (RenderPoly vs) = fmap (\(p,co) -> [flat3 p,flat4 co]) vs +pokeTriStrat,pokeCharStrat,pokeArcStrat,pokeLineStrat,pokeEllStrat :: RenderType -> [[Float]] +pokeTriStrat (RenderPoly vs) = fmap (\(p,co) -> concat [flat3 p,flat4 co]) vs pokeTriStrat _ = [] -pokeLightingFloorStrat :: RenderType -> [[[Float]]] -pokeLightingFloorStrat Render1111{_unRender1111=x} = [[flat4 x]] +pokeLightingFloorStrat :: RenderType -> [[Float]] +pokeLightingFloorStrat Render1111{_unRender1111=x} = [flat4 x] 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 _ = [] -pokeArcStrat (RenderArc (a,b,c)) = [[flat3 a, flat4 b, flat4 c]] +pokeArcStrat (RenderArc (a,b,c)) = [concat [flat3 a, flat4 b, flat4 c]] 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 _ = [] -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 _ = [] vert, geom, frag :: ShaderType @@ -216,16 +216,16 @@ vert = VertexShader geom = GeometryShader frag = FragmentShader -pokeWPStrat :: RenderType -> [[[Float]]] -pokeWPStrat Render22{_unRender22 = ((x,y),(z,w))} = [[[x,y,z,w]]] +pokeWPStrat :: RenderType -> [[Float]] +pokeWPStrat Render22{_unRender22 = ((x,y),(z,w))} = [[x,y,z,w]] pokeWPStrat _ = undefined -pokeWPColStrat :: RenderType -> [[[Float]]] -pokeWPColStrat Render22x4{_unRender22x4=(((x,y),(z,w)),(r,g,b,a))} = [[[x,y,z,w],[r,g,b,a]]] +pokeWPColStrat :: RenderType -> [[Float]] +pokeWPColStrat Render22x4{_unRender22x4=(((x,y),(z,w)),(r,g,b,a))} = [[x,y,z,w,r,g,b,a]] pokeWPColStrat _ = undefined -poke32 :: (Point3,Point2) -> [[[Float]]] -poke32 ((x,y,z),(a,b)) = [[[x,y,z],[a,b]]] +poke32 :: (Point3,Point2) -> [[Float]] +poke32 ((x,y,z),(a,b)) = [[x,y,z,a,b]] -pokeBGStrat :: a -> [[[Float]]] +pokeBGStrat :: a -> [[Float]] pokeBGStrat = const [] diff --git a/src/Shader.hs b/src/Shader.hs index 6261c5de3..ba466fa80 100644 --- a/src/Shader.hs +++ b/src/Shader.hs @@ -33,7 +33,6 @@ extractProgAndUnis s = (_shaderProgram s, _shaderMatrixUniform s) pokeShaders :: [FullShader] -> F.FoldM IO RenderType [Int] pokeShaders = traverse pokeShader' ---pokeShaders = traverse pokeShader pokeShader' :: FullShader -> F.FoldM IO RenderType Int 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 pokeRender' - :: (RenderType -> [[[Float]]]) + :: (RenderType -> [[Float]]) -> Ptr Float -> Int -- ^ stride -> Int @@ -52,12 +51,12 @@ pokeRender' -> IO Int 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) -pokePtrs' :: Ptr Float -> Int -> Int -> [[Float]] -> IO Int -pokePtrs' ptr stride n fss = do - pokeArrayOff ptr (stride * n) (concat fss) +pokePtrs' :: Ptr Float -> Int -> Int -> [Float] -> IO Int +pokePtrs' ptr stride n fs = do + pokeArrayOff ptr (stride * n) fs return $ n + 1 pokeArrayOff :: Storable a => Ptr a -> Int -> [a] -> IO () diff --git a/src/Shader/Compile.hs b/src/Shader/Compile.hs index 4b96131eb..577ff2eb2 100644 --- a/src/Shader/Compile.hs +++ b/src/Shader/Compile.hs @@ -22,19 +22,20 @@ makeShader -> [ShaderType] -- ^ Filetype extensions -> [Int] -- ^ The input vertex sizes -> 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) makeShader s shaderlist sizes pm renStrat = do (prog,unis) <- makeSourcedShader s shaderlist vaob <- setupVAO sizes - return $ FullShader { _shaderProgram = prog - , _shaderMatrixUniform = unis - , _shaderVAO = vaob - , _shaderPokeStrategy = renStrat - , _shaderDrawPrimitive = pm - , _shaderTexture = Nothing - , _shaderCustomUnis = [] - } + return $ FullShader + { _shaderProgram = prog + , _shaderMatrixUniform = unis + , _shaderVAO = vaob + , _shaderPokeStrategy = renStrat + , _shaderDrawPrimitive = pm + , _shaderTexture = Nothing + , _shaderCustomUnis = [] + } -- | Compile shader and get its uniform locations. -- supposes the shader code is in the shader folder, with the string names diff --git a/src/Shader/Data.hs b/src/Shader/Data.hs index 3a9e334f2..ab532b135 100644 --- a/src/Shader/Data.hs +++ b/src/Shader/Data.hs @@ -47,7 +47,7 @@ data FullShader = FullShader { _shaderProgram :: Program , _shaderMatrixUniform :: UniformLocation , _shaderVAO :: VAO - , _shaderPokeStrategy :: RenderType -> [[[Float]]]-- -> F.FoldM IO RenderType Int + , _shaderPokeStrategy :: RenderType -> [[Float]]-- -> F.FoldM IO RenderType Int , _shaderDrawPrimitive :: PrimitiveMode , _shaderTexture :: Maybe ShaderTexture , _shaderCustomUnis :: [UniformLocation]