128 lines
4.1 KiB
Haskell
128 lines
4.1 KiB
Haskell
module Shader.Compile
|
|
( makeShader
|
|
, makeSourcedShader
|
|
, setupVAO
|
|
) where
|
|
import Shader.Data
|
|
import Shader.Parameters
|
|
import Picture.Data
|
|
|
|
import Foreign
|
|
import qualified Data.ByteString as BS
|
|
import Control.Monad
|
|
--import Control.Lens
|
|
import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
|
|
|
|
{- |
|
|
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.
|
|
-}
|
|
makeShader
|
|
:: String -- ^ First part of the name of the shader
|
|
-> [ShaderType] -- ^ Filetype extensions
|
|
-> [Int] -- ^ The input vertex sizes
|
|
-> PrimitiveMode
|
|
-> (RenderType -> [[Float]]) -- ^ Poke strategy: method for creating a list of vertex data to be bound
|
|
-> IO FullShader
|
|
makeShader s shaderlist sizes pm renStrat = do
|
|
prog <- makeSourcedShader s shaderlist
|
|
vaob <- setupVAO sizes
|
|
return $ FullShader
|
|
{ _shaderProgram = prog
|
|
, _shaderVAO = vaob
|
|
, _shaderPokeStrategy = renStrat
|
|
, _shaderDrawPrimitive = pm
|
|
, _shaderTexture = Nothing
|
|
, _shaderCustomUnis = []
|
|
}
|
|
|
|
-- | 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 -> [ShaderType] -> IO Program
|
|
makeSourcedShader s sts = do
|
|
sources <- forM sts $ \st -> BS.readFile ("shader/" ++ s ++ shaderTypeExt st)
|
|
makeShaderProgram s $ zip sts sources
|
|
|
|
shaderTypeExt :: ShaderType -> String
|
|
shaderTypeExt VertexShader = ".vert"
|
|
shaderTypeExt GeometryShader = ".geom"
|
|
shaderTypeExt FragmentShader = ".frag"
|
|
shaderTypeExt _ = undefined
|
|
|
|
setupVAO :: [Int] -> IO VAO
|
|
setupVAO sizes = do
|
|
theVAO <- genObjectName
|
|
bindVertexArrayObject $= Just theVAO
|
|
theVBO <- setupVBO sizes
|
|
return $ VAO
|
|
{ _vao = theVAO
|
|
, _vaoVBO = theVBO
|
|
}
|
|
|
|
setupVBO :: [Int] -> IO VBO
|
|
setupVBO sizes = do
|
|
vboName <- genObjectName
|
|
bindBuffer ArrayBuffer $= Just vboName
|
|
forM_ (zip3 [0..] sizes offs) $ \(loc,siz,off) -> do
|
|
setupVertexAttribPointer loc siz strd off
|
|
thePtr <- mallocArray (strd * numDrawableElements)
|
|
-- Allocate space
|
|
bufferData ArrayBuffer $=
|
|
(fromIntegral $ floatSize * numDrawableElements * strd
|
|
, nullPtr
|
|
, DynamicDraw
|
|
)
|
|
return $ VBO
|
|
{ _vbo = vboName
|
|
, _vboPointer = thePtr
|
|
, _vboAttribSizes = sizes
|
|
}
|
|
where
|
|
strd = sum sizes
|
|
offs = scanl (+) 0 sizes
|
|
|
|
{- | Assumes the correct VBO is bound -}
|
|
setupVertexAttribPointer
|
|
:: Int -- ^ Atrib location
|
|
-> Int -- ^ Size
|
|
-> Int -- ^ Stride
|
|
-> Int -- ^ Offset
|
|
-> IO ()
|
|
setupVertexAttribPointer loc siz strd off = do
|
|
vertexAttribPointer (AttribLocation (fi loc)) $=
|
|
(ToFloat, VertexArrayDescriptor (fi' siz) Float (fi'' $ floatSize * strd) (bufferOffset off))
|
|
vertexAttribArray (AttribLocation (fi loc)) $= Enabled
|
|
where
|
|
fi = fromIntegral
|
|
fi' = fromIntegral
|
|
fi'' = fromIntegral
|
|
|
|
makeShaderProgram :: String -> [(ShaderType,BS.ByteString)] -> IO Program
|
|
makeShaderProgram str sources = do
|
|
theShaderProgram <- createProgram
|
|
shaders <- mapM (compileAndCheckShader str) sources
|
|
mapM_ (attachShader theShaderProgram) shaders
|
|
|
|
linkProgram theShaderProgram
|
|
linkingSuccess <- linkStatus theShaderProgram
|
|
unless linkingSuccess $ do
|
|
infoLog <- get (programInfoLog theShaderProgram)
|
|
putStrLn $ str ++ ": Program Linking" ++ infoLog
|
|
return theShaderProgram
|
|
|
|
compileAndCheckShader :: String -> (ShaderType,BS.ByteString) -> IO Shader
|
|
compileAndCheckShader str (theShaderType,sourceCode) = do
|
|
theShader <- createShader theShaderType
|
|
shaderSourceBS theShader $= sourceCode
|
|
compileShader theShader
|
|
success <- compileStatus theShader
|
|
unless success $ do
|
|
infoLog <- get (shaderInfoLog theShader)
|
|
putStrLn $ str ++ ": Shader compile: " ++ show theShaderType ++ " :\n" ++ infoLog
|
|
return theShader
|
|
|
|
bufferOffset :: Integral a => a -> Ptr b
|
|
bufferOffset = plusPtr nullPtr . (* floatSize) . fromIntegral
|
|
|