1 files changed, 46 insertions, 0 deletions

diff --git a/GPURing.hs b/GPURing.hs
new file mode 100644
index 0000000..d5f46af
--- /dev/null
+++ b/GPURing.hs
@@ -0,0 +1,46 @@
+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)
+
+
+-- | Typical usage:
+--
+-- > ringBuffer <- newRing capacity (VectorRing.new capacity)
+type Update keys = (keys -> Writer [DSum AttributeKey GLUniformValue] ())
+
+new :: Data keys => GLStorage -> (String -> String) -> Int -> IO (TargetBuffer (Update keys))
+new 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 = LineStrip }
+    Just keys <- return $ lookupAttrKeys (lookupAttributeKey gd . toAttr)
+    obj <- addToObjectArray storage "Points" [] 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 ()
+        }
+