Abstract Shaders into own module

This commit is contained in:
nek0 2020-05-21 21:04:05 +02:00
parent c2014e41c5
commit 90d2ef73e6
3 changed files with 138 additions and 84 deletions

View File

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

View File

@ -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

123
src/Shader.hs Normal file
View File

@ -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