diff --git a/src/Framebuffer/Update.hs b/src/Framebuffer/Update.hs index ae8ab3932..e5a73cfa5 100644 --- a/src/Framebuffer/Update.hs +++ b/src/Framebuffer/Update.hs @@ -81,18 +81,18 @@ resizeShadowFBO (fboname,(oldto1,oldto2)) xsize ysize = do deleteObjectName oldto2 to1 <- genObjectName to2 <- genObjectName --- textureBinding Texture2DArray $= Just to1 --- glTexStorage3D GL_TEXTURE_2D_ARRAY 1 GL_RGBA8 xsize' ysize' 10 --- textureFilter Texture2DArray $= minMagFilter --- glFramebufferTexture GL_FRAMEBUFFER GL_COLOR_ATTACHMENT0 (unTexture to1) 0 --- textureBinding Texture2DArray $= Just to2 --- glTexStorage3D GL_TEXTURE_2D_ARRAY 1 GL_DEPTH24_STENCIL8 xsize' ysize' 10 --- textureFilter Texture2DArray $= minMagFilter --- glFramebufferTexture GL_FRAMEBUFFER GL_DEPTH_STENCIL_ATTACHMENT (unTexture to2) 0 --- fboStatus <- framebufferStatus Framebuffer --- case fboStatus of --- Complete -> return () --- _ -> error $ "after resize, resizeFBOTO2 framebuffer status:" ++ show fboStatus + textureBinding Texture2DArray $= Just to1 + glTexStorage3D GL_TEXTURE_2D_ARRAY 1 GL_RGBA8 xsize' ysize' 10 + textureFilter Texture2DArray $= minMagFilter + glFramebufferTexture GL_FRAMEBUFFER GL_COLOR_ATTACHMENT0 (unTexture to1) 0 + textureBinding Texture2DArray $= Just to2 + glTexStorage3D GL_TEXTURE_2D_ARRAY 1 GL_DEPTH24_STENCIL8 xsize' ysize' 10 + textureFilter Texture2DArray $= minMagFilter + glFramebufferTexture GL_FRAMEBUFFER GL_DEPTH_STENCIL_ATTACHMENT (unTexture to2) 0 + fboStatus <- framebufferStatus Framebuffer + case fboStatus of + Complete -> return () + _ -> error $ "after resize, resizeFBOTO2 framebuffer status:" ++ show fboStatus return (fboname,(to1,to2)) unTexture :: TextureObject -> GLuint diff --git a/src/Shader.hs b/src/Shader.hs index 8c230d26d..d926819d0 100644 --- a/src/Shader.hs +++ b/src/Shader.hs @@ -43,7 +43,6 @@ drawShader fs i = do case _shadTex fs of Just ShaderTexture{_textureObject = TextureObject txo , _textureTarget = tt } --- -> textureBinding Texture2D $= Just txo -> glBindTexture tt txo _ -> return () glDrawArrays diff --git a/src/Shader/Compile.hs b/src/Shader/Compile.hs index 9df1bc3bb..e42dd105a 100644 --- a/src/Shader/Compile.hs +++ b/src/Shader/Compile.hs @@ -14,9 +14,11 @@ import Shader.Parameters import Foreign import qualified Data.ByteString as BS +import qualified Data.ByteString.Unsafe as BU import Control.Monad --import Control.Lens import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight) +import Graphics.GL.Core43 {- | Compiles a full shader found within the shader directory. The shader is made up of files begining with the inputted string with extensions .vert, .geom etc. @@ -37,6 +39,24 @@ makeShader s shaderlist sizes pm = do , _shadTex = Nothing , _shadUnis = mempty } + +makeByteStringShader' + :: String -- ^ (Arbitrary) name of the shader + -> [(GLenum,BS.ByteString)] -- ^ Filetype extensions and shader data + -> [Int] -- ^ The input vertex sizes + -> EPrimitiveMode + -> IO FullShader' +makeByteStringShader' s shaderlist sizes pm = do + prog <- makeShaderProgram' s shaderlist + vaob <- setupVAO sizes + return $ FullShader' + { _shadProg' = prog + , _shadVAO' = vaob + , _shadPrim' = pm + , _shadTex' = Nothing + , _shadUnis' = mempty + } + makeByteStringShader :: String -- ^ (Arbitrary) name of the shader -> [(ShaderType,BS.ByteString)] -- ^ Filetype extensions and shader data @@ -136,6 +156,7 @@ shaderTypeExt GeometryShader = ".geom" shaderTypeExt FragmentShader = ".frag" shaderTypeExt _ = undefined +-- I think that this requires that the correct shader program is bound... setupVAO :: [Int] -> IO VAO setupVAO sizes = do theVAO <- genObjectName @@ -217,6 +238,33 @@ setupVertexAttribPointer loc siz strd off = do fi' = fromIntegral fi'' = fromIntegral +makeShaderProgram' :: String + -> [(GLenum,BS.ByteString)] -- list of shaders + -> IO GLuint +makeShaderProgram' str srcs = do + theprog <- glCreateProgram + shaders <- mapM (compileAndCheckShader' str) srcs + glLinkProgram theprog + glCheckError str glGetProgramiv glGetProgramInfoLog theprog GL_LINK_STATUS + mapM (glDetachShader theprog) shaders + mapM glDeleteShader shaders + return theprog + +glCheckError str f g x statustype = + alloca $ \statusPtr -> do + f x statustype statusPtr + status <- peek $ castPtr statusPtr + if status == GL_FALSE + then do + alloca $ \ptr -> do + f x GL_INFO_LOG_LENGTH ptr + len <- peek ptr -- we may have to use this length more intelligently + alloca $ \charPtr -> do + g x len nullPtr charPtr + char <- peek charPtr + error $ str ++ show char + else return () + makeShaderProgram :: String -> [(ShaderType,BS.ByteString)] -> IO Program makeShaderProgram str sources = do theShaderProgram <- createProgram @@ -241,5 +289,25 @@ compileAndCheckShader str (theShaderType,sourceCode) = do putStrLn $ str ++ ": Shader compile: " ++ show theShaderType ++ " :\n" ++ infoLog return theShader +compileAndCheckShader' :: String -> (GLenum,BS.ByteString) -> IO GLuint +compileAndCheckShader' str (theShaderType,sourceCode) = do + theShader <- glCreateShader theShaderType + setShaderSource theShader sourceCode + glCompileShader theShader + glCheckError str glGetShaderiv glGetShaderInfoLog theShader GL_COMPILE_STATUS + return theShader + +setShaderSource :: GLuint -> BS.ByteString -> IO () +setShaderSource si src = + withByteString src $ \srcPtr srcLength -> + with srcPtr $ \srcPtrBuf -> + with srcLength $ \srcLengthBuf -> + glShaderSource si 1 srcPtrBuf srcLengthBuf + +-- https://hackage.haskell.org/package/OpenGL-3.0.3.0/docs/src/Graphics.Rendering.OpenGL.GL.ByteString.html#withByteStringP +withByteString bs act = + BU.unsafeUseAsCStringLen bs $ \(ptr, size) -> + act (castPtr ptr) (fromIntegral size) + bufferOffset :: Integral a => a -> Ptr b bufferOffset = plusPtr nullPtr . (* floatSize) . fromIntegral diff --git a/src/Shader/Data.hs b/src/Shader/Data.hs index b81962e56..6201b73c9 100644 --- a/src/Shader/Data.hs +++ b/src/Shader/Data.hs @@ -6,6 +6,7 @@ module Shader.Data , VBO (..) , EBO (..) , FullShader (..) + , FullShader' (..) , ShaderTexture (..) , EPrimitiveMode (..) -- | Lens functions @@ -22,6 +23,12 @@ module Shader.Data , vboStride , ebo , eboPtr + + , shadProg' + , shadVAO' + , shadPrim' + , shadTex' + , shadUnis' -- | Synonyms , vert , geom @@ -39,6 +46,13 @@ data FullShader = FullShader , _shadTex :: Maybe ShaderTexture , _shadUnis :: Vector UniformLocation } +data FullShader' = FullShader' + { _shadProg' :: GLuint + , _shadVAO' :: VAO + , _shadPrim' :: EPrimitiveMode + , _shadTex' :: Maybe ShaderTexture + , _shadUnis' :: Vector UniformLocation + } {- | Vertex array object: contains the reference to the object, and its buffer targets. -} data VAO = VAO @@ -85,4 +99,5 @@ frag = FragmentShader makeLenses ''VAO makeLenses ''VBO makeLenses ''FullShader +makeLenses ''FullShader' makeLenses ''EBO