module Graphics.LambdaCube.RenderSystem.GL.GpuProgram where
import Data.List
import Control.Monad
import Foreign
import Foreign.C.String
import Graphics.Rendering.OpenGL.Raw.Core31
import qualified Graphics.Rendering.OpenGL.Raw.EXT as EXT
import Graphics.LambdaCube.GpuProgram
import Graphics.LambdaCube.HardwareVertexBuffer
getFixedAttributeIndex :: VertexElementSemantic -> Int -> Int
getFixedAttributeIndex semantic index = case semantic of
VES_POSITION -> 0
VES_BLEND_WEIGHTS -> 1
VES_NORMAL -> 2
VES_DIFFUSE -> 3
VES_SPECULAR -> 4
VES_BLEND_INDICES -> 7
VES_TEXTURE_COORDINATES -> 8 + index
VES_TANGENT -> 14
VES_BINORMAL -> 15
isAttributeValid :: VertexElementSemantic -> Int -> Bool
isAttributeValid semantic _ = case semantic of
VES_POSITION -> False
VES_NORMAL -> False
VES_DIFFUSE -> False
VES_SPECULAR -> False
VES_TEXTURE_COORDINATES -> False
VES_BLEND_WEIGHTS -> True
VES_BLEND_INDICES -> True
VES_BINORMAL -> True
VES_TANGENT -> True
data GLGpuProgram
= GLGpuProgram
{ glgpShaderObject :: GLuint
}
deriving (Eq,Ord)
data GLLinkedGpuProgram
= GLLinkedGpuProgram
{ gllgpProgramObject :: GLuint
}
deriving (Eq,Ord)
instance LinkedGpuProgram GLLinkedGpuProgram
instance GpuProgram GLGpuProgram
withGLStringLen :: String -> ((Ptr b, Int) -> IO a) -> IO a
withGLStringLen s act =
withCAStringLen s $ \(p,len) ->
act (castPtr p, fromIntegral len)
setShaderSource :: GLuint -> [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 shader len charBufsBuf lengthsBuf
shaderInfoLog :: GLuint -> IO String
shaderInfoLog a = allocaArray maxLen $ \s -> alloca $ \l -> do
glGetShaderInfoLog a (fromIntegral maxLen) l s
len <- peek l
peekCStringLen (castPtr s, fromIntegral len)
where
maxLen = 256
programInfoLog :: GLuint -> IO String
programInfoLog a = allocaArray maxLen $ \s -> alloca $ \l -> do
glGetProgramInfoLog a (fromIntegral maxLen) l s
len <- peek l
peekCStringLen (castPtr s, fromIntegral len)
where
maxLen = 256
compileShader :: Integral a => a -> String -> IO (Either GLuint [Char])
compileShader ptype src = do
shader <- glCreateShader $ fromIntegral ptype
setShaderSource shader [src]
glCompileShader shader
infoLog <- shaderInfoLog shader
ok <- alloca $ \buf -> glGetShaderiv shader gl_COMPILE_STATUS buf >> peek buf
case ok == fromIntegral gl_TRUE of
False -> do
glDeleteShader shader
return $ Right $ "shader compilation failed: " ++ infoLog
True -> return $ Left shader
mkGLGpuProgram :: GpuProgramType -> String -> IO (Either GLGpuProgram String)
mkGLGpuProgram ptype src = do
let stype = case ptype of
GPT_VERTEX_PROGRAM -> gl_VERTEX_SHADER
GPT_FRAGMENT_PROGRAM -> gl_FRAGMENT_SHADER
GPT_GEOMETRY_PROGRAM -> EXT.gl_GEOMETRY_SHADER
s <- compileShader stype src
case s of
Right m -> return $ Right m
Left sh -> return $ Left $ GLGpuProgram sh
mkGLLinkedGpuProgram :: [GLGpuProgram] -> IO (Either GLLinkedGpuProgram String)
mkGLLinkedGpuProgram pl = do
p <- glCreateProgram
forM_ (map glgpShaderObject pl) $ \sh -> glAttachShader p sh
glLinkProgram p
infoLog <- programInfoLog p
ok <- alloca $ \buf -> glGetProgramiv p gl_LINK_STATUS buf >> peek buf
case ok == fromIntegral gl_TRUE of
False -> do
glDeleteProgram p
return $ Right $ "GpuProgram linking failed: " ++ infoLog
True -> return $ Left $ GLLinkedGpuProgram p