renderer-tutorial/src/Shader.hs

124 lines
3.1 KiB
Haskell
Raw Normal View History

2020-05-21 19:04:05 +00:00
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