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.hs3
1 files changed, 3 insertions, 0 deletions
diff --git a/src/LambdaCube/GL/Input.hs b/src/LambdaCube/GL/Input.hs
index 30125d9..5d2a49e 100644
--- a/src/LambdaCube/GL/Input.hs
+++ b/src/LambdaCube/GL/Input.hs
@@ -397,6 +397,7 @@ type UniM = Writer [Map GLUniformName InputSetter -> IO ()]
397class UniformSetter a where 397class UniformSetter a where
398 (@=) :: GLUniformName -> IO a -> UniM () 398 (@=) :: GLUniformName -> IO a -> UniM ()
399 399
400setUniM :: (n -> Map GLUniformName InputSetter -> a -> IO ()) -> n -> IO a -> UniM ()
400setUniM setUni n act = tell [\s -> let f = setUni n s in f =<< act] 401setUniM setUni n act = tell [\s -> let f = setUni n s in f =<< act]
401 402
402instance UniformSetter Bool where (@=) = setUniM uniformBool 403instance UniformSetter Bool where (@=) = setUniM uniformBool
@@ -426,10 +427,12 @@ instance UniformSetter M43F where (@=) = setUniM uniformM43F
426instance UniformSetter M44F where (@=) = setUniM uniformM44F 427instance UniformSetter M44F where (@=) = setUniM uniformM44F
427instance UniformSetter TextureData where (@=) = setUniM uniformFTexture2D 428instance UniformSetter TextureData where (@=) = setUniM uniformFTexture2D
428 429
430updateUniforms :: GLStorage -> UniM a -> IO ()
429updateUniforms storage m = sequence_ l where 431updateUniforms storage m = sequence_ l where
430 setters = uniformSetter storage 432 setters = uniformSetter storage
431 l = map ($ setters) $ execWriter m 433 l = map ($ setters) $ execWriter m
432 434
435updateObjectUniforms :: Object -> UniM a -> IO ()
433updateObjectUniforms object m = sequence_ l where 436updateObjectUniforms object m = sequence_ l where
434 setters = objectUniformSetter object 437 setters = objectUniformSetter object
435 l = map ($ setters) $ execWriter m 438 l = map ($ setters) $ execWriter m