From 9d06d5a3b467ddf56147f87531fb56b35375dbd2 Mon Sep 17 00:00:00 2001
From: Csaba Hruska <csaba.hruska@gmail.com>
Date: Sun, 10 Jul 2016 14:57:22 +0200
Subject: add updateObjectUniforms

---
 src/LambdaCube/GL/Input.hs | 12 +++++++++---
 1 file changed, 9 insertions(+), 3 deletions(-)

(limited to 'src/LambdaCube/GL')

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
-- 
cgit v1.2.3