124 lines
3.1 KiB
Haskell
124 lines
3.1 KiB
Haskell
|
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
|