summaryrefslogtreecommitdiff
path: root/src/LambdaCube/GL
diff options
context:
space:
mode:
Diffstat (limited to 'src/LambdaCube/GL')
-rw-r--r--src/LambdaCube/GL/Input.hs12
1 files changed, 9 insertions, 3 deletions
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
394 Just (SFTexture2D fun) -> fun 394 Just (SFTexture2D fun) -> fun
395 _ -> nullSetter n "FTexture2D" 395 _ -> nullSetter n "FTexture2D"
396 396
397type UniM = Writer [GLStorage -> IO ()] 397type UniM = Writer [Map GLUniformName InputSetter -> IO ()]
398 398
399class UniformSetter a where 399class UniformSetter a where
400 (@=) :: GLUniformName -> IO a -> UniM () 400 (@=) :: GLUniformName -> IO a -> UniM ()
401 401
402setUniM setUni n act = tell [\s -> let f = setUni n (uniformSetter s) in f =<< act] 402setUniM setUni n act = tell [\s -> let f = setUni n s in f =<< act]
403 403
404instance UniformSetter Bool where (@=) = setUniM uniformBool 404instance UniformSetter Bool where (@=) = setUniM uniformBool
405instance UniformSetter V2B where (@=) = setUniM uniformV2B 405instance UniformSetter V2B where (@=) = setUniM uniformV2B
@@ -428,4 +428,10 @@ instance UniformSetter M43F where (@=) = setUniM uniformM43F
428instance UniformSetter M44F where (@=) = setUniM uniformM44F 428instance UniformSetter M44F where (@=) = setUniM uniformM44F
429instance UniformSetter TextureData where (@=) = setUniM uniformFTexture2D 429instance UniformSetter TextureData where (@=) = setUniM uniformFTexture2D
430 430
431updateUniforms storage m = sequence_ $ let l = map ($ storage) $ execWriter m in l 431updateUniforms storage m = sequence_ l where
432 setters = uniformSetter storage
433 l = map ($ setters) $ execWriter m
434
435updateObjectUniforms object m = sequence_ l where
436 setters = objectUniformSetter object
437 l = map ($ setters) $ execWriter m