376 lines
12 KiB
Haskell
376 lines
12 KiB
Haskell
module Shader.Compile (
|
|
setupVBO,
|
|
setupVBOStatic,
|
|
makeShaderEBO,
|
|
makeShaderVBO,
|
|
makeShaderUsingVBO,
|
|
makeByteStringShaderUsingVAO,
|
|
makeShaderFixedVertices,
|
|
makeShaderUsingVAO,
|
|
setupVAOUsingVBO,
|
|
setupVAOvbo,
|
|
setupEBO,
|
|
setupVertexAttribPointer,
|
|
makeSourcedShader,
|
|
toFloatVAs,
|
|
setupStaticVBOVAO
|
|
) where
|
|
|
|
import Foreign.C.Types
|
|
import Graphics.GL.Types
|
|
import Control.Lens
|
|
import Control.Monad
|
|
import qualified Data.ByteString as BS
|
|
import qualified Data.ByteString.Unsafe as BU
|
|
import Foreign
|
|
import Foreign.C.String
|
|
import GLHelp
|
|
import Graphics.GL.Core45
|
|
import Shader.Data
|
|
import Shader.Parameters
|
|
|
|
--import Graphics.GL.Core45
|
|
|
|
{- |
|
|
Compiles a full shader found within the shader directory.
|
|
The shader is made up of files begining with the inputted string with extensions .vert, .geom etc.
|
|
-}
|
|
makeShaderVBO ::
|
|
-- | First part of the name of the shader
|
|
String ->
|
|
-- | shader types
|
|
[GLenum] ->
|
|
-- | The input vertex sizes
|
|
[Int] ->
|
|
PrimitiveMode ->
|
|
IO (Shader, VBO)
|
|
makeShaderVBO s shaderlist sizes pm = do
|
|
prog <- makeSourcedShader s shaderlist
|
|
(vao, vbo) <- setupVBOVAO sizes
|
|
return
|
|
( Shader
|
|
{ _shaderUINT = prog
|
|
, _shaderVAO = vao
|
|
, _shaderPrimitive = pm
|
|
}
|
|
, vbo
|
|
)
|
|
|
|
makeShaderEBO ::
|
|
-- | First part of the name of the shader
|
|
String ->
|
|
-- | shader types
|
|
[GLenum] ->
|
|
-- | The input vertex sizes
|
|
[Int] ->
|
|
PrimitiveMode ->
|
|
VBO ->
|
|
IO (Shader, EBO)
|
|
makeShaderEBO s shaderlist sizes pm vbo = do
|
|
shad <- makeShaderUsingVBO s shaderlist (toFloatVAs sizes) pm vbo
|
|
ebo <- setupEBO (shad ^. shaderVAO)
|
|
glVertexArrayElementBuffer (shad ^. shaderVAO . vaoName) (ebo ^. eboName)
|
|
return
|
|
( shad
|
|
, ebo
|
|
)
|
|
|
|
makeShaderUsingVBO ::
|
|
-- | First part of the name of the shader
|
|
String ->
|
|
-- | shader types
|
|
[GLenum] ->
|
|
-- | The input vertex sizes
|
|
[VertexAttribute] ->
|
|
PrimitiveMode ->
|
|
VBO ->
|
|
IO Shader
|
|
makeShaderUsingVBO s shaderlist sizes pm vbo = do
|
|
vao <- setupVAOUsingVBO sizes vbo
|
|
makeShaderUsingVAO s shaderlist pm vao
|
|
|
|
setupVBO :: Int -> IO VBO
|
|
setupVBO vertexsize = do
|
|
vboname <- mglCreate glCreateBuffers
|
|
thePtr <- mallocArray (vertexsize * numDrawableElements)
|
|
-- Allocate space
|
|
glNamedBufferData
|
|
vboname
|
|
(fromIntegral $ floatSize * numDrawableElements * vertexsize)
|
|
nullPtr
|
|
GL_STREAM_DRAW
|
|
return VBO{_vboName = vboname, _vboPtr = thePtr, _vboVertexBytes = floatSize * vertexsize}
|
|
|
|
-- the input ptr is assumed to contain the correct amount of data according to
|
|
-- the specified number and type of vertices
|
|
-- note the VBO here does not have a sensible ptr value
|
|
setupStaticVBOVAO :: Storable a => [VertexAttribute] -> [a] -> IO (VBO,VAO)
|
|
setupStaticVBOVAO vas vdata = withArrayLen vdata $ \i ptr -> do
|
|
vboname <- mglCreate glCreateBuffers
|
|
glNamedBufferStorage
|
|
vboname
|
|
(CPtrdiff (fromIntegral (i * sizeOf (head vdata))))
|
|
ptr
|
|
0
|
|
let vbo = VBO
|
|
{ _vboName = vboname
|
|
, _vboPtr = nullPtr
|
|
, _vboVertexBytes = vasTightStride vas
|
|
}
|
|
vao <- setupVAOUsingVBO vas vbo
|
|
return (vbo,vao)
|
|
|
|
|
|
|
|
setupVBOStatic :: Int -> IO VBO
|
|
setupVBOStatic vertexsize = do
|
|
vboname <- mglCreate glCreateBuffers
|
|
thePtr <- mallocArray (vertexsize * numDrawableElements)
|
|
-- Allocate space
|
|
glNamedBufferData
|
|
vboname
|
|
(fromIntegral $ floatSize * numDrawableElements * vertexsize)
|
|
nullPtr
|
|
GL_STATIC_DRAW
|
|
return VBO{_vboName = vboname, _vboPtr = thePtr, _vboVertexBytes = floatSize * vertexsize}
|
|
|
|
makeByteStringShaderUsingVAO ::
|
|
-- | (Arbitrary) name of the shader
|
|
String ->
|
|
-- | Filetype extensions and shader data
|
|
[(GLenum, BS.ByteString)] ->
|
|
PrimitiveMode ->
|
|
VAO ->
|
|
IO Shader
|
|
makeByteStringShaderUsingVAO s shaderlist pm vao = do
|
|
prog <- makeShaderProgram s shaderlist
|
|
return
|
|
Shader
|
|
{ _shaderUINT = prog
|
|
, _shaderVAO = vao
|
|
, _shaderPrimitive = pm
|
|
}
|
|
|
|
-- | Takes the VAO from elsewhere
|
|
makeShaderUsingVAO ::
|
|
-- | First part of the name of the shader
|
|
String ->
|
|
-- | shader types
|
|
[GLenum] ->
|
|
PrimitiveMode ->
|
|
VAO ->
|
|
IO Shader
|
|
makeShaderUsingVAO s shaderlist pm theVAO = do
|
|
prog <- makeSourcedShader s shaderlist
|
|
return
|
|
Shader
|
|
{ _shaderUINT = prog
|
|
, _shaderVAO = theVAO
|
|
, _shaderPrimitive = pm
|
|
}
|
|
|
|
-- this should be changed to some FIXED STORAGE SHADER
|
|
-- I cannot think of any other reason to have it
|
|
{- |
|
|
Compiles a full shader found within the shader directory.
|
|
The shader is made up of files begining with the inputted string with extensions .vert, .geom etc.
|
|
-}
|
|
makeShaderFixedVertices ::
|
|
-- | First part of the name of the shader
|
|
String ->
|
|
-- | shader types
|
|
[GLenum] ->
|
|
-- | The input vertex sizes
|
|
[Int] ->
|
|
-- | Number of vertexes that can be poked
|
|
Int ->
|
|
PrimitiveMode ->
|
|
IO (Shader, VBO)
|
|
makeShaderFixedVertices s shaderlist sizes ndraw pm = do
|
|
prog <- makeSourcedShader s shaderlist
|
|
(vao, vbo) <- setupVBOVAO sizes
|
|
return
|
|
( Shader
|
|
{ _shaderUINT = prog
|
|
, _shaderVAO = vao
|
|
, _shaderPrimitive = pm
|
|
}
|
|
, vbo
|
|
)
|
|
|
|
{- | Compile shader and get its uniform locations.
|
|
supposes the shader code is in the shader folder, with the string names
|
|
followed by .vert/.geom/.frag.
|
|
-}
|
|
makeSourcedShader :: String -> [GLenum] -> IO GLuint
|
|
makeSourcedShader s sts = do
|
|
sources <- forM sts $ \st -> BS.readFile ("shader/" ++ s ++ shaderTypeExt st)
|
|
makeShaderProgram s $ zip sts sources
|
|
|
|
shaderTypeExt :: GLenum -> String
|
|
shaderTypeExt GL_VERTEX_SHADER = ".vert"
|
|
shaderTypeExt GL_GEOMETRY_SHADER = ".geom"
|
|
shaderTypeExt GL_FRAGMENT_SHADER = ".frag"
|
|
shaderTypeExt GL_COMPUTE_SHADER = ".comp"
|
|
shaderTypeExt _ = undefined
|
|
|
|
setupVAOvbo :: [VertexAttribute] -> Int -> GLuint -> IO VAO
|
|
setupVAOvbo sizes strd vbo = do
|
|
vaoname <- mglCreate glCreateVertexArrays
|
|
glBindVertexArray vaoname
|
|
setupVertexAttribs vbo vaoname sizes (fromIntegral strd * fromIntegral floatSize)
|
|
return $
|
|
VAO
|
|
{ _vaoName = vaoname
|
|
}
|
|
|
|
setupVAOUsingVBO :: [VertexAttribute] -> VBO -> IO VAO
|
|
setupVAOUsingVBO vas vbo = do
|
|
let strd = vbo ^. vboVertexBytes
|
|
vaoname <- mglCreate glCreateVertexArrays
|
|
glBindVertexArray vaoname
|
|
setupVertexAttribs (vbo ^. vboName) vaoname vas
|
|
(fromIntegral strd)
|
|
return VAO{_vaoName = vaoname}
|
|
|
|
setupEBO :: VAO -> IO EBO
|
|
setupEBO vao = do
|
|
eboptr <- mallocArray numDrawableElements
|
|
eboname <- mglCreate glCreateBuffers
|
|
glNamedBufferData
|
|
eboname
|
|
(fromIntegral $ glushortSize * numDrawableElements)
|
|
nullPtr
|
|
GL_STREAM_DRAW
|
|
glVertexArrayElementBuffer (vao ^. vaoName) eboname
|
|
return $ EBO eboname eboptr
|
|
|
|
setupVBOVAO :: [Int] -> IO (VAO, VBO)
|
|
setupVBOVAO sizes = do
|
|
vaoname <- mglCreate glCreateVertexArrays
|
|
glBindVertexArray vaoname
|
|
vbo <- setupVBO (sum sizes)
|
|
--vao <- setupVAOvbo (toFloatVAs sizes) (sum sizes) (vbo ^. vboName)
|
|
vao <- setupVAOUsingVBO (toFloatVAs sizes) vbo
|
|
return (vao,vbo)
|
|
where
|
|
vas = toFloatVAs sizes
|
|
strd = vasTightStride vas
|
|
|
|
toFloatVAs :: [Int] -> [VertexAttribute]
|
|
toFloatVAs = go 0
|
|
where
|
|
go _ [] = []
|
|
go x (i:is) = VertexAttribute (fromIntegral i) GL_FLOAT GL_FALSE x
|
|
: go (x + fromIntegral floatSize*fromIntegral i) is
|
|
|
|
setupVertexAttribs :: GLuint -> GLuint -> [VertexAttribute] -> GLsizei -> IO ()
|
|
setupVertexAttribs vbo vao vas strd = do
|
|
glVertexArrayVertexBuffer vao 0 vbo 0 strd
|
|
zipWithM_ (setupVertexAttribPointer vao) [0..] vas
|
|
|
|
-- | Assumes the correct VBO is bound
|
|
setupVertexAttribPointer ::
|
|
GLuint ->
|
|
-- | Location (in shader)
|
|
Int ->
|
|
VertexAttribute ->
|
|
IO ()
|
|
setupVertexAttribPointer vao loc va = do
|
|
glEnableVertexArrayAttrib vao loc'
|
|
glVertexArrayAttribFormat vao loc'
|
|
(va ^. vaCount)
|
|
(va ^. vaType)
|
|
(va ^. vaNormalize)
|
|
(va ^. vaOffset)
|
|
glVertexArrayAttribBinding vao loc' 0
|
|
where
|
|
loc' = fromIntegral loc
|
|
|
|
makeShaderProgram ::
|
|
String ->
|
|
[(GLenum, BS.ByteString)] -> -- list of shaders
|
|
IO GLuint
|
|
makeShaderProgram str srcs = do
|
|
theprog <- glCreateProgram
|
|
shaders <- mapM (compileAndCheckShader str) srcs
|
|
mapM_ (glAttachShader theprog) shaders
|
|
glLinkProgram theprog
|
|
checkErrorGL (str ++ " linking ") glGetProgramiv glGetProgramInfoLog theprog GL_LINK_STATUS
|
|
mapM_ (glDetachShader theprog) shaders
|
|
mapM_ glDeleteShader shaders
|
|
return theprog
|
|
|
|
checkErrorGL ::
|
|
(Storable t1) =>
|
|
[Char] ->
|
|
(t2 -> GLenum -> Ptr t1 -> IO ()) ->
|
|
(t2 -> t1 -> Ptr a3 -> CString -> IO ()) ->
|
|
t2 ->
|
|
GLenum ->
|
|
IO ()
|
|
checkErrorGL str f g x statustype =
|
|
alloca $ \statusPtr -> do
|
|
f x statustype statusPtr
|
|
status <- peek $ castPtr statusPtr
|
|
when (status == GL_FALSE) $
|
|
alloca $ \ptr -> do
|
|
f x GL_INFO_LOG_LENGTH ptr
|
|
len <- peek ptr -- we may have to use this length more intelligently
|
|
alloca $ \charPtr -> do
|
|
g x len nullPtr charPtr
|
|
char <- peekCString charPtr
|
|
error $ str ++ show char
|
|
|
|
-- use glCreateShaderProgramv here
|
|
compileAndCheckShader :: String -> (GLenum, BS.ByteString) -> IO GLuint
|
|
compileAndCheckShader str (theShaderType, sourceCode) = do
|
|
theShader <- glCreateShader theShaderType
|
|
setShaderSource theShader sourceCode
|
|
glCompileShader theShader
|
|
checkErrorGL
|
|
(str ++ shaderTypeExt theShaderType)
|
|
glGetShaderiv
|
|
glGetShaderInfoLog
|
|
theShader
|
|
GL_COMPILE_STATUS
|
|
return theShader
|
|
|
|
setShaderSource :: GLuint -> BS.ByteString -> IO ()
|
|
setShaderSource si src =
|
|
withByteString src $ \srcPtr srcLength ->
|
|
with srcPtr $ \srcPtrBuf ->
|
|
with srcLength $ \srcLengthBuf ->
|
|
glShaderSource si 1 srcPtrBuf srcLengthBuf
|
|
|
|
vasTightStride :: [VertexAttribute] -> Int
|
|
vasTightStride = go 0
|
|
where
|
|
go x [] = x
|
|
go x (v:vs)
|
|
| x /= fromIntegral (v ^. vaOffset) = error "vasTightStride: vertex offset incorrect"
|
|
| otherwise = go (x + fromIntegral (v ^. vaCount * fromIntegral (attribSize (v ^. vaType))))
|
|
vs
|
|
|
|
attribSize :: GLenum -> Int
|
|
attribSize x = case x of
|
|
GL_BYTE -> sizeOf (0 :: GLbyte )
|
|
GL_SHORT -> sizeOf (0 :: GLshort)
|
|
GL_INT -> sizeOf (0 :: GLint)
|
|
GL_FIXED -> sizeOf (0 :: GLfixed)
|
|
GL_FLOAT -> sizeOf (0 :: GLfloat)
|
|
GL_HALF_FLOAT -> sizeOf (0 :: GLhalf)
|
|
GL_DOUBLE -> sizeOf (0 :: GLdouble)
|
|
GL_UNSIGNED_BYTE -> sizeOf (0 :: GLubyte)
|
|
GL_UNSIGNED_SHORT -> sizeOf (0 :: GLushort)
|
|
GL_UNSIGNED_INT -> sizeOf (0 :: GLuint)
|
|
-- GL_INT_2_10_10_10_REV -> sizeOf (0 :: GL_INT_2_10_10_10_REV)
|
|
-- GL_UNSIGNED_INT_2_10_10_10_REV -> sizeOf (0 :: GL_UNSIGNED_INT_2_10_10_10_REV)
|
|
-- GL_UNSIGNED_INT_10F_11F_11F_REV -> sizeOf (0 :: GL_UNSIGNED_INT_10F_11F_11F_REV)
|
|
|
|
-- https://hackage.haskell.org/package/OpenGL-3.0.3.0/docs/src/Graphics.Rendering.OpenGL.GL.ByteString.html#withByteStringP
|
|
withByteString :: Num t => BS.ByteString -> (Ptr b -> t -> IO a) -> IO a
|
|
withByteString bs act =
|
|
BU.unsafeUseAsCStringLen bs $ \(ptr, size) ->
|
|
act (castPtr ptr) (fromIntegral size)
|