add updateObjectUniforms

3 files changed, 12 insertions, 5 deletions

diff --git a/lambdacube-gl.cabal b/lambdacube-gl.cabal
index 9a2e16a..4f8d733 100644
--- a/lambdacube-gl.cabal
+++ b/lambdacube-gl.cabal
@@ -1,5 +1,5 @@
 name:                lambdacube-gl
-version:             0.5.0.5
+version:             0.5.1.0
 synopsis:            OpenGL 3.3 Core Profile backend for LambdaCube 3D
 description:         OpenGL 3.3 Core Profile backend for LambdaCube 3D
 homepage:            http://lambdacube3d.com
diff --git a/src/LambdaCube/GL.hs b/src/LambdaCube/GL.hs
index 2b5c814..f852eab 100644
--- a/src/LambdaCube/GL.hs
+++ b/src/LambdaCube/GL.hs
@@ -90,7 +90,8 @@ module LambdaCube.GL (
     makeSchema,
 
     (@=),
-    updateUniforms
+    updateUniforms,
+    updateObjectUniforms
 ) where
 
 import LambdaCube.GL.Type
diff --git a/src/LambdaCube/GL/Input.hs b/src/LambdaCube/GL/Input.hs
index 7a3b809..00b2773 100644
--- a/src/LambdaCube/GL/Input.hs
+++ b/src/LambdaCube/GL/Input.hs
@@ -394,12 +394,12 @@ uniformFTexture2D n is = case Map.lookup n is of
     Just (SFTexture2D fun)    -> fun
     _   -> nullSetter n "FTexture2D"
 
-type UniM = Writer [GLStorage -> IO ()]
+type UniM = Writer [Map GLUniformName InputSetter -> IO ()]
 
 class UniformSetter a where
   (@=) :: GLUniformName -> IO a -> UniM ()
 
-setUniM setUni n act = tell [\s -> let f = setUni n (uniformSetter s) in f =<< act]
+setUniM setUni n act = tell [\s -> let f = setUni n s in f =<< act]
 
 instance UniformSetter Bool   where (@=) = setUniM uniformBool
 instance UniformSetter V2B    where (@=) = setUniM uniformV2B
@@ -428,4 +428,10 @@ instance UniformSetter M43F   where (@=) = setUniM uniformM43F
 instance UniformSetter M44F   where (@=) = setUniM uniformM44F
 instance UniformSetter TextureData where (@=) = setUniM uniformFTexture2D
 
-updateUniforms storage m = sequence_ $ let l = map ($ storage) $ execWriter m in l
+updateUniforms storage m = sequence_ l where
+  setters = uniformSetter storage
+  l = map ($ setters) $ execWriter m
+
+updateObjectUniforms object m = sequence_ l where
+  setters = objectUniformSetter object
+  l = map ($ setters) $ execWriter m