summaryrefslogtreecommitdiff
path: root/src/LambdaCube/GL/Util.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/LambdaCube/GL/Util.hs')
-rw-r--r--src/LambdaCube/GL/Util.hs22
1 files changed, 14 insertions, 8 deletions
diff --git a/src/LambdaCube/GL/Util.hs b/src/LambdaCube/GL/Util.hs
index ab8350f..bbc4345 100644
--- a/src/LambdaCube/GL/Util.hs
+++ b/src/LambdaCube/GL/Util.hs
@@ -262,15 +262,18 @@ fromGLType (t,1)
262 | otherwise = error "Failed fromGLType" 262 | otherwise = error "Failed fromGLType"
263fromGLUniformType _ = error "Failed fromGLType" 263fromGLUniformType _ = error "Failed fromGLType"
264 264
265printShaderLog :: GLuint -> IO () 265printShaderLog :: GLuint -> IO String
266printShaderLog o = do 266printShaderLog o = do
267 i <- glGetShaderiv1 GL_INFO_LOG_LENGTH o 267 i <- glGetShaderiv1 GL_INFO_LOG_LENGTH o
268 when (i > 0) $ 268 case (i > 0) of
269 False -> return ""
270 True -> do
269 alloca $ \sizePtr -> allocaArray (fromIntegral i) $! \ps -> do 271 alloca $ \sizePtr -> allocaArray (fromIntegral i) $! \ps -> do
270 glGetShaderInfoLog o (fromIntegral i) sizePtr ps 272 glGetShaderInfoLog o (fromIntegral i) sizePtr ps
271 size <- peek sizePtr 273 size <- peek sizePtr
272 log <- peekCStringLen (castPtr ps, fromIntegral size) 274 log <- peekCStringLen (castPtr ps, fromIntegral size)
273 putStrLn log 275 putStrLn log
276 return log
274 277
275glGetShaderiv1 :: GLenum -> GLuint -> IO GLint 278glGetShaderiv1 :: GLenum -> GLuint -> IO GLint
276glGetShaderiv1 pname o = alloca $! \pi -> glGetShaderiv o pname pi >> peek pi 279glGetShaderiv1 pname o = alloca $! \pi -> glGetShaderiv o pname pi >> peek pi
@@ -278,23 +281,26 @@ glGetShaderiv1 pname o = alloca $! \pi -> glGetShaderiv o pname pi >> peek pi
278glGetProgramiv1 :: GLenum -> GLuint -> IO GLint 281glGetProgramiv1 :: GLenum -> GLuint -> IO GLint
279glGetProgramiv1 pname o = alloca $! \pi -> glGetProgramiv o pname pi >> peek pi 282glGetProgramiv1 pname o = alloca $! \pi -> glGetProgramiv o pname pi >> peek pi
280 283
281printProgramLog :: GLuint -> IO () 284printProgramLog :: GLuint -> IO String
282printProgramLog o = do 285printProgramLog o = do
283 i <- glGetProgramiv1 GL_INFO_LOG_LENGTH o 286 i <- glGetProgramiv1 GL_INFO_LOG_LENGTH o
284 when (i > 0) $ 287 case (i > 0) of
288 False -> return ""
289 True -> do
285 alloca $ \sizePtr -> allocaArray (fromIntegral i) $! \ps -> do 290 alloca $ \sizePtr -> allocaArray (fromIntegral i) $! \ps -> do
286 glGetProgramInfoLog o (fromIntegral i) sizePtr ps 291 glGetProgramInfoLog o (fromIntegral i) sizePtr ps
287 size <- peek sizePtr 292 size <- peek sizePtr
288 log <- peekCStringLen (castPtr ps, fromIntegral size) 293 log <- peekCStringLen (castPtr ps, fromIntegral size)
289 unless (null log) $ putStrLn log 294 unless (null log) $ putStrLn log
295 return log
290 296
291compileShader :: GLuint -> [String] -> IO () 297compileShader :: GLuint -> [String] -> IO ()
292compileShader o srcl = withMany withCString srcl $! \l -> withArray l $! \p -> do 298compileShader o srcl = withMany withCString srcl $! \l -> withArray l $! \p -> do
293 glShaderSource o (fromIntegral $! length srcl) (castPtr p) nullPtr 299 glShaderSource o (fromIntegral $! length srcl) (castPtr p) nullPtr
294 glCompileShader o 300 glCompileShader o
295 printShaderLog o 301 log <- printShaderLog o
296 status <- glGetShaderiv1 GL_COMPILE_STATUS o 302 status <- glGetShaderiv1 GL_COMPILE_STATUS o
297 when (status /= fromIntegral GL_TRUE) $ fail "compileShader failed!" 303 when (status /= fromIntegral GL_TRUE) $ fail $ unlines ["compileShader failed:",log]
298 304
299checkGL :: IO String 305checkGL :: IO String
300checkGL = do 306checkGL = do