summaryrefslogtreecommitdiff
path: root/src/LambdaCube/GL
diff options
context:
space:
mode:
Diffstat (limited to 'src/LambdaCube/GL')
-rw-r--r--src/LambdaCube/GL/Input.hs74
-rw-r--r--src/LambdaCube/GL/Type.hs7
2 files changed, 43 insertions, 38 deletions
diff --git a/src/LambdaCube/GL/Input.hs b/src/LambdaCube/GL/Input.hs
index f2216fb..596563a 100644
--- a/src/LambdaCube/GL/Input.hs
+++ b/src/LambdaCube/GL/Input.hs
@@ -14,6 +14,8 @@ import qualified Data.Set as S
14import qualified Data.Map as Map 14import qualified Data.Map as Map
15import qualified Data.Vector as V 15import qualified Data.Vector as V
16import qualified Data.Vector.Algorithms.Intro as I 16import qualified Data.Vector.Algorithms.Intro as I
17import Data.ByteString.Char8 (ByteString)
18import qualified Data.ByteString.Char8 as SB
17 19
18import Graphics.GL.Core33 20import Graphics.GL.Core33
19 21
@@ -36,7 +38,7 @@ schemaFromPipeline a = PipelineSchema (Map.fromList sl) (foldl Map.union Map.emp
36 Just v -> v 38 Just v -> v
37 Nothing -> error "internal error (schemaFromPipeline)" 39 Nothing -> error "internal error (schemaFromPipeline)"
38 40
39mkUniform :: [(String,InputType)] -> IO (Map String InputSetter, Map String GLUniform) 41mkUniform :: [(String,InputType)] -> IO (Map GLUniformName InputSetter, Map String GLUniform)
40mkUniform l = do 42mkUniform l = do
41 unisAndSetters <- forM l $ \(n,t) -> do 43 unisAndSetters <- forM l $ \(n,t) -> do
42 (uni, setter) <- mkUniformSetter t 44 (uni, setter) <- mkUniformSetter t
@@ -147,7 +149,7 @@ setObjectOrder p obj i = do
147 writeIORef (objOrder obj) i 149 writeIORef (objOrder obj) i
148 modifyIORef (slotVector p ! objSlot obj) $ \(GLSlot objs sorted _) -> GLSlot objs sorted Reorder 150 modifyIORef (slotVector p ! objSlot obj) $ \(GLSlot objs sorted _) -> GLSlot objs sorted Reorder
149 151
150objectUniformSetter :: Object -> Map String InputSetter 152objectUniformSetter :: Object -> Map GLUniformName InputSetter
151objectUniformSetter = objUniSetter 153objectUniformSetter = objUniSetter
152 154
153setScreenSize :: GLStorage -> Word -> Word -> IO () 155setScreenSize :: GLStorage -> Word -> Word -> IO ()
@@ -245,41 +247,41 @@ createObjectCommands texUnitMap topUnis obj prg = objUniCmds ++ objStreamCmds ++
245 -- constant generic attribute 247 -- constant generic attribute
246 constAttr -> GLSetVertexAttrib i constAttr 248 constAttr -> GLSetVertexAttrib i constAttr
247 249
248nullSetter :: String -> String -> a -> IO () 250nullSetter :: GLUniformName -> String -> a -> IO ()
249--nullSetter n t _ = return () -- Prelude.putStrLn $ "WARNING: unknown uniform: " ++ SB.unpack n ++ " :: " ++ t 251--nullSetter n t _ = return () -- Prelude.putStrLn $ "WARNING: unknown uniform: " ++ SB.unpack n ++ " :: " ++ t
250nullSetter n t _ = Prelude.putStrLn $ "WARNING: unknown uniform: " ++ n ++ " :: " ++ t 252nullSetter n t _ = Prelude.putStrLn $ "WARNING: unknown uniform: " ++ show n ++ " :: " ++ t
251 253
252uniformBool :: String -> Map String InputSetter -> SetterFun Bool 254uniformBool :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun Bool
253uniformV2B :: String -> Map String InputSetter -> SetterFun V2B 255uniformV2B :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun V2B
254uniformV3B :: String -> Map String InputSetter -> SetterFun V3B 256uniformV3B :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun V3B
255uniformV4B :: String -> Map String InputSetter -> SetterFun V4B 257uniformV4B :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun V4B
256 258
257uniformWord :: String -> Map String InputSetter -> SetterFun Word32 259uniformWord :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun Word32
258uniformV2U :: String -> Map String InputSetter -> SetterFun V2U 260uniformV2U :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun V2U
259uniformV3U :: String -> Map String InputSetter -> SetterFun V3U 261uniformV3U :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun V3U
260uniformV4U :: String -> Map String InputSetter -> SetterFun V4U 262uniformV4U :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun V4U
261 263
262uniformInt :: String -> Map String InputSetter -> SetterFun Int32 264uniformInt :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun Int32
263uniformV2I :: String -> Map String InputSetter -> SetterFun V2I 265uniformV2I :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun V2I
264uniformV3I :: String -> Map String InputSetter -> SetterFun V3I 266uniformV3I :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun V3I
265uniformV4I :: String -> Map String InputSetter -> SetterFun V4I 267uniformV4I :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun V4I
266 268
267uniformFloat :: String -> Map String InputSetter -> SetterFun Float 269uniformFloat :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun Float
268uniformV2F :: String -> Map String InputSetter -> SetterFun V2F 270uniformV2F :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun V2F
269uniformV3F :: String -> Map String InputSetter -> SetterFun V3F 271uniformV3F :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun V3F
270uniformV4F :: String -> Map String InputSetter -> SetterFun V4F 272uniformV4F :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun V4F
271 273
272uniformM22F :: String -> Map String InputSetter -> SetterFun M22F 274uniformM22F :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun M22F
273uniformM23F :: String -> Map String InputSetter -> SetterFun M23F 275uniformM23F :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun M23F
274uniformM24F :: String -> Map String InputSetter -> SetterFun M24F 276uniformM24F :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun M24F
275uniformM32F :: String -> Map String InputSetter -> SetterFun M32F 277uniformM32F :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun M32F
276uniformM33F :: String -> Map String InputSetter -> SetterFun M33F 278uniformM33F :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun M33F
277uniformM34F :: String -> Map String InputSetter -> SetterFun M34F 279uniformM34F :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun M34F
278uniformM42F :: String -> Map String InputSetter -> SetterFun M42F 280uniformM42F :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun M42F
279uniformM43F :: String -> Map String InputSetter -> SetterFun M43F 281uniformM43F :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun M43F
280uniformM44F :: String -> Map String InputSetter -> SetterFun M44F 282uniformM44F :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun M44F
281 283
282uniformFTexture2D :: String -> Map String InputSetter -> SetterFun TextureData 284uniformFTexture2D :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun TextureData
283 285
284uniformBool n is = case Map.lookup n is of 286uniformBool n is = case Map.lookup n is of
285 Just (SBool fun) -> fun 287 Just (SBool fun) -> fun
diff --git a/src/LambdaCube/GL/Type.hs b/src/LambdaCube/GL/Type.hs
index 7f83a2a..ebd0582 100644
--- a/src/LambdaCube/GL/Type.hs
+++ b/src/LambdaCube/GL/Type.hs
@@ -10,12 +10,15 @@ import Data.Vector (Vector)
10import Data.Word 10import Data.Word
11import Foreign.Ptr 11import Foreign.Ptr
12import Foreign.Storable 12import Foreign.Storable
13import Data.ByteString
13 14
14import Graphics.GL.Core33 15import Graphics.GL.Core33
15 16
16import Linear 17import Linear
17import IR 18import IR
18 19
20type GLUniformName = String -- ByteString
21
19--------------- 22---------------
20-- Input API -- 23-- Input API --
21--------------- 24---------------
@@ -101,7 +104,7 @@ data GLStorage
101 , slotMap :: Map String SlotName 104 , slotMap :: Map String SlotName
102 , slotVector :: Vector (IORef GLSlot) 105 , slotVector :: Vector (IORef GLSlot)
103 , objSeed :: IORef Int 106 , objSeed :: IORef Int
104 , uniformSetter :: Map String InputSetter 107 , uniformSetter :: Map GLUniformName InputSetter
105 , uniformSetup :: Map String GLUniform 108 , uniformSetup :: Map String GLUniform
106 , screenSize :: IORef (Word,Word) 109 , screenSize :: IORef (Word,Word)
107 , pipelines :: IORef (Vector (Maybe GLRenderer)) -- attached pipelines 110 , pipelines :: IORef (Vector (Maybe GLRenderer)) -- attached pipelines
@@ -113,7 +116,7 @@ data Object -- internal type
113 , objPrimitive :: Primitive 116 , objPrimitive :: Primitive
114 , objIndices :: Maybe (IndexStream Buffer) 117 , objIndices :: Maybe (IndexStream Buffer)
115 , objAttributes :: Map String (Stream Buffer) 118 , objAttributes :: Map String (Stream Buffer)
116 , objUniSetter :: Map String InputSetter 119 , objUniSetter :: Map GLUniformName InputSetter
117 , objUniSetup :: Map String GLUniform 120 , objUniSetup :: Map String GLUniform
118 , objOrder :: IORef Int 121 , objOrder :: IORef Int
119 , objEnabled :: IORef Bool 122 , objEnabled :: IORef Bool