summaryrefslogtreecommitdiff
path: root/src/LambdaCube/GL/Input.hs
diff options
context:
space:
mode:
authorCsaba Hruska <csaba.hruska@gmail.com>2016-01-08 15:21:39 +0100
committerCsaba Hruska <csaba.hruska@gmail.com>2016-01-08 15:21:39 +0100
commitd53f8b4e66612a968431aa7ffff32058f2e02c3b (patch)
tree3737cd37c8ec33d494f2f295119085bb4dae1019 /src/LambdaCube/GL/Input.hs
parent2cc82723838be8f9fc084c7582bbc87f26e1a794 (diff)
use String instead og ByteString
Diffstat (limited to 'src/LambdaCube/GL/Input.hs')
-rw-r--r--src/LambdaCube/GL/Input.hs82
1 files changed, 40 insertions, 42 deletions
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