diff options
Diffstat (limited to 'src/LambdaCube')
-rw-r--r-- | src/LambdaCube/GL/Input.hs | 74 | ||||
-rw-r--r-- | src/LambdaCube/GL/Type.hs | 7 |
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 | |||
14 | import qualified Data.Map as Map | 14 | import qualified Data.Map as Map |
15 | import qualified Data.Vector as V | 15 | import qualified Data.Vector as V |
16 | import qualified Data.Vector.Algorithms.Intro as I | 16 | import qualified Data.Vector.Algorithms.Intro as I |
17 | import Data.ByteString.Char8 (ByteString) | ||
18 | import qualified Data.ByteString.Char8 as SB | ||
17 | 19 | ||
18 | import Graphics.GL.Core33 | 20 | import 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 | ||
39 | mkUniform :: [(String,InputType)] -> IO (Map String InputSetter, Map String GLUniform) | 41 | mkUniform :: [(String,InputType)] -> IO (Map GLUniformName InputSetter, Map String GLUniform) |
40 | mkUniform l = do | 42 | mkUniform 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 | ||
150 | objectUniformSetter :: Object -> Map String InputSetter | 152 | objectUniformSetter :: Object -> Map GLUniformName InputSetter |
151 | objectUniformSetter = objUniSetter | 153 | objectUniformSetter = objUniSetter |
152 | 154 | ||
153 | setScreenSize :: GLStorage -> Word -> Word -> IO () | 155 | setScreenSize :: 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 | ||
248 | nullSetter :: String -> String -> a -> IO () | 250 | nullSetter :: 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 |
250 | nullSetter n t _ = Prelude.putStrLn $ "WARNING: unknown uniform: " ++ n ++ " :: " ++ t | 252 | nullSetter n t _ = Prelude.putStrLn $ "WARNING: unknown uniform: " ++ show n ++ " :: " ++ t |
251 | 253 | ||
252 | uniformBool :: String -> Map String InputSetter -> SetterFun Bool | 254 | uniformBool :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun Bool |
253 | uniformV2B :: String -> Map String InputSetter -> SetterFun V2B | 255 | uniformV2B :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun V2B |
254 | uniformV3B :: String -> Map String InputSetter -> SetterFun V3B | 256 | uniformV3B :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun V3B |
255 | uniformV4B :: String -> Map String InputSetter -> SetterFun V4B | 257 | uniformV4B :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun V4B |
256 | 258 | ||
257 | uniformWord :: String -> Map String InputSetter -> SetterFun Word32 | 259 | uniformWord :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun Word32 |
258 | uniformV2U :: String -> Map String InputSetter -> SetterFun V2U | 260 | uniformV2U :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun V2U |
259 | uniformV3U :: String -> Map String InputSetter -> SetterFun V3U | 261 | uniformV3U :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun V3U |
260 | uniformV4U :: String -> Map String InputSetter -> SetterFun V4U | 262 | uniformV4U :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun V4U |
261 | 263 | ||
262 | uniformInt :: String -> Map String InputSetter -> SetterFun Int32 | 264 | uniformInt :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun Int32 |
263 | uniformV2I :: String -> Map String InputSetter -> SetterFun V2I | 265 | uniformV2I :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun V2I |
264 | uniformV3I :: String -> Map String InputSetter -> SetterFun V3I | 266 | uniformV3I :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun V3I |
265 | uniformV4I :: String -> Map String InputSetter -> SetterFun V4I | 267 | uniformV4I :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun V4I |
266 | 268 | ||
267 | uniformFloat :: String -> Map String InputSetter -> SetterFun Float | 269 | uniformFloat :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun Float |
268 | uniformV2F :: String -> Map String InputSetter -> SetterFun V2F | 270 | uniformV2F :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun V2F |
269 | uniformV3F :: String -> Map String InputSetter -> SetterFun V3F | 271 | uniformV3F :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun V3F |
270 | uniformV4F :: String -> Map String InputSetter -> SetterFun V4F | 272 | uniformV4F :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun V4F |
271 | 273 | ||
272 | uniformM22F :: String -> Map String InputSetter -> SetterFun M22F | 274 | uniformM22F :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun M22F |
273 | uniformM23F :: String -> Map String InputSetter -> SetterFun M23F | 275 | uniformM23F :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun M23F |
274 | uniformM24F :: String -> Map String InputSetter -> SetterFun M24F | 276 | uniformM24F :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun M24F |
275 | uniformM32F :: String -> Map String InputSetter -> SetterFun M32F | 277 | uniformM32F :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun M32F |
276 | uniformM33F :: String -> Map String InputSetter -> SetterFun M33F | 278 | uniformM33F :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun M33F |
277 | uniformM34F :: String -> Map String InputSetter -> SetterFun M34F | 279 | uniformM34F :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun M34F |
278 | uniformM42F :: String -> Map String InputSetter -> SetterFun M42F | 280 | uniformM42F :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun M42F |
279 | uniformM43F :: String -> Map String InputSetter -> SetterFun M43F | 281 | uniformM43F :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun M43F |
280 | uniformM44F :: String -> Map String InputSetter -> SetterFun M44F | 282 | uniformM44F :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun M44F |
281 | 283 | ||
282 | uniformFTexture2D :: String -> Map String InputSetter -> SetterFun TextureData | 284 | uniformFTexture2D :: GLUniformName -> Map GLUniformName InputSetter -> SetterFun TextureData |
283 | 285 | ||
284 | uniformBool n is = case Map.lookup n is of | 286 | uniformBool 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) | |||
10 | import Data.Word | 10 | import Data.Word |
11 | import Foreign.Ptr | 11 | import Foreign.Ptr |
12 | import Foreign.Storable | 12 | import Foreign.Storable |
13 | import Data.ByteString | ||
13 | 14 | ||
14 | import Graphics.GL.Core33 | 15 | import Graphics.GL.Core33 |
15 | 16 | ||
16 | import Linear | 17 | import Linear |
17 | import IR | 18 | import IR |
18 | 19 | ||
20 | type 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 |