124 lines
3.9 KiB
Haskell
124 lines
3.9 KiB
Haskell
{-# LANGUAGE QuasiQuotes #-}
|
|
module Shaders
|
|
(setupBasicShader
|
|
,setupFadeShader
|
|
,setupShaders
|
|
,makeTextureShader
|
|
,makeBasicShader
|
|
,makeFadeShader
|
|
,makeCircleShader
|
|
,makeArcShader
|
|
,makeBackgroundShader
|
|
)
|
|
where
|
|
import Graphics.Rendering.OpenGL
|
|
import Control.Monad (when)
|
|
import Text.RawString.QQ
|
|
import qualified Data.ByteString as BS
|
|
|
|
setupShaders :: IO [Program]
|
|
setupShaders = do
|
|
basicShader <- makeBasicShader
|
|
fadeShader <- makeFadeShader
|
|
textureShader <- makeTextureShader
|
|
return [basicShader,fadeShader,textureShader]
|
|
|
|
makeBasicShader :: IO Program
|
|
makeBasicShader = do
|
|
vsSource <- BS.readFile "shader/basic.vert"
|
|
fsSource <- BS.readFile "shader/basic.frag"
|
|
|
|
makeShaderProgram [(VertexShader, vsSource)
|
|
,(FragmentShader, fsSource)
|
|
]
|
|
|
|
setupBasicShader :: IO ()
|
|
setupBasicShader = do
|
|
shaderProgram <- makeBasicShader
|
|
currentProgram $= (Just shaderProgram)
|
|
|
|
makeCircleShader :: IO Program
|
|
makeCircleShader = do
|
|
vsSource <- BS.readFile "shader/circle.vert"
|
|
gsSource <- BS.readFile "shader/circle.geom"
|
|
fsSource <- BS.readFile "shader/circle.frag"
|
|
|
|
makeShaderProgram [(VertexShader, vsSource )
|
|
,(GeometryShader, gsSource )
|
|
,(FragmentShader, fsSource )
|
|
]
|
|
|
|
makeArcShader :: IO Program
|
|
makeArcShader = do
|
|
vsSource <- BS.readFile "shader/arc.vert"
|
|
gsSource <- BS.readFile "shader/arc.geom"
|
|
fsSource <- BS.readFile "shader/arc.frag"
|
|
|
|
makeShaderProgram [(VertexShader, vsSource )
|
|
,(GeometryShader, gsSource )
|
|
,(FragmentShader, fsSource )
|
|
]
|
|
|
|
makeFadeShader :: IO Program
|
|
makeFadeShader = do
|
|
vsSource <- BS.readFile "shader/fadeCircle.vert"
|
|
gsSource <- BS.readFile "shader/fadeCircle.geom"
|
|
fsSource <- BS.readFile "shader/fadeCircle.frag"
|
|
|
|
makeShaderProgram [(VertexShader, vsSource )
|
|
,(GeometryShader, gsSource )
|
|
,(FragmentShader, fsSource )
|
|
]
|
|
makeBackgroundShader :: IO Program
|
|
makeBackgroundShader = do
|
|
vsSource <- BS.readFile "shader/background.vert"
|
|
gsSource <- BS.readFile "shader/background.geom"
|
|
fsSource <- BS.readFile "shader/background.frag"
|
|
|
|
makeShaderProgram [(VertexShader, vsSource )
|
|
,(GeometryShader, gsSource )
|
|
,(FragmentShader, fsSource )
|
|
]
|
|
|
|
setupFadeShader :: IO Program
|
|
setupFadeShader = do
|
|
shaderProgram <- makeFadeShader
|
|
currentProgram $= (Just shaderProgram)
|
|
return shaderProgram
|
|
|
|
makeTextureShader :: IO Program
|
|
makeTextureShader = do
|
|
vsSource <- BS.readFile "shader/basicTexture.vert"
|
|
gsSource <- BS.readFile "shader/basicTexture.geom"
|
|
fsSource <- BS.readFile "shader/basicTexture.frag"
|
|
|
|
makeShaderProgram [(VertexShader, vsSource )
|
|
,(GeometryShader, gsSource )
|
|
,(FragmentShader, fsSource )
|
|
]
|
|
|
|
makeShaderProgram :: [(ShaderType,BS.ByteString)] -> IO Program
|
|
makeShaderProgram sources = do
|
|
shaderProgram <- createProgram
|
|
shaders <- mapM compileAndCheckShader sources
|
|
mapM_ (attachShader shaderProgram) shaders
|
|
|
|
linkProgram shaderProgram
|
|
linkingSuccess <- linkStatus shaderProgram
|
|
when (not linkingSuccess) $ do
|
|
infoLog <- get (programInfoLog shaderProgram)
|
|
putStrLn $ "Program Linking" ++ infoLog
|
|
|
|
return shaderProgram
|
|
|
|
compileAndCheckShader :: (ShaderType,BS.ByteString) -> IO Shader
|
|
compileAndCheckShader (shaderType,sourceCode) = do
|
|
theShader <- createShader shaderType
|
|
shaderSourceBS theShader $= sourceCode
|
|
compileShader theShader
|
|
success <- compileStatus theShader
|
|
when (not success) $ do
|
|
infoLog <- get (shaderInfoLog theShader)
|
|
putStrLn $ "Shader compile: " ++ show shaderType ++ " : " ++ show infoLog
|
|
return theShader
|