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.hs13
1 files changed, 6 insertions, 7 deletions
diff --git a/src/LambdaCube/GL/Util.hs b/src/LambdaCube/GL/Util.hs
index 2059415..6c65628 100644
--- a/src/LambdaCube/GL/Util.hs
+++ b/src/LambdaCube/GL/Util.hs
@@ -37,7 +37,6 @@ import Control.Monad
37import Data.ByteString.Char8 (ByteString,pack,unpack) 37import Data.ByteString.Char8 (ByteString,pack,unpack)
38import Data.IORef 38import Data.IORef
39import Data.List as L 39import Data.List as L
40import Data.Trie as T
41import Foreign 40import Foreign
42import qualified Data.ByteString.Char8 as SB 41import qualified Data.ByteString.Char8 as SB
43import qualified Data.Vector as V 42import qualified Data.Vector as V
@@ -51,8 +50,8 @@ import Linear
51import IR 50import IR
52import LambdaCube.GL.Type 51import LambdaCube.GL.Type
53 52
54toTrie :: Map String a -> Trie a 53toTrie :: Map String a -> Map ByteString a
55toTrie m = T.fromList [(pack k,v) | (k,v) <- Map.toList m] 54toTrie m = Map.fromList [(pack k,v) | (k,v) <- Map.toList m]
56 55
57setSampler :: GLint -> Int32 -> IO () 56setSampler :: GLint -> Int32 -> IO ()
58setSampler i v = glUniform1i i $ fromIntegral v 57setSampler i v = glUniform1i i $ fromIntegral v
@@ -62,13 +61,13 @@ z3 = V3 0 0 0 :: V3F
62z4 = V4 0 0 0 0 :: V4F 61z4 = V4 0 0 0 0 :: V4F
63 62
64-- uniform functions 63-- uniform functions
65queryUniforms :: GLuint -> IO (Trie GLint, Trie InputType) 64queryUniforms :: GLuint -> IO (Map ByteString GLint, Map ByteString InputType)
66queryUniforms po = do 65queryUniforms po = do
67 ul <- getNameTypeSize po glGetActiveUniform glGetUniformLocation GL_ACTIVE_UNIFORMS GL_ACTIVE_UNIFORM_MAX_LENGTH 66 ul <- getNameTypeSize po glGetActiveUniform glGetUniformLocation GL_ACTIVE_UNIFORMS GL_ACTIVE_UNIFORM_MAX_LENGTH
68 let uNames = [n | (n,_,_,_) <- ul] 67 let uNames = [n | (n,_,_,_) <- ul]
69 uTypes = [fromGLType (e,s) | (_,_,e,s) <- ul] 68 uTypes = [fromGLType (e,s) | (_,_,e,s) <- ul]
70 uLocation = [i | (_,i,_,_) <- ul] 69 uLocation = [i | (_,i,_,_) <- ul]
71 return $! (T.fromList $! zip uNames uLocation, T.fromList $! zip uNames uTypes) 70 return $! (Map.fromList $! zip uNames uLocation, Map.fromList $! zip uNames uTypes)
72 71
73b2w :: Bool -> GLuint 72b2w :: Bool -> GLuint
74b2w True = 1 73b2w True = 1
@@ -137,13 +136,13 @@ setUniform i ty ref = do
137 _ -> fail $ "internal error (setUniform)! - " ++ show ty 136 _ -> fail $ "internal error (setUniform)! - " ++ show ty
138 137
139-- attribute functions 138-- attribute functions
140queryStreams :: GLuint -> IO (Trie GLuint, Trie InputType) 139queryStreams :: GLuint -> IO (Map ByteString GLuint, Map ByteString InputType)
141queryStreams po = do 140queryStreams po = do
142 al <- getNameTypeSize po glGetActiveAttrib glGetAttribLocation GL_ACTIVE_ATTRIBUTES GL_ACTIVE_ATTRIBUTE_MAX_LENGTH 141 al <- getNameTypeSize po glGetActiveAttrib glGetAttribLocation GL_ACTIVE_ATTRIBUTES GL_ACTIVE_ATTRIBUTE_MAX_LENGTH
143 let aNames = [n | (n,_,_,_) <- al] 142 let aNames = [n | (n,_,_,_) <- al]
144 aTypes = [fromGLType (e,s) | (_,_,e,s) <- al] 143 aTypes = [fromGLType (e,s) | (_,_,e,s) <- al]
145 aLocation = [fromIntegral i | (_,i,_,_) <- al] 144 aLocation = [fromIntegral i | (_,i,_,_) <- al]
146 return $! (T.fromList $! zip aNames aLocation, T.fromList $! zip aNames aTypes) 145 return $! (Map.fromList $! zip aNames aLocation, Map.fromList $! zip aNames aTypes)
147 146
148arrayTypeToGLType :: ArrayType -> GLenum 147arrayTypeToGLType :: ArrayType -> GLenum
149arrayTypeToGLType a = case a of 148arrayTypeToGLType a = case a of