module Graphics.Rendering.OpenGL.GL.Shaders.Shaders (
Shader(..), VertexShader(..), FragmentShader(..), shaderDeleteStatus, shaderSource,
compileShader, compileStatus, shaderInfoLog,
shaderTypeEnum
) where
import Control.Monad
import Control.Monad.Fix
import Data.List
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Marshal.Utils
import Graphics.Rendering.OpenGL.GL.ObjectName
import Graphics.Rendering.OpenGL.GL.StateVar
import Graphics.Rendering.OpenGL.GL.GLboolean
import Graphics.Rendering.OpenGL.GL.GLstring
import Graphics.Rendering.OpenGL.GL.PeekPoke
import Graphics.Rendering.OpenGL.Raw.Core31
newtype VertexShader = VertexShader { vertexShaderID :: GLuint }
deriving ( Eq, Ord, Show )
newtype FragmentShader = FragmentShader { fragmentShaderID :: GLuint }
deriving ( Eq, Ord, Show )
class (Eq s, Ord s, Show s, ObjectName s) => Shader s where
shaderID :: s -> GLuint
makeShader :: GLuint -> s
shaderType :: s -> GLenum
instance Shader VertexShader where
makeShader = VertexShader
shaderID = vertexShaderID
shaderType = const gl_VERTEX_SHADER
instance Shader FragmentShader where
makeShader = FragmentShader
shaderID = fragmentShaderID
shaderType = const gl_FRAGMENT_SHADER
instance ObjectName VertexShader where
genObjectNames = genShaderNames
deleteObjectNames = deleteShaderNames
isObjectName = isShaderName
instance ObjectName FragmentShader where
genObjectNames = genShaderNames
deleteObjectNames = deleteShaderNames
isObjectName = isShaderName
genShaderNames :: Shader s => Int -> IO [s]
genShaderNames n = replicateM n createShader
createShader :: Shader s => IO s
createShader = mfix (fmap makeShader . glCreateShader . shaderType)
deleteShaderNames :: Shader s => [s] -> IO ()
deleteShaderNames = mapM_ (glDeleteShader . shaderID)
isShaderName :: Shader s => s -> IO Bool
isShaderName = fmap unmarshalGLboolean . glIsShader . shaderID
compileShader :: Shader s => s -> IO ()
compileShader = glCompileShader . shaderID
shaderSource :: Shader s => s -> StateVar [String]
shaderSource shader =
makeStateVar (getShaderSource shader) (setShaderSource shader)
setShaderSource :: Shader s => s -> [String] -> IO ()
setShaderSource shader srcs = do
let len = genericLength srcs
withMany withGLStringLen srcs $ \charBufsAndLengths -> do
let (charBufs, lengths) = unzip charBufsAndLengths
withArray charBufs $ \charBufsBuf ->
withArray (map fromIntegral lengths) $ \lengthsBuf ->
glShaderSource (shaderID shader) len charBufsBuf lengthsBuf
getShaderSource :: Shader s => s -> IO [String]
getShaderSource shader = do
src <- get (stringQuery (shaderSourceLength shader)
(glGetShaderSource (shaderID shader)))
return [src]
shaderInfoLog :: Shader s => s -> GettableStateVar String
shaderInfoLog shader =
stringQuery (shaderInfoLogLength shader) (glGetShaderInfoLog (shaderID shader))
shaderDeleteStatus :: Shader s => s -> GettableStateVar Bool
shaderDeleteStatus = shaderVar unmarshalGLboolean ShaderDeleteStatus
compileStatus :: Shader s => s -> GettableStateVar Bool
compileStatus = shaderVar unmarshalGLboolean CompileStatus
shaderInfoLogLength :: Shader s => s -> GettableStateVar GLsizei
shaderInfoLogLength = shaderVar fromIntegral ShaderInfoLogLength
shaderSourceLength :: Shader s => s -> GettableStateVar GLsizei
shaderSourceLength = shaderVar fromIntegral ShaderSourceLength
shaderTypeEnum :: Shader s => s -> GettableStateVar GLenum
shaderTypeEnum = shaderVar fromIntegral ShaderType
data GetShaderPName =
ShaderDeleteStatus
| CompileStatus
| ShaderInfoLogLength
| ShaderSourceLength
| ShaderType
marshalGetShaderPName :: GetShaderPName -> GLenum
marshalGetShaderPName x = case x of
ShaderDeleteStatus -> gl_DELETE_STATUS
CompileStatus -> gl_COMPILE_STATUS
ShaderInfoLogLength -> gl_INFO_LOG_LENGTH
ShaderSourceLength -> gl_SHADER_SOURCE_LENGTH
ShaderType -> gl_SHADER_TYPE
shaderVar :: Shader s => (GLint -> a) -> GetShaderPName -> s -> GettableStateVar a
shaderVar f p shader =
makeGettableStateVar $
alloca $ \buf -> do
glGetShaderiv (shaderID shader) (marshalGetShaderPName p) buf
peek1 f buf