summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoe Crayne <joe@jerkface.net>2019-06-03 22:18:44 -0400
committerJoe Crayne <joe@jerkface.net>2019-06-03 22:18:44 -0400
commit07bcb2a2e4c52b0a0f3c34bc1a70772e4ab2dbb5 (patch)
tree4f7405a8cee50937386cd0ccf90d0498a96dc781
parentf3ac5a8de1c86792517f6e6db56c370f330055bb (diff)
Specify stream name for GPU-ringbuffers.
-rw-r--r--GPURing.hs6
-rw-r--r--MeshSketch.hs2
2 files changed, 4 insertions, 4 deletions
diff --git a/GPURing.hs b/GPURing.hs
index d5f46af..3002c9e 100644
--- a/GPURing.hs
+++ b/GPURing.hs
@@ -25,8 +25,8 @@ import LambdaCube.GL.Input hiding (createObjectCommands)
25-- > ringBuffer <- newRing capacity (VectorRing.new capacity) 25-- > ringBuffer <- newRing capacity (VectorRing.new capacity)
26type Update keys = (keys -> Writer [DSum AttributeKey GLUniformValue] ()) 26type Update keys = (keys -> Writer [DSum AttributeKey GLUniformValue] ())
27 27
28new :: Data keys => GLStorage -> (String -> String) -> Int -> IO (TargetBuffer (Update keys)) 28new :: Data keys => String -> GLStorage -> (String -> String) -> Int -> IO (TargetBuffer (Update keys))
29new storage toAttr sz = fix $ \retProxy -> do 29new streamName storage toAttr sz = fix $ \retProxy -> do
30 let paramProxy = paramProxy' retProxy 30 let paramProxy = paramProxy' retProxy
31 where paramProxy' :: io (targetbuffer (keys -> writer)) -> Proxy keys 31 where paramProxy' :: io (targetbuffer (keys -> writer)) -> Proxy keys
32 paramProxy' _ = Proxy 32 paramProxy' _ = Proxy
@@ -35,7 +35,7 @@ new storage toAttr sz = fix $ \retProxy -> do
35 gd0 <- uploadDynamicBuffer sz ps 35 gd0 <- uploadDynamicBuffer sz ps
36 let gd = gd0 { dPrimitive = LineStrip } 36 let gd = gd0 { dPrimitive = LineStrip }
37 Just keys <- return $ lookupAttrKeys (lookupAttributeKey gd . toAttr) 37 Just keys <- return $ lookupAttrKeys (lookupAttributeKey gd . toAttr)
38 obj <- addToObjectArray storage "Points" [] gd 38 obj <- addToObjectArray storage streamName [] gd
39 -- readIORef (objCommands obj) >>= mapM_ print 39 -- readIORef (objCommands obj) >>= mapM_ print
40 return TargetBuffer 40 return TargetBuffer
41 { syncBuffer = \mask -> do updateCommands storage obj mask 41 { syncBuffer = \mask -> do updateCommands storage obj mask
diff --git a/MeshSketch.hs b/MeshSketch.hs
index 15af94f..dc0adf1 100644
--- a/MeshSketch.hs
+++ b/MeshSketch.hs
@@ -172,7 +172,7 @@ uploadState obj glarea storage = do
172 let bufsize = 1000 172 let bufsize = 1000
173 v <- MV.unsafeNew bufsize 173 v <- MV.unsafeNew bufsize
174 pts <- newRing bufsize (Vector.new v) 174 pts <- newRing bufsize (Vector.new v)
175 ring <- newRing bufsize (GPU.new storage ringPointAttr bufsize) 175 ring <- newRing bufsize (GPU.new "Points" storage ringPointAttr bufsize)
176 176
177 -- setup FrameClock 177 -- setup FrameClock
178 w <- toWidget glarea 178 w <- toWidget glarea