summaryrefslogtreecommitdiff
path: root/src/LambdaCube/GL/Input.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/LambdaCube/GL/Input.hs')
-rw-r--r--src/LambdaCube/GL/Input.hs74
1 files changed, 38 insertions, 36 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