53 lines
1.8 KiB
Haskell
53 lines
1.8 KiB
Haskell
|
module Render.Misc where
|
||
|
|
||
|
import Graphics.Rendering.OpenGL.GL.StringQueries
|
||
|
import Graphics.Rendering.OpenGL.GL.StateVar
|
||
|
import Graphics.Rendering.OpenGL.GLU.Errors
|
||
|
import System.IO (hPutStrLn, stderr)
|
||
|
import Control.Monad
|
||
|
import Graphics.Rendering.OpenGL.GL.Shaders
|
||
|
import qualified Data.ByteString as B (ByteString)
|
||
|
|
||
|
|
||
|
checkError :: String -> IO ()
|
||
|
checkError functionName = get errors >>= mapM_ reportError
|
||
|
where reportError e =
|
||
|
hPutStrLn stderr (showError e ++ " detected in " ++ functionName)
|
||
|
showError (Error category message) =
|
||
|
"GL error " ++ show category ++ " (" ++ message ++ ")"
|
||
|
|
||
|
dumpInfo :: IO ()
|
||
|
dumpInfo = do
|
||
|
let dump message var = putStrLn . ((message ++ ": ") ++) =<< get var
|
||
|
dump "Vendor" vendor
|
||
|
dump "Renderer" renderer
|
||
|
dump "Version" glVersion
|
||
|
dump "GLSL" shadingLanguageVersion
|
||
|
checkError "dumpInfo"
|
||
|
|
||
|
checked :: (t -> IO ()) -> (t -> GettableStateVar Bool) -> (t -> GettableStateVar String) -> String -> t -> IO ()
|
||
|
checked action getStatus getInfoLog message object = do
|
||
|
action object
|
||
|
status <- get (getStatus object)
|
||
|
unless status $
|
||
|
hPutStrLn stderr . ((message ++ " log: ") ++) =<< get (getInfoLog object)
|
||
|
|
||
|
compileAndCheck :: Shader -> IO ()
|
||
|
compileAndCheck = checked compileShader compileStatus shaderInfoLog "compile"
|
||
|
|
||
|
compileShaderSource :: ShaderType -> B.ByteString -> IO Shader
|
||
|
compileShaderSource st source = do
|
||
|
shader <- createShader st
|
||
|
shaderSourceBS shader $= source
|
||
|
compileAndCheck shader
|
||
|
return shader
|
||
|
|
||
|
linkAndCheck :: Program -> IO ()
|
||
|
linkAndCheck = checked linkProgram linkStatus programInfoLog "link"
|
||
|
|
||
|
createProgramUsing :: [Shader] -> IO Program
|
||
|
createProgramUsing shaders = do
|
||
|
program <- createProgram
|
||
|
attachedShaders program $= shaders
|
||
|
linkAndCheck program
|
||
|
return program
|