summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lambdacube-gl-ir.cabal42
-rw-r--r--src/LambdaCube/GL/Backend.hs47
-rw-r--r--src/LambdaCube/GL/Data.hs1
-rw-r--r--src/LambdaCube/GL/Input.hs82
-rw-r--r--src/LambdaCube/GL/Mesh.hs13
-rw-r--r--src/LambdaCube/GL/Type.hs33
-rw-r--r--src/LambdaCube/GL/Util.hs34
7 files changed, 100 insertions, 152 deletions
diff --git a/lambdacube-gl-ir.cabal b/lambdacube-gl-ir.cabal
index 6008847..bf5eea9 100644
--- a/lambdacube-gl-ir.cabal
+++ b/lambdacube-gl-ir.cabal
@@ -1,6 +1,3 @@
1-- Initial lambdacube-dsl.cabal generated by cabal init. For further
2-- documentation, see http://haskell.org/cabal/users-guide/
3
4name: lambdacube-gl-ir 1name: lambdacube-gl-ir
5version: 0.2.0.0 2version: 0.2.0.0
6-- synopsis: 3-- synopsis:
@@ -28,25 +25,7 @@ library
28 LambdaCube.GL.Type 25 LambdaCube.GL.Type
29 LambdaCube.GL.Util 26 LambdaCube.GL.Util
30 -- other-modules: 27 -- other-modules:
31 other-extensions: 28 -- other-extensions:
32 LambdaCase
33 PatternSynonyms
34 ViewPatterns
35 TypeSynonymInstances
36 FlexibleInstances
37 NoMonomorphismRestriction
38 TypeFamilies
39 RecordWildCards
40 DeriveFunctor
41 DeriveFoldable
42 DeriveTraversable
43 GeneralizedNewtypeDeriving
44 OverloadedStrings
45 TupleSections
46 MonadComprehensions
47 ExistentialQuantification
48 ScopedTypeVariables
49 ParallelListComp
50 build-depends: 29 build-depends:
51 base >=4.7 && <4.9, 30 base >=4.7 && <4.9,
52 containers >=0.5 && <0.6, 31 containers >=0.5 && <0.6,
@@ -60,22 +39,3 @@ library
60 lambdacube-ir 39 lambdacube-ir
61 hs-source-dirs: src 40 hs-source-dirs: src
62 default-language: Haskell2010 41 default-language: Haskell2010
63
64--executable sampleIR
65-- hs-source-dirs: tests
66-- main-is: sampleIR.hs
67-- build-depends:
68-- lambdacube-dsl,
69-- base >=4.7 && <4.9
70-- default-language: Haskell2010
71
72--test-suite runtests
73-- type: exitcode-stdio-1.0
74-- hs-source-dirs: tests
75-- main-is: runTests.hs
76--
77-- build-depends: base < 4.9
78-- , filepath
79-- , directory
80-- , lambdacube-dsl
81-- default-language: Haskell2010
diff --git a/src/LambdaCube/GL/Backend.hs b/src/LambdaCube/GL/Backend.hs
index 196280d..2753ac3 100644
--- a/src/LambdaCube/GL/Backend.hs
+++ b/src/LambdaCube/GL/Backend.hs
@@ -1,18 +1,16 @@
1{-# LANGUAGE TupleSections, MonadComprehensions, ViewPatterns, RecordWildCards #-} 1{-# LANGUAGE TupleSections, MonadComprehensions, RecordWildCards #-}
2module LambdaCube.GL.Backend where 2module LambdaCube.GL.Backend where
3 3
4import Control.Applicative 4import Control.Applicative
5import Control.Monad 5import Control.Monad
6import Control.Monad.State 6import Control.Monad.State
7import Data.Bits 7import Data.Bits
8import Data.ByteString.Char8 (ByteString,pack)
9import Data.IORef 8import Data.IORef
10import Data.IntMap (IntMap) 9import Data.IntMap (IntMap)
11import Data.Maybe (isNothing,fromJust) 10import Data.Maybe (isNothing,fromJust)
12import Data.Map (Map) 11import Data.Map (Map)
13import Data.Set (Set) 12import Data.Set (Set)
14import Data.Vector (Vector,(!),(//)) 13import Data.Vector (Vector,(!),(//))
15import qualified Data.ByteString.Char8 as SB
16import qualified Data.Foldable as F 14import qualified Data.Foldable as F
17import qualified Data.IntMap as IM 15import qualified Data.IntMap as IM
18import qualified Data.Map as Map 16import qualified Data.Map as Map
@@ -23,6 +21,7 @@ import qualified Data.Vector.Storable as SV
23 21
24import Graphics.GL.Core33 22import Graphics.GL.Core33
25import Foreign 23import Foreign
24import Foreign.C.String
26 25
27-- LC IR imports 26-- LC IR imports
28import Linear 27import Linear
@@ -196,13 +195,13 @@ clearRenderTarget values = do
196printGLStatus = checkGL >>= print 195printGLStatus = checkGL >>= print
197printFBOStatus = checkFBO >>= print 196printFBOStatus = checkFBO >>= print
198 197
199compileProgram :: Map ByteString InputType -> Program -> IO GLProgram 198compileProgram :: Map String InputType -> Program -> IO GLProgram
200compileProgram uniTrie p = do 199compileProgram uniTrie p = do
201 po <- glCreateProgram 200 po <- glCreateProgram
202 putStrLn $ "compile program: " ++ show po 201 putStrLn $ "compile program: " ++ show po
203 let createAndAttach src t = do 202 let createAndAttach src t = do
204 o <- glCreateShader t 203 o <- glCreateShader t
205 compileShader o $ map pack [src] 204 compileShader o [src]
206 glAttachShader po o 205 glAttachShader po o
207 putStr " + compile shader source: " >> printGLStatus 206 putStr " + compile shader source: " >> printGLStatus
208 return o 207 return o
@@ -211,7 +210,7 @@ compileProgram uniTrie p = do
211 Nothing -> [] 210 Nothing -> []
212 Just s -> [createAndAttach s GL_GEOMETRY_SHADER] 211 Just s -> [createAndAttach s GL_GEOMETRY_SHADER]
213 212
214 forM_ (zip (V.toList $ programOutput p) [0..]) $ \(Parameter (pack -> n) t,i) -> SB.useAsCString n $ \pn -> do 213 forM_ (zip (V.toList $ programOutput p) [0..]) $ \(Parameter n t,i) -> withCString n $ \pn -> do
215 putStrLn ("variable " ++ show n ++ " attached to color number #" ++ show i) 214 putStrLn ("variable " ++ show n ++ " attached to color number #" ++ show i)
216 glBindFragDataLocation po i $ castPtr pn 215 glBindFragDataLocation po i $ castPtr pn
217 putStr " + setup shader output mapping: " >> printGLStatus 216 putStr " + setup shader output mapping: " >> printGLStatus
@@ -228,8 +227,8 @@ compileProgram uniTrie p = do
228 (attributes,attributesType) <- queryStreams po 227 (attributes,attributesType) <- queryStreams po
229 print uniforms 228 print uniforms
230 print attributes 229 print attributes
231 let lcUniforms = (toTrie $ programUniforms p) `Map.union` (toTrie $ programInTextures p) 230 let lcUniforms = (programUniforms p) `Map.union` (programInTextures p)
232 lcStreams = fmap ty (toTrie $ programStreams p) 231 lcStreams = fmap ty (programStreams p)
233 check a m = and $ map go $ Map.toList m 232 check a m = and $ map go $ Map.toList m
234 where go (k,b) = case Map.lookup k a of 233 where go (k,b) = case Map.lookup k a of
235 Nothing -> False 234 Nothing -> False
@@ -240,9 +239,9 @@ compileProgram uniTrie p = do
240 fail "shader program uniform input mismatch!" 239 fail "shader program uniform input mismatch!"
241 unless (check lcStreams attributesType) $ fail $ "shader program stream input mismatch! " ++ show (attributesType,lcStreams) 240 unless (check lcStreams attributesType) $ fail $ "shader program stream input mismatch! " ++ show (attributesType,lcStreams)
242 -- the public (user) pipeline and program input is encoded by the objectArrays, therefore the programs does not distinct the render and slot textures input 241 -- the public (user) pipeline and program input is encoded by the objectArrays, therefore the programs does not distinct the render and slot textures input
243 let inUniNames = toTrie $ programUniforms p 242 let inUniNames = programUniforms p
244 inUniforms = L.filter (\(n,v) -> Map.member n inUniNames) $ Map.toList $ uniforms 243 inUniforms = L.filter (\(n,v) -> Map.member n inUniNames) $ Map.toList $ uniforms
245 inTextureNames = toTrie $ programInTextures p 244 inTextureNames = programInTextures p
246 inTextures = L.filter (\(n,v) -> Map.member n inTextureNames) $ Map.toList $ uniforms 245 inTextures = L.filter (\(n,v) -> Map.member n inTextureNames) $ Map.toList $ uniforms
247 texUnis = [n | (n,_) <- inTextures, Map.member n uniTrie] 246 texUnis = [n | (n,_) <- inTextures, Map.member n uniTrie]
248 putStrLn $ "uniTrie: " ++ show (Map.keys uniTrie) 247 putStrLn $ "uniTrie: " ++ show (Map.keys uniTrie)
@@ -252,18 +251,18 @@ compileProgram uniTrie p = do
252 putStrLn $ "inTextures: " ++ show inTextures 251 putStrLn $ "inTextures: " ++ show inTextures
253 putStrLn $ "texUnis: " ++ show texUnis 252 putStrLn $ "texUnis: " ++ show texUnis
254 let valA = Map.toList $ attributes 253 let valA = Map.toList $ attributes
255 valB = Map.toList $ toTrie $ programStreams p 254 valB = Map.toList $ programStreams p
256 putStrLn "------------" 255 putStrLn "------------"
257 print $ Map.toList $ attributes 256 print $ Map.toList $ attributes
258 print $ Map.toList $ toTrie $ programStreams p 257 print $ Map.toList $ programStreams p
259 let lcStreamName = fmap name (toTrie $ programStreams p) 258 let lcStreamName = fmap name (programStreams p)
260 return $ GLProgram 259 return $ GLProgram
261 { shaderObjects = objs 260 { shaderObjects = objs
262 , programObject = po 261 , programObject = po
263 , inputUniforms = Map.fromList inUniforms 262 , inputUniforms = Map.fromList inUniforms
264 , inputTextures = Map.fromList inTextures 263 , inputTextures = Map.fromList inTextures
265 , inputTextureUniforms = S.fromList $ texUnis 264 , inputTextureUniforms = S.fromList $ texUnis
266 , inputStreams = Map.fromList [(n,(idx, pack attrName)) | (n,idx) <- Map.toList $ attributes, let Just attrName = Map.lookup n lcStreamName] 265 , inputStreams = Map.fromList [(n,(idx, attrName)) | (n,idx) <- Map.toList $ attributes, let Just attrName = Map.lookup n lcStreamName]
267 } 266 }
268 267
269compileSampler :: SamplerDescriptor -> IO GLSampler 268compileSampler :: SamplerDescriptor -> IO GLSampler
@@ -409,11 +408,11 @@ compileStreamData s = do
409 Triangles -> TriangleList 408 Triangles -> TriangleList
410 LinesAdjacency -> LineListAdjacency 409 LinesAdjacency -> LineListAdjacency
411 TrianglesAdjacency -> TriangleListAdjacency 410 TrianglesAdjacency -> TriangleListAdjacency
412 , glStreamAttributes = toTrie $ Map.fromList $ map toStream indexMap 411 , glStreamAttributes = Map.fromList $ map toStream indexMap
413 , glStreamProgram = V.head $ streamPrograms s 412 , glStreamProgram = V.head $ streamPrograms s
414 } 413 }
415 414
416createStreamCommands :: Map ByteString (IORef GLint) -> Map ByteString GLUniform -> Map ByteString (Stream Buffer) -> Primitive -> GLProgram -> [GLObjectCommand] 415createStreamCommands :: Map String (IORef GLint) -> Map String GLUniform -> Map String (Stream Buffer) -> Primitive -> GLProgram -> [GLObjectCommand]
417createStreamCommands texUnitMap topUnis attrs primitive prg = streamUniCmds ++ streamCmds ++ [drawCmd] 416createStreamCommands texUnitMap topUnis attrs primitive prg = streamUniCmds ++ streamCmds ++ [drawCmd]
418 where 417 where
419 -- object draw command 418 -- object draw command
@@ -483,7 +482,7 @@ allocRenderer p = do
483 prgs <- V.mapM (compileProgram uniTrie) $ programs p 482 prgs <- V.mapM (compileProgram uniTrie) $ programs p
484 -- texture unit mapping ioref trie 483 -- texture unit mapping ioref trie
485 -- texUnitMapRefs :: Map UniformName (IORef TextureUnit) 484 -- texUnitMapRefs :: Map UniformName (IORef TextureUnit)
486 texUnitMapRefs <- Map.fromList <$> mapM (\k -> (k,) <$> newIORef 0) (S.toList $ S.fromList $ concat $ V.toList $ V.map (Map.keys . toTrie . programInTextures) $ programs p) 485 texUnitMapRefs <- Map.fromList <$> mapM (\k -> (k,) <$> newIORef 0) (S.toList $ S.fromList $ concat $ V.toList $ V.map (Map.keys . programInTextures) $ programs p)
487 let (cmds,st) = runState (mapM (compileCommand texUnitMapRefs smps texs trgs prgs) $ V.toList $ commands p) initCGState 486 let (cmds,st) = runState (mapM (compileCommand texUnitMapRefs smps texs trgs prgs) $ V.toList $ commands p) initCGState
488 input <- newIORef Nothing 487 input <- newIORef Nothing
489 -- default Vertex Array Object 488 -- default Vertex Array Object
@@ -497,7 +496,7 @@ allocRenderer p = do
497 , glCommands = cmds 496 , glCommands = cmds
498 , glSlotPrograms = V.map (V.toList . slotPrograms) $ IR.slots p 497 , glSlotPrograms = V.map (V.toList . slotPrograms) $ IR.slots p
499 , glInput = input 498 , glInput = input
500 , glSlotNames = V.map (pack . slotName) $ IR.slots p 499 , glSlotNames = V.map slotName $ IR.slots p
501 , glVAO = vao 500 , glVAO = vao
502 , glTexUnitMapping = texUnitMapRefs 501 , glTexUnitMapping = texUnitMapRefs
503 , glStreams = strs 502 , glStreams = strs
@@ -530,7 +529,7 @@ data PipelineSchema
530 } 529 }
531 deriving Show 530 deriving Show
532-} 531-}
533isSubTrie :: (a -> a -> Bool) -> Map ByteString a -> Map ByteString a -> Bool 532isSubTrie :: (a -> a -> Bool) -> Map String a -> Map String a -> Bool
534isSubTrie eqFun universe subset = and [isMember a (Map.lookup n universe) | (n,a) <- Map.toList subset] 533isSubTrie eqFun universe subset = and [isMember a (Map.lookup n universe) | (n,a) <- Map.toList subset]
535 where 534 where
536 isMember a Nothing = False 535 isMember a Nothing = False
@@ -702,7 +701,7 @@ renderSlot cmds = forM_ cmds $ \cmd -> do
702 glDisableVertexAttribArray idx 701 glDisableVertexAttribArray idx
703 setVertexAttrib idx val 702 setVertexAttrib idx val
704 isOk <- checkGL 703 isOk <- checkGL
705 putStrLn $ SB.unpack isOk ++ " - " ++ show cmd 704 putStrLn $ isOk ++ " - " ++ show cmd
706 705
707renderFrame :: GLRenderer -> IO () 706renderFrame :: GLRenderer -> IO ()
708renderFrame glp = do 707renderFrame glp = do
@@ -752,7 +751,7 @@ renderFrame glp = do
752 GLLoadImage 751 GLLoadImage
753 -} 752 -}
754 isOk <- checkGL 753 isOk <- checkGL
755 putStrLn $ SB.unpack isOk ++ " - " ++ show cmd 754 putStrLn $ isOk ++ " - " ++ show cmd
756 755
757data CGState 756data CGState
758 = CGState 757 = CGState
@@ -769,7 +768,7 @@ initCGState = CGState
769 768
770type CG a = State CGState a 769type CG a = State CGState a
771 770
772compileCommand :: Map ByteString (IORef GLint) -> Vector GLSampler -> Vector GLTexture -> Vector GLRenderTarget -> Vector GLProgram -> Command -> CG GLCommand 771compileCommand :: Map String (IORef GLint) -> Vector GLSampler -> Vector GLTexture -> Vector GLRenderTarget -> Vector GLProgram -> Command -> CG GLCommand
773compileCommand texUnitMap samplers textures targets programs cmd = case cmd of 772compileCommand texUnitMap samplers textures targets programs cmd = case cmd of
774 SetRasterContext rCtx -> return $ GLSetRasterContext rCtx 773 SetRasterContext rCtx -> return $ GLSetRasterContext rCtx
775 SetAccumulationContext aCtx -> return $ GLSetAccumulationContext aCtx 774 SetAccumulationContext aCtx -> return $ GLSetAccumulationContext aCtx
@@ -780,9 +779,9 @@ compileCommand texUnitMap samplers textures targets programs cmd = case cmd of
780 SetSamplerUniform n tu -> do 779 SetSamplerUniform n tu -> do
781 modify (\s@CGState{..} -> s {samplerUniforms = Map.insert n tu samplerUniforms}) 780 modify (\s@CGState{..} -> s {samplerUniforms = Map.insert n tu samplerUniforms})
782 p <- currentProgram <$> get 781 p <- currentProgram <$> get
783 case Map.lookup (pack n) (inputTextures $ programs ! p) of 782 case Map.lookup n (inputTextures $ programs ! p) of
784 Nothing -> fail $ "internal error (SetSamplerUniform)! - " ++ show cmd 783 Nothing -> fail $ "internal error (SetSamplerUniform)! - " ++ show cmd
785 Just i -> case Map.lookup (pack n) texUnitMap of 784 Just i -> case Map.lookup n texUnitMap of
786 Nothing -> fail $ "internal error (SetSamplerUniform - IORef)! - " ++ show cmd 785 Nothing -> fail $ "internal error (SetSamplerUniform - IORef)! - " ++ show cmd
787 Just r -> return $ GLSetSamplerUniform i (fromIntegral tu) r 786 Just r -> return $ GLSetSamplerUniform i (fromIntegral tu) r
788 SetTexture tu t -> do 787 SetTexture tu t -> do
diff --git a/src/LambdaCube/GL/Data.hs b/src/LambdaCube/GL/Data.hs
index 21142f5..4ebe33c 100644
--- a/src/LambdaCube/GL/Data.hs
+++ b/src/LambdaCube/GL/Data.hs
@@ -2,7 +2,6 @@ module LambdaCube.GL.Data where
2 2
3import Control.Applicative 3import Control.Applicative
4import Control.Monad 4import Control.Monad
5import Data.ByteString.Char8 (ByteString)
6import Data.IORef 5import Data.IORef
7import Data.List as L 6import Data.List as L
8import Data.Maybe 7import Data.Maybe
diff --git a/src/LambdaCube/GL/Input.hs b/src/LambdaCube/GL/Input.hs
index 88b2654..f2216fb 100644
--- a/src/LambdaCube/GL/Input.hs
+++ b/src/LambdaCube/GL/Input.hs
@@ -3,14 +3,12 @@ module LambdaCube.GL.Input where
3import Control.Applicative 3import Control.Applicative
4import Control.Exception 4import Control.Exception
5import Control.Monad 5import Control.Monad
6import Data.ByteString.Char8 (ByteString,pack)
7import Data.IORef 6import Data.IORef
8import Data.Map (Map) 7import Data.Map (Map)
9import Data.IntMap (IntMap) 8import Data.IntMap (IntMap)
10import Data.Vector (Vector,(//),(!)) 9import Data.Vector (Vector,(//),(!))
11import Data.Word 10import Data.Word
12import Foreign 11import Foreign
13import qualified Data.ByteString.Char8 as SB
14import qualified Data.IntMap as IM 12import qualified Data.IntMap as IM
15import qualified Data.Set as S 13import qualified Data.Set as S
16import qualified Data.Map as Map 14import qualified Data.Map as Map
@@ -29,8 +27,8 @@ import qualified IR as IR
29schemaFromPipeline :: IR.Pipeline -> PipelineSchema 27schemaFromPipeline :: IR.Pipeline -> PipelineSchema
30schemaFromPipeline a = PipelineSchema (Map.fromList sl) (foldl Map.union Map.empty ul) 28schemaFromPipeline a = PipelineSchema (Map.fromList sl) (foldl Map.union Map.empty ul)
31 where 29 where
32 (sl,ul) = unzip [( (pack sName,ObjectArraySchema sPrimitive (fmap cvt (toTrie sStreams))) 30 (sl,ul) = unzip [( (sName,ObjectArraySchema sPrimitive (fmap cvt sStreams))
33 , toTrie sUniforms 31 , sUniforms
34 ) 32 )
35 | IR.Slot sName sStreams sUniforms sPrimitive _ <- V.toList $ IR.slots a 33 | IR.Slot sName sStreams sUniforms sPrimitive _ <- V.toList $ IR.slots a
36 ] 34 ]
@@ -38,7 +36,7 @@ schemaFromPipeline a = PipelineSchema (Map.fromList sl) (foldl Map.union Map.emp
38 Just v -> v 36 Just v -> v
39 Nothing -> error "internal error (schemaFromPipeline)" 37 Nothing -> error "internal error (schemaFromPipeline)"
40 38
41mkUniform :: [(ByteString,InputType)] -> IO (Map ByteString InputSetter, Map ByteString GLUniform) 39mkUniform :: [(String,InputType)] -> IO (Map String InputSetter, Map String GLUniform)
42mkUniform l = do 40mkUniform l = do
43 unisAndSetters <- forM l $ \(n,t) -> do 41 unisAndSetters <- forM l $ \(n,t) -> do
44 (uni, setter) <- mkUniformSetter t 42 (uni, setter) <- mkUniformSetter t
@@ -70,7 +68,7 @@ disposeStorage :: GLStorage -> IO ()
70disposeStorage = error "not implemented: disposeStorage" 68disposeStorage = error "not implemented: disposeStorage"
71 69
72-- object 70-- object
73addObject :: GLStorage -> ByteString -> Primitive -> Maybe (IndexStream Buffer) -> Map ByteString (Stream Buffer) -> [ByteString] -> IO Object 71addObject :: GLStorage -> String -> Primitive -> Maybe (IndexStream Buffer) -> Map String (Stream Buffer) -> [String] -> IO Object
74addObject input slotName prim indices attribs uniformNames = do 72addObject input slotName prim indices attribs uniformNames = do
75 let sch = schema input 73 let sch = schema input
76 forM_ uniformNames $ \n -> case Map.lookup n (uniforms sch) of 74 forM_ uniformNames $ \n -> case Map.lookup n (uniforms sch) of
@@ -149,7 +147,7 @@ setObjectOrder p obj i = do
149 writeIORef (objOrder obj) i 147 writeIORef (objOrder obj) i
150 modifyIORef (slotVector p ! objSlot obj) $ \(GLSlot objs sorted _) -> GLSlot objs sorted Reorder 148 modifyIORef (slotVector p ! objSlot obj) $ \(GLSlot objs sorted _) -> GLSlot objs sorted Reorder
151 149
152objectUniformSetter :: Object -> Map ByteString InputSetter 150objectUniformSetter :: Object -> Map String InputSetter
153objectUniformSetter = objUniSetter 151objectUniformSetter = objUniSetter
154 152
155setScreenSize :: GLStorage -> Word -> Word -> IO () 153setScreenSize :: GLStorage -> Word -> Word -> IO ()
@@ -177,7 +175,7 @@ sortSlotObjects p = V.forM_ (slotVector p) $ \slotRef -> do
177 return (ord,obj) 175 return (ord,obj)
178 doSort objs 176 doSort objs
179 177
180createObjectCommands :: Map ByteString (IORef GLint) -> Map ByteString GLUniform -> Object -> GLProgram -> [GLObjectCommand] 178createObjectCommands :: Map String (IORef GLint) -> Map String GLUniform -> Object -> GLProgram -> [GLObjectCommand]
181createObjectCommands texUnitMap topUnis obj prg = objUniCmds ++ objStreamCmds ++ [objDrawCmd] 179createObjectCommands texUnitMap topUnis obj prg = objUniCmds ++ objStreamCmds ++ [objDrawCmd]
182 where 180 where
183 -- object draw command 181 -- object draw command
@@ -247,41 +245,41 @@ createObjectCommands texUnitMap topUnis obj prg = objUniCmds ++ objStreamCmds ++
247 -- constant generic attribute 245 -- constant generic attribute
248 constAttr -> GLSetVertexAttrib i constAttr 246 constAttr -> GLSetVertexAttrib i constAttr
249 247
250nullSetter :: ByteString -> String -> a -> IO () 248nullSetter :: String -> String -> a -> IO ()
251--nullSetter n t _ = return () -- Prelude.putStrLn $ "WARNING: unknown uniform: " ++ SB.unpack n ++ " :: " ++ t 249--nullSetter n t _ = return () -- Prelude.putStrLn $ "WARNING: unknown uniform: " ++ SB.unpack n ++ " :: " ++ t
252nullSetter n t _ = Prelude.putStrLn $ "WARNING: unknown uniform: " ++ SB.unpack n ++ " :: " ++ t 250nullSetter n t _ = Prelude.putStrLn $ "WARNING: unknown uniform: " ++ n ++ " :: " ++ t
253 251
254uniformBool :: ByteString -> Map ByteString InputSetter -> SetterFun Bool 252uniformBool :: String -> Map String InputSetter -> SetterFun Bool
255uniformV2B :: ByteString -> Map ByteString InputSetter -> SetterFun V2B 253uniformV2B :: String -> Map String InputSetter -> SetterFun V2B
256uniformV3B :: ByteString -> Map ByteString InputSetter -> SetterFun V3B 254uniformV3B :: String -> Map String InputSetter -> SetterFun V3B
257uniformV4B :: ByteString -> Map ByteString InputSetter -> SetterFun V4B 255uniformV4B :: String -> Map String InputSetter -> SetterFun V4B
258 256
259uniformWord :: ByteString -> Map ByteString InputSetter -> SetterFun Word32 257uniformWord :: String -> Map String InputSetter -> SetterFun Word32
260uniformV2U :: ByteString -> Map ByteString InputSetter -> SetterFun V2U 258uniformV2U :: String -> Map String InputSetter -> SetterFun V2U
261uniformV3U :: ByteString -> Map ByteString InputSetter -> SetterFun V3U 259uniformV3U :: String -> Map String InputSetter -> SetterFun V3U
262uniformV4U :: ByteString -> Map ByteString InputSetter -> SetterFun V4U 260uniformV4U :: String -> Map String InputSetter -> SetterFun V4U
263 261
264uniformInt :: ByteString -> Map ByteString InputSetter -> SetterFun Int32 262uniformInt :: String -> Map String InputSetter -> SetterFun Int32
265uniformV2I :: ByteString -> Map ByteString InputSetter -> SetterFun V2I 263uniformV2I :: String -> Map String InputSetter -> SetterFun V2I
266uniformV3I :: ByteString -> Map ByteString InputSetter -> SetterFun V3I 264uniformV3I :: String -> Map String InputSetter -> SetterFun V3I
267uniformV4I :: ByteString -> Map ByteString InputSetter -> SetterFun V4I 265uniformV4I :: String -> Map String InputSetter -> SetterFun V4I
268 266
269uniformFloat :: ByteString -> Map ByteString InputSetter -> SetterFun Float 267uniformFloat :: String -> Map String InputSetter -> SetterFun Float
270uniformV2F :: ByteString -> Map ByteString InputSetter -> SetterFun V2F 268uniformV2F :: String -> Map String InputSetter -> SetterFun V2F
271uniformV3F :: ByteString -> Map ByteString InputSetter -> SetterFun V3F 269uniformV3F :: String -> Map String InputSetter -> SetterFun V3F
272uniformV4F :: ByteString -> Map ByteString InputSetter -> SetterFun V4F 270uniformV4F :: String -> Map String InputSetter -> SetterFun V4F
273 271
274uniformM22F :: ByteString -> Map ByteString InputSetter -> SetterFun M22F 272uniformM22F :: String -> Map String InputSetter -> SetterFun M22F
275uniformM23F :: ByteString -> Map ByteString InputSetter -> SetterFun M23F 273uniformM23F :: String -> Map String InputSetter -> SetterFun M23F
276uniformM24F :: ByteString -> Map ByteString InputSetter -> SetterFun M24F 274uniformM24F :: String -> Map String InputSetter -> SetterFun M24F
277uniformM32F :: ByteString -> Map ByteString InputSetter -> SetterFun M32F 275uniformM32F :: String -> Map String InputSetter -> SetterFun M32F
278uniformM33F :: ByteString -> Map ByteString InputSetter -> SetterFun M33F 276uniformM33F :: String -> Map String InputSetter -> SetterFun M33F
279uniformM34F :: ByteString -> Map ByteString InputSetter -> SetterFun M34F 277uniformM34F :: String -> Map String InputSetter -> SetterFun M34F
280uniformM42F :: ByteString -> Map ByteString InputSetter -> SetterFun M42F 278uniformM42F :: String -> Map String InputSetter -> SetterFun M42F
281uniformM43F :: ByteString -> Map ByteString InputSetter -> SetterFun M43F 279uniformM43F :: String -> Map String InputSetter -> SetterFun M43F
282uniformM44F :: ByteString -> Map ByteString InputSetter -> SetterFun M44F 280uniformM44F :: String -> Map String InputSetter -> SetterFun M44F
283 281
284uniformFTexture2D :: ByteString -> Map ByteString InputSetter -> SetterFun TextureData 282uniformFTexture2D :: String -> Map String InputSetter -> SetterFun TextureData
285 283
286uniformBool n is = case Map.lookup n is of 284uniformBool n is = case Map.lookup n is of
287 Just (SBool fun) -> fun 285 Just (SBool fun) -> fun
diff --git a/src/LambdaCube/GL/Mesh.hs b/src/LambdaCube/GL/Mesh.hs
index 553e2e8..f8521dd 100644
--- a/src/LambdaCube/GL/Mesh.hs
+++ b/src/LambdaCube/GL/Mesh.hs
@@ -15,7 +15,6 @@ module LambdaCube.GL.Mesh (
15import Control.Applicative 15import Control.Applicative
16import Control.Monad 16import Control.Monad
17import Data.Binary 17import Data.Binary
18import Data.ByteString.Char8 (ByteString)
19import Foreign.Ptr 18import Foreign.Ptr
20import Data.Int 19import Data.Int
21import Foreign.Storable 20import Foreign.Storable
@@ -23,10 +22,10 @@ import Foreign.Marshal.Utils
23import System.IO.Unsafe 22import System.IO.Unsafe
24import Data.Map (Map) 23import Data.Map (Map)
25import qualified Data.Map as Map 24import qualified Data.Map as Map
26import qualified Data.ByteString.Char8 as SB
27import qualified Data.ByteString.Lazy as LB
28import qualified Data.Vector.Storable as V 25import qualified Data.Vector.Storable as V
29import qualified Data.Vector.Storable.Mutable as MV 26import qualified Data.Vector.Storable.Mutable as MV
27import qualified Data.ByteString.Char8 as SB
28import qualified Data.ByteString.Lazy as LB
30 29
31import LambdaCube.GL 30import LambdaCube.GL
32import LambdaCube.GL.Type as T 31import LambdaCube.GL.Type as T
@@ -56,7 +55,7 @@ data MeshPrimitive
56 55
57data Mesh 56data Mesh
58 = Mesh 57 = Mesh
59 { mAttributes :: Map ByteString MeshAttribute 58 { mAttributes :: Map String MeshAttribute
60 , mPrimitive :: MeshPrimitive 59 , mPrimitive :: MeshPrimitive
61 , mGPUData :: Maybe GPUData 60 , mGPUData :: Maybe GPUData
62 } 61 }
@@ -64,7 +63,7 @@ data Mesh
64data GPUData 63data GPUData
65 = GPUData 64 = GPUData
66 { dPrimitive :: Primitive 65 { dPrimitive :: Primitive
67 , dStreams :: Map ByteString (Stream Buffer) 66 , dStreams :: Map String (Stream Buffer)
68 , dIndices :: Maybe (IndexStream Buffer) 67 , dIndices :: Maybe (IndexStream Buffer)
69 } 68 }
70 69
@@ -77,7 +76,7 @@ loadMesh n = uploadMeshToGPU =<< loadMesh' n
77saveMesh :: String -> Mesh -> IO () 76saveMesh :: String -> Mesh -> IO ()
78saveMesh n m = LB.writeFile n (encode m) 77saveMesh n m = LB.writeFile n (encode m)
79 78
80addMeshToObjectArray :: GLStorage -> ByteString -> [ByteString] -> Mesh -> IO Object 79addMeshToObjectArray :: GLStorage -> String -> [String] -> Mesh -> IO Object
81addMeshToObjectArray input slotName objUniNames (Mesh _ _ (Just (GPUData prim streams indices))) = do 80addMeshToObjectArray input slotName objUniNames (Mesh _ _ (Just (GPUData prim streams indices))) = do
82 -- select proper attributes 81 -- select proper attributes
83 let Just (ObjectArraySchema slotPrim slotStreams) = Map.lookup slotName $! objectArrays $! schema input 82 let Just (ObjectArraySchema slotPrim slotStreams) = Map.lookup slotName $! objectArrays $! schema input
@@ -109,7 +108,7 @@ meshAttrToStream b i (A_M44F v) = Stream Attribute_M44F b i 0 (V.length v)
109meshAttrToStream b i (A_Int v) = Stream Attribute_Int b i 0 (V.length v) 108meshAttrToStream b i (A_Int v) = Stream Attribute_Int b i 0 (V.length v)
110meshAttrToStream b i (A_Word v) = Stream Attribute_Word b i 0 (V.length v) 109meshAttrToStream b i (A_Word v) = Stream Attribute_Word b i 0 (V.length v)
111 110
112updateMesh :: Mesh -> [(ByteString,MeshAttribute)] -> Maybe MeshPrimitive -> IO () 111updateMesh :: Mesh -> [(String,MeshAttribute)] -> Maybe MeshPrimitive -> IO ()
113updateMesh (Mesh dMA dMP (Just (GPUData _ dS dI))) al mp = do 112updateMesh (Mesh dMA dMP (Just (GPUData _ dS dI))) al mp = do
114 -- check type match 113 -- check type match
115 let arrayChk (Array t1 s1 _) (Array t2 s2 _) = t1 == t2 && s1 == s2 114 let arrayChk (Array t1 s1 _) (Array t2 s2 _) = t1 == t2 && s1 == s2
diff --git a/src/LambdaCube/GL/Type.hs b/src/LambdaCube/GL/Type.hs
index c06032f..7f83a2a 100644
--- a/src/LambdaCube/GL/Type.hs
+++ b/src/LambdaCube/GL/Type.hs
@@ -1,7 +1,6 @@
1{-# LANGUAGE ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving, ScopedTypeVariables #-} 1{-# LANGUAGE ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving, ScopedTypeVariables #-}
2module LambdaCube.GL.Type where 2module LambdaCube.GL.Type where
3 3
4import Data.ByteString.Char8 (ByteString)
5import Data.IORef 4import Data.IORef
6import Data.Int 5import Data.Int
7import Data.IntMap (IntMap) 6import Data.IntMap (IntMap)
@@ -68,14 +67,14 @@ data ArrayDesc
68data ObjectArraySchema 67data ObjectArraySchema
69 = ObjectArraySchema 68 = ObjectArraySchema
70 { primitive :: FetchPrimitive 69 { primitive :: FetchPrimitive
71 , attributes :: Map ByteString StreamType 70 , attributes :: Map String StreamType
72 } 71 }
73 deriving Show 72 deriving Show
74 73
75data PipelineSchema 74data PipelineSchema
76 = PipelineSchema 75 = PipelineSchema
77 { objectArrays :: Map ByteString ObjectArraySchema 76 { objectArrays :: Map String ObjectArraySchema
78 , uniforms :: Map ByteString InputType 77 , uniforms :: Map String InputType
79 } 78 }
80 deriving Show 79 deriving Show
81 80
@@ -99,11 +98,11 @@ data GLSlot
99data GLStorage 98data GLStorage
100 = GLStorage 99 = GLStorage
101 { schema :: PipelineSchema 100 { schema :: PipelineSchema
102 , slotMap :: Map ByteString SlotName 101 , slotMap :: Map String SlotName
103 , slotVector :: Vector (IORef GLSlot) 102 , slotVector :: Vector (IORef GLSlot)
104 , objSeed :: IORef Int 103 , objSeed :: IORef Int
105 , uniformSetter :: Map ByteString InputSetter 104 , uniformSetter :: Map String InputSetter
106 , uniformSetup :: Map ByteString GLUniform 105 , uniformSetup :: Map String GLUniform
107 , screenSize :: IORef (Word,Word) 106 , screenSize :: IORef (Word,Word)
108 , pipelines :: IORef (Vector (Maybe GLRenderer)) -- attached pipelines 107 , pipelines :: IORef (Vector (Maybe GLRenderer)) -- attached pipelines
109 } 108 }
@@ -113,9 +112,9 @@ data Object -- internal type
113 { objSlot :: SlotName 112 { objSlot :: SlotName
114 , objPrimitive :: Primitive 113 , objPrimitive :: Primitive
115 , objIndices :: Maybe (IndexStream Buffer) 114 , objIndices :: Maybe (IndexStream Buffer)
116 , objAttributes :: Map ByteString (Stream Buffer) 115 , objAttributes :: Map String (Stream Buffer)
117 , objUniSetter :: Map ByteString InputSetter 116 , objUniSetter :: Map String InputSetter
118 , objUniSetup :: Map ByteString GLUniform 117 , objUniSetup :: Map String GLUniform
119 , objOrder :: IORef Int 118 , objOrder :: IORef Int
120 , objEnabled :: IORef Bool 119 , objEnabled :: IORef Bool
121 , objId :: Int 120 , objId :: Int
@@ -130,10 +129,10 @@ data GLProgram
130 = GLProgram 129 = GLProgram
131 { shaderObjects :: [GLuint] 130 { shaderObjects :: [GLuint]
132 , programObject :: GLuint 131 , programObject :: GLuint
133 , inputUniforms :: Map ByteString GLint 132 , inputUniforms :: Map String GLint
134 , inputTextures :: Map ByteString GLint -- all input textures (render texture + uniform texture) 133 , inputTextures :: Map String GLint -- all input textures (render texture + uniform texture)
135 , inputTextureUniforms :: Set ByteString 134 , inputTextureUniforms :: Set String
136 , inputStreams :: Map ByteString (GLuint,ByteString) 135 , inputStreams :: Map String (GLuint,String)
137 } 136 }
138 137
139data GLTexture 138data GLTexture
@@ -154,7 +153,7 @@ data GLStream
154 = GLStream 153 = GLStream
155 { glStreamCommands :: IORef [GLObjectCommand] 154 { glStreamCommands :: IORef [GLObjectCommand]
156 , glStreamPrimitive :: Primitive 155 , glStreamPrimitive :: Primitive
157 , glStreamAttributes :: Map ByteString (Stream Buffer) 156 , glStreamAttributes :: Map String (Stream Buffer)
158 , glStreamProgram :: ProgramName 157 , glStreamProgram :: ProgramName
159 } 158 }
160 159
@@ -167,9 +166,9 @@ data GLRenderer
167 , glCommands :: [GLCommand] 166 , glCommands :: [GLCommand]
168 , glSlotPrograms :: Vector [ProgramName] -- programs depend on a slot 167 , glSlotPrograms :: Vector [ProgramName] -- programs depend on a slot
169 , glInput :: IORef (Maybe InputConnection) 168 , glInput :: IORef (Maybe InputConnection)
170 , glSlotNames :: Vector ByteString 169 , glSlotNames :: Vector String
171 , glVAO :: GLuint 170 , glVAO :: GLuint
172 , glTexUnitMapping :: Map ByteString (IORef GLint) -- maps texture uniforms to texture units 171 , glTexUnitMapping :: Map String (IORef GLint) -- maps texture uniforms to texture units
173 , glStreams :: Vector GLStream 172 , glStreams :: Vector GLStream
174 } 173 }
175 174
diff --git a/src/LambdaCube/GL/Util.hs b/src/LambdaCube/GL/Util.hs
index 6c65628..c8449eb 100644
--- a/src/LambdaCube/GL/Util.hs
+++ b/src/LambdaCube/GL/Util.hs
@@ -1,4 +1,3 @@
1{-# LANGUAGE OverloadedStrings #-}
2module LambdaCube.GL.Util ( 1module LambdaCube.GL.Util (
3 queryUniforms, 2 queryUniforms,
4 queryStreams, 3 queryStreams,
@@ -27,18 +26,16 @@ module LambdaCube.GL.Util (
27 compileTexture, 26 compileTexture,
28 primitiveToFetchPrimitive, 27 primitiveToFetchPrimitive,
29 primitiveToGLType, 28 primitiveToGLType,
30 inputTypeToTextureTarget, 29 inputTypeToTextureTarget
31 toTrie
32) where 30) where
33 31
34import Control.Applicative 32import Control.Applicative
35import Control.Exception 33import Control.Exception
36import Control.Monad 34import Control.Monad
37import Data.ByteString.Char8 (ByteString,pack,unpack)
38import Data.IORef 35import Data.IORef
39import Data.List as L 36import Data.List as L
40import Foreign 37import Foreign
41import qualified Data.ByteString.Char8 as SB 38import Foreign.C.String
42import qualified Data.Vector as V 39import qualified Data.Vector as V
43import Data.Vector.Unboxed.Mutable (IOVector) 40import Data.Vector.Unboxed.Mutable (IOVector)
44import qualified Data.Vector.Unboxed.Mutable as MV 41import qualified Data.Vector.Unboxed.Mutable as MV
@@ -50,9 +47,6 @@ import Linear
50import IR 47import IR
51import LambdaCube.GL.Type 48import LambdaCube.GL.Type
52 49
53toTrie :: Map String a -> Map ByteString a
54toTrie m = Map.fromList [(pack k,v) | (k,v) <- Map.toList m]
55
56setSampler :: GLint -> Int32 -> IO () 50setSampler :: GLint -> Int32 -> IO ()
57setSampler i v = glUniform1i i $ fromIntegral v 51setSampler i v = glUniform1i i $ fromIntegral v
58 52
@@ -61,7 +55,7 @@ z3 = V3 0 0 0 :: V3F
61z4 = V4 0 0 0 0 :: V4F 55z4 = V4 0 0 0 0 :: V4F
62 56
63-- uniform functions 57-- uniform functions
64queryUniforms :: GLuint -> IO (Map ByteString GLint, Map ByteString InputType) 58queryUniforms :: GLuint -> IO (Map String GLint, Map String InputType)
65queryUniforms po = do 59queryUniforms po = do
66 ul <- getNameTypeSize po glGetActiveUniform glGetUniformLocation GL_ACTIVE_UNIFORMS GL_ACTIVE_UNIFORM_MAX_LENGTH 60 ul <- getNameTypeSize po glGetActiveUniform glGetUniformLocation GL_ACTIVE_UNIFORMS GL_ACTIVE_UNIFORM_MAX_LENGTH
67 let uNames = [n | (n,_,_,_) <- ul] 61 let uNames = [n | (n,_,_,_) <- ul]
@@ -136,7 +130,7 @@ setUniform i ty ref = do
136 _ -> fail $ "internal error (setUniform)! - " ++ show ty 130 _ -> fail $ "internal error (setUniform)! - " ++ show ty
137 131
138-- attribute functions 132-- attribute functions
139queryStreams :: GLuint -> IO (Map ByteString GLuint, Map ByteString InputType) 133queryStreams :: GLuint -> IO (Map String GLuint, Map String InputType)
140queryStreams po = do 134queryStreams po = do
141 al <- getNameTypeSize po glGetActiveAttrib glGetAttribLocation GL_ACTIVE_ATTRIBUTES GL_ACTIVE_ATTRIBUTE_MAX_LENGTH 135 al <- getNameTypeSize po glGetActiveAttrib glGetAttribLocation GL_ACTIVE_ATTRIBUTES GL_ACTIVE_ATTRIBUTE_MAX_LENGTH
142 let aNames = [n | (n,_,_,_) <- al] 136 let aNames = [n | (n,_,_,_) <- al]
@@ -191,13 +185,13 @@ setAV4F i v = with v $! \p -> glVertexAttrib4fv i $! castPtr p
191 185
192-- result list: [(name string,location,gl type,component count)] 186-- result list: [(name string,location,gl type,component count)]
193getNameTypeSize :: GLuint -> (GLuint -> GLuint -> GLsizei -> Ptr GLsizei -> Ptr GLint -> Ptr GLenum -> Ptr GLchar -> IO ()) 187getNameTypeSize :: GLuint -> (GLuint -> GLuint -> GLsizei -> Ptr GLsizei -> Ptr GLint -> Ptr GLenum -> Ptr GLchar -> IO ())
194 -> (GLuint -> Ptr GLchar -> IO GLint) -> GLenum -> GLenum -> IO [(ByteString,GLint,GLenum,GLint)] 188 -> (GLuint -> Ptr GLchar -> IO GLint) -> GLenum -> GLenum -> IO [(String,GLint,GLenum,GLint)]
195getNameTypeSize o f g enum enumLen = do 189getNameTypeSize o f g enum enumLen = do
196 nameLen <- glGetProgramiv1 enumLen o 190 nameLen <- glGetProgramiv1 enumLen o
197 allocaArray (fromIntegral nameLen) $! \namep -> alloca $! \sizep -> alloca $! \typep -> do 191 allocaArray (fromIntegral nameLen) $! \namep -> alloca $! \sizep -> alloca $! \typep -> do
198 n <- glGetProgramiv1 enum o 192 n <- glGetProgramiv1 enum o
199 forM [0..n-1] $! \i -> f o (fromIntegral i) (fromIntegral nameLen) nullPtr sizep typep namep >> 193 forM [0..n-1] $! \i -> f o (fromIntegral i) (fromIntegral nameLen) nullPtr sizep typep namep >>
200 (,,,) <$> SB.packCString (castPtr namep) <*> g o namep <*> peek typep <*> peek sizep 194 (,,,) <$> peekCString (castPtr namep) <*> g o namep <*> peek typep <*> peek sizep
201 195
202fromGLType :: (GLenum,GLint) -> InputType 196fromGLType :: (GLenum,GLint) -> InputType
203fromGLType (t,1) 197fromGLType (t,1)
@@ -272,8 +266,8 @@ printShaderLog o = do
272 alloca $ \sizePtr -> allocaArray (fromIntegral i) $! \ps -> do 266 alloca $ \sizePtr -> allocaArray (fromIntegral i) $! \ps -> do
273 glGetShaderInfoLog o (fromIntegral i) sizePtr ps 267 glGetShaderInfoLog o (fromIntegral i) sizePtr ps
274 size <- peek sizePtr 268 size <- peek sizePtr
275 log <- SB.packCStringLen (castPtr ps, fromIntegral size) 269 log <- peekCStringLen (castPtr ps, fromIntegral size)
276 SB.putStrLn log 270 putStrLn log
277 271
278glGetShaderiv1 :: GLenum -> GLuint -> IO GLint 272glGetShaderiv1 :: GLenum -> GLuint -> IO GLint
279glGetShaderiv1 pname o = alloca $! \pi -> glGetShaderiv o pname pi >> peek pi 273glGetShaderiv1 pname o = alloca $! \pi -> glGetShaderiv o pname pi >> peek pi
@@ -288,18 +282,18 @@ printProgramLog o = do
288 alloca $ \sizePtr -> allocaArray (fromIntegral i) $! \ps -> do 282 alloca $ \sizePtr -> allocaArray (fromIntegral i) $! \ps -> do
289 glGetProgramInfoLog o (fromIntegral i) sizePtr ps 283 glGetProgramInfoLog o (fromIntegral i) sizePtr ps
290 size <- peek sizePtr 284 size <- peek sizePtr
291 log <- SB.packCStringLen (castPtr ps, fromIntegral size) 285 log <- peekCStringLen (castPtr ps, fromIntegral size)
292 SB.putStrLn log 286 putStrLn log
293 287
294compileShader :: GLuint -> [ByteString] -> IO () 288compileShader :: GLuint -> [String] -> IO ()
295compileShader o srcl = withMany SB.useAsCString srcl $! \l -> withArray l $! \p -> do 289compileShader o srcl = withMany withCString srcl $! \l -> withArray l $! \p -> do
296 glShaderSource o (fromIntegral $! length srcl) (castPtr p) nullPtr 290 glShaderSource o (fromIntegral $! length srcl) (castPtr p) nullPtr
297 glCompileShader o 291 glCompileShader o
298 printShaderLog o 292 printShaderLog o
299 status <- glGetShaderiv1 GL_COMPILE_STATUS o 293 status <- glGetShaderiv1 GL_COMPILE_STATUS o
300 when (status /= fromIntegral GL_TRUE) $ fail "compileShader failed!" 294 when (status /= fromIntegral GL_TRUE) $ fail "compileShader failed!"
301 295
302checkGL :: IO ByteString 296checkGL :: IO String
303checkGL = do 297checkGL = do
304 let f e | e == GL_INVALID_ENUM = "INVALID_ENUM" 298 let f e | e == GL_INVALID_ENUM = "INVALID_ENUM"
305 | e == GL_INVALID_VALUE = "INVALID_VALUE" 299 | e == GL_INVALID_VALUE = "INVALID_VALUE"
@@ -478,7 +472,7 @@ Texture and renderbuffer color formats (R):
478glGetIntegerv1 :: GLenum -> IO GLint 472glGetIntegerv1 :: GLenum -> IO GLint
479glGetIntegerv1 e = alloca $ \pi -> glGetIntegerv e pi >> peek pi 473glGetIntegerv1 e = alloca $ \pi -> glGetIntegerv e pi >> peek pi
480 474
481checkFBO :: IO ByteString 475checkFBO :: IO String
482checkFBO = do 476checkFBO = do
483 let f e | e == GL_FRAMEBUFFER_UNDEFINED = "FRAMEBUFFER_UNDEFINED" 477 let f e | e == GL_FRAMEBUFFER_UNDEFINED = "FRAMEBUFFER_UNDEFINED"
484 | e == GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT = "FRAMEBUFFER_INCOMPLETE_ATTACHMENT" 478 | e == GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT = "FRAMEBUFFER_INCOMPLETE_ATTACHMENT"
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-05 05:47:56 +0000