blob: a315349b5296cf2658be990ca82a02fb18026fe3 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
|
module GPURing where
import Control.Monad.Writer
import Data.Data
import Data.Dependent.Sum
import Data.Function
import Data.Typeable
import AttributeData
import RingBuffer
import MaskableStream
import LambdaCube.GL as LC hiding (updateBuffer)
import LambdaCube.GL.Data hiding (updateBuffer) -- (uploadCubeMapToGPU,uploadTextureBufferToGPU,updateTextureBuffer)
import LambdaCube.GL.Mesh as LC
import LambdaCube.GL.Type
import LambdaCube.IR as LC
import LambdaCube.GL.Util
import LambdaCube.GL.Input.Type
import LambdaCube.GL.Input hiding (createObjectCommands)
type Update keys = (keys -> Writer [DSum AttributeKey GLUniformValue] ())
new :: Data keys => Primitive -> String -> GLStorage -> (String -> String) -> Int -> IO (TargetBuffer (Update keys))
new prim streamName storage toAttr sz = fix $ \retProxy -> do
let paramProxy = paramProxy' retProxy
where paramProxy' :: io (targetbuffer (keys -> writer)) -> Proxy keys
paramProxy' _ = Proxy
let ps = fieldParameters paramProxy toAttr
putStrLn $ "Ring params: " ++ show ps
gd0 <- uploadDynamicBuffer sz ps
let gd = gd0 { dPrimitive = prim }
Just keys <- return $ lookupAttrKeys (lookupAttributeKey gd . toAttr)
obj <- addToObjectArray storage streamName [] gd
-- readIORef (objCommands obj) >>= mapM_ print
return TargetBuffer
{ syncBuffer = \mask -> do updateCommands storage obj mask
return ()
, updateBuffer = \i u -> do updateAttributes i $ u keys
return ()
}
|