From 90d2ef73e6f7ff6446a50e998e54dfdcb001536e Mon Sep 17 00:00:00 2001 From: nek0 Date: Thu, 21 May 2020 21:04:05 +0200 Subject: [PATCH] Abstract Shaders into own module --- renderer-tutorial.cabal | 1 + src/Main.hs | 98 +++++--------------------------- src/Shader.hs | 123 ++++++++++++++++++++++++++++++++++++++++ 3 files changed, 138 insertions(+), 84 deletions(-) create mode 100644 src/Shader.hs diff --git a/renderer-tutorial.cabal b/renderer-tutorial.cabal index bfe157e..4dddfba 100644 --- a/renderer-tutorial.cabal +++ b/renderer-tutorial.cabal @@ -31,5 +31,6 @@ executable renderer-tutorial , VertexBuffer , VertexArray , IndexBuffer + , Shader hs-source-dirs: src default-language: Haskell2010 diff --git a/src/Main.hs b/src/Main.hs index 55f8fe0..61e22e1 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -36,6 +36,7 @@ import BufferClass import VertexArray import VertexBuffer import IndexBuffer +import Shader main :: IO () main = do @@ -121,21 +122,16 @@ main = do -- -- SHADERS - -- read in shaders from source file - vertSrc <- B.readFile "./res/shaders/vert.shader" - fragSrc <- B.readFile "./res/shaders/frag.shader" - - sp <- createShaderProgram vertSrc fragSrc - GL.currentProgram $= Just sp + sp <- newShader + [ ShaderSource GL.VertexShader "./res/shaders/vert.shader" + , ShaderSource GL.FragmentShader "./res/shaders/frag.shader" + ] + [ "u_color" + ] -- -- UNIFORMS - -- -- get the uniform's location out of the shader program - -- uniLoc <- get $ GL.uniformLocation sp "u_color" - -- -- write data to the uniform - -- GL.uniform uniLoc $= (GL.Color4 1 0.5 0 1 :: GL.Color4 GL.GLfloat) - - -- create an MVar for pulsating red channel + -- create MVars for pulsating red channel red <- newMVar 0 increment <- newMVar 0.05 @@ -149,7 +145,7 @@ main = do GL.bindVertexArrayObject $= Nothing unbind vbo unbind ibo - GL.currentProgram $= Nothing + unbind sp -- -- LOOPING @@ -177,18 +173,17 @@ main = do bind vao -- (note the missing bindings to the vertex buffer and the attrib pointer) bind ibo - GL.currentProgram $= Just sp + bind sp -- throw away previous errors -- void $ get GL.errors - -- get the uniform's location out of the shader program - uniLoc <- get $ GL.uniformLocation sp "u_color" - -- write data to the uniform - redValue <- takeMVar red incrementValue <- takeMVar increment + redValue <- takeMVar red let newRed = redValue + incrementValue - GL.uniform uniLoc $= (GL.Color4 newRed 0.5 0 1 :: GL.Color4 GL.GLfloat) + + -- write data to the uniform + setUniform sp "u_color" (GL.Color4 newRed 0.5 0 1 :: GL.Color4 GL.GLfloat) -- the actual drawing happens here GL.drawElements GL.Triangles 6 GL.UnsignedInt nullPtr @@ -223,68 +218,3 @@ main = do -- This is the end. putStrLn "Bye!" - - ------------------------ Supplemantary functions ------------------------------- - --- | create the actual Shader programs from source -createShaderProgram - :: B.ByteString -- ^ vertex shader source - -> B.ByteString -- ^ fragment shader source - -> IO GL.Program -createShaderProgram vertSrc fragSrc = do - -- create program Object - program <- GL.createProgram - - -- create shaders from the source codes given - vs <- compileShaderSource GL.VertexShader vertSrc - fs <- compileShaderSource GL.FragmentShader fragSrc - - -- attach, link and validate the shader program - GL.attachedShaders program $= [vs, fs] - GL.linkProgram program - GL.validateProgram program - - ok <- get (GL.validateStatus program) - if ok - then - putStrLn "Shaderprogram linked successfully!" - else do - info <- get (GL.programInfoLog program) - putStrLn "Shaderprogram linking failed!\nInfo log says:" - putStrLn info - GL.deleteObjectName program - - -- throw away the shaders, since they are linked into the shader program - mapM_ (\s -> GL.deleteObjectName s) [fs, vs] - - return program - --- | compile a shader from source -compileShaderSource - :: GL.ShaderType -- ^ what type of shader we are compiling - -> B.ByteString -- ^ its source code - -> IO GL.Shader -compileShaderSource type_ source = do - -- create shader object of specified type - shaderObject <- GL.createShader type_ - - -- assign source code to shader object - GL.shaderSourceBS shaderObject $= source - - -- actually compile the shader - GL.compileShader shaderObject - - -- error handling - ok <- GL.compileStatus shaderObject - - if ok - then - putStrLn (show type_ ++ ": compilation successful!") - else do - info <- get (GL.shaderInfoLog shaderObject) - putStrLn (show type_ ++ ": compilation failed!\nInfo log says:") - putStrLn info - GL.deleteObjectName shaderObject - - return shaderObject diff --git a/src/Shader.hs b/src/Shader.hs new file mode 100644 index 0000000..9db7a21 --- /dev/null +++ b/src/Shader.hs @@ -0,0 +1,123 @@ +module Shader where + +import SDL (($=), get) + +import qualified Graphics.Rendering.OpenGL as GL + +import Data.List as L + +import qualified Data.ByteString as B + +-- internal imports + +import BindableClass + +data Shader = Shader + { shaderId :: GL.Program + , shaderSources :: [ShaderSource] + , shaderUniforms :: [ShaderUniform] + } + +-- make Shader Bindable +instance Bindable Shader where + + bind s = GL.currentProgram $= Just (shaderId s) + + unbind _ = GL.currentProgram $= Nothing + +data ShaderSource = ShaderSource + { shaderSourceType :: GL.ShaderType + , shaderPath :: FilePath + } + +data ShaderUniform = ShaderUniform + { shaderUniformName :: String + , shaderUniformLocation :: GL.UniformLocation + } + +-- cerate new data object of type Shader +newShader :: [ShaderSource] -> [String] -> IO Shader +newShader shaderSrc uniforms = do + -- create program Object + program <- GL.createProgram + + -- create shaders from the source codes given + compilates <- mapM + (\(ShaderSource type_ path) -> do + -- read in shader source from File + source<- B.readFile path + + -- compile the shader + compiledShader <- compileShaderSource type_ source + return (type_, compiledShader) + ) + shaderSrc + + -- attach, link and validate the shader program + GL.attachedShaders program $= map snd compilates + GL.linkProgram program + GL.validateProgram program + + ok <- get (GL.validateStatus program) + if ok + then + putStrLn "Shaderprogram linked successfully!" + else do + info <- get (GL.programInfoLog program) + putStrLn "Shaderprogram linking failed!\nInfo log says:" + putStrLn info + GL.deleteObjectName program + + -- throw away the shaders, since they are linked into the shader program + mapM_ (\s -> GL.deleteObjectName s) (map snd compilates) + + -- retrieve locations of all uniforms and store them + uniLocs <- mapM + (\name -> do + loc <- get $ GL.uniformLocation program name + return (ShaderUniform name loc) + ) + uniforms + + -- return data object + return (Shader program shaderSrc uniLocs) + +-- pass uniform values into Shader program +setUniform :: (GL.Uniform a) => Shader -> String -> a -> IO () +setUniform shader uniname data_ = do + -- retrieve uniform location + let [ShaderUniform _ loc] = filter + (\(ShaderUniform name _) -> name == uniname) + (shaderUniforms shader) + + -- set the data + GL.uniform loc $= data_ + +-- | compile a shader from source +compileShaderSource + :: GL.ShaderType -- ^ what type of shader we are compiling + -> B.ByteString -- ^ its source code + -> IO GL.Shader +compileShaderSource type_ source = do + -- create shader object of specified type + shaderObject <- GL.createShader type_ + + -- assign source code to shader object + GL.shaderSourceBS shaderObject $= source + + -- actually compile the shader + GL.compileShader shaderObject + + -- error handling + ok <- GL.compileStatus shaderObject + + if ok + then + putStrLn (show type_ ++ ": compilation successful!") + else do + info <- get (GL.shaderInfoLog shaderObject) + putStrLn (show type_ ++ ": compilation failed!\nInfo log says:") + putStrLn info + GL.deleteObjectName shaderObject + + return shaderObject