summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorCsaba Hruska <csaba.hruska@gmail.com>2016-02-12 17:07:41 +0100
committerCsaba Hruska <csaba.hruska@gmail.com>2016-02-12 17:07:41 +0100
commit5ca4d7845df57242e4a2c85030693faab9b17822 (patch)
tree6f76812ee47d184e01827ab4f3cba3e9c150013e /src
parent4b51e6a96d528bad7aee1f1e30b1b0a1dc2998f0 (diff)
improve exceptions
Diffstat (limited to 'src')
-rw-r--r--src/LambdaCube/GL/Backend.hs4
-rw-r--r--src/LambdaCube/GL/Util.hs22
2 files changed, 16 insertions, 10 deletions
diff --git a/src/LambdaCube/GL/Backend.hs b/src/LambdaCube/GL/Backend.hs
index 40abc6d..1d910a2 100644
--- a/src/LambdaCube/GL/Backend.hs
+++ b/src/LambdaCube/GL/Backend.hs
@@ -217,11 +217,11 @@ compileProgram p = do
217 --putStr " + setup shader output mapping: " >> printGLStatus 217 --putStr " + setup shader output mapping: " >> printGLStatus
218 218
219 glLinkProgram po 219 glLinkProgram po
220 printProgramLog po 220 log <- printProgramLog po
221 221
222 -- check link status 222 -- check link status
223 status <- glGetProgramiv1 GL_LINK_STATUS po 223 status <- glGetProgramiv1 GL_LINK_STATUS po
224 when (status /= fromIntegral GL_TRUE) $ fail "link program failed!" 224 when (status /= fromIntegral GL_TRUE) $ fail $ unlines ["link program failed:",log]
225 225
226 -- check program input 226 -- check program input
227 (uniforms,uniformsType) <- queryUniforms po 227 (uniforms,uniformsType) <- queryUniforms po
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