diff options
Diffstat (limited to 'src/LambdaCube/GL/Input.hs')
-rw-r--r-- | src/LambdaCube/GL/Input.hs | 3 |
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 ()] | |||
397 | class UniformSetter a where | 397 | class UniformSetter a where |
398 | (@=) :: GLUniformName -> IO a -> UniM () | 398 | (@=) :: GLUniformName -> IO a -> UniM () |
399 | 399 | ||
400 | setUniM :: (n -> Map GLUniformName InputSetter -> a -> IO ()) -> n -> IO a -> UniM () | ||
400 | setUniM setUni n act = tell [\s -> let f = setUni n s in f =<< act] | 401 | setUniM setUni n act = tell [\s -> let f = setUni n s in f =<< act] |
401 | 402 | ||
402 | instance UniformSetter Bool where (@=) = setUniM uniformBool | 403 | instance UniformSetter Bool where (@=) = setUniM uniformBool |
@@ -426,10 +427,12 @@ instance UniformSetter M43F where (@=) = setUniM uniformM43F | |||
426 | instance UniformSetter M44F where (@=) = setUniM uniformM44F | 427 | instance UniformSetter M44F where (@=) = setUniM uniformM44F |
427 | instance UniformSetter TextureData where (@=) = setUniM uniformFTexture2D | 428 | instance UniformSetter TextureData where (@=) = setUniM uniformFTexture2D |
428 | 429 | ||
430 | updateUniforms :: GLStorage -> UniM a -> IO () | ||
429 | updateUniforms storage m = sequence_ l where | 431 | updateUniforms 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 | ||
435 | updateObjectUniforms :: Object -> UniM a -> IO () | ||
433 | updateObjectUniforms object m = sequence_ l where | 436 | updateObjectUniforms 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 |