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 ()
        }