Abstract Shaders into own module

renderer-tutorial.cabal

@@ -31,5 +31,6 @@ executable renderer-tutorial
                      , VertexBuffer
                      , VertexArray
                      , IndexBuffer
+                     , Shader
   hs-source-dirs:      src
   default-language:    Haskell2010

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

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