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