{-# LANGUAGE LambdaCase, RecordWildCards, DataKinds #-}
module PointPrimitiveRing where

import Control.Monad
import Data.Data
import Data.Foldable
import Data.Function
import Data.Int
import Data.IORef
import Data.Maybe
import Data.Some
import Data.Word
import qualified Data.Map.Strict as Map
import qualified Data.Vector as V
         ;import Data.Vector as V ((!),(//))
import Foreign.C.Types (CPtrdiff)
import Foreign.Marshal
import Foreign.Ptr
import Foreign.Storable

import LambdaCube.GL      as LC
import LambdaCube.GL.Data -- (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)

-- import Graphics.GL.Core33

import MaskableStream

data Ring = Ring
    { rBufferObject :: Buffer
    , rStorage      :: GLStorage
    , rObject       :: Object
    , rSize         :: IORef Int -- Current count of vertices in the ring buffer.
    , rBack         :: IORef Int -- Where next vertex will be added.
    , ringCapacity  :: Int       -- Maximum number of vertices in buffer.
    , rPosition     :: AttributeKey (GLVector 3 Float)
    }

newRing :: GLStorage -> Int -> IO Ring
newRing storage sz = do
    startRef <- newIORef 0
    sizeRef <- newIORef 0
    gd <- uploadDynamicBuffer sz [Parameter "position" V3F]
    let Just k = attributeKey gd "position"
    obj <- addToObjectArray storage "Points" [] gd
    readIORef (objCommands obj) >>= mapM_ print
        -- [[GLSetUniform 0 GLUniform M44F,GLSetVertexAttribArray 0 5 3 5126 0x0000000000000000,GLDrawArrays 0 0 1],[],[],[]]
    let bo = streamBuffer $ dStreams gd Map.! "position"
        r = Ring
            { rBufferObject = bo
            , rStorage      = storage
            , rObject       = obj
            , rSize         = sizeRef
            , rBack         = startRef
            , ringCapacity  = sz
            , rPosition     = k
            }
    updateRingCommands r
    return r

updateRingCommands :: Ring -> IO ()
updateRingCommands r = do
    back <- fromIntegral <$> readIORef (rBack r)
    size  <- fromIntegral <$> readIORef (rSize r)
    let mask 0   = []
        mask cnt
            | cnt==size = [(0,cnt)]
            | otherwise = case cnt + back - size of
                front | front > cnt -> [(front - cnt,size)]
                      | otherwise   -> [(0,back), (front,cnt - front)]
    updateCommands (rStorage r) (rObject r) mask
    readIORef (objCommands $ rObject r) >>= mapM_ print
    return ()

pushBack :: Ring -> Float -> Float -> Float -> IO ()
pushBack r x y z = do
    back <- readIORef $ rBack r
    writeIORef (rBack r) (mod (back + 1) (ringCapacity r))
    updateAttributes back $ do
        rPosition r @<- V3 x y z -- (fromList [x,y,z] :: Vector Float)
    sz <- readIORef (rSize r)
    putStrLn $ "pushBack "++show (sz,back,(x,y,z))
    when (sz < ringCapacity r) $ do
        writeIORef (rSize r) (sz + 1)
    updateRingCommands r

updateRingUniforms :: GLStorage -> Ring -> IO ()
updateRingUniforms _ _ = return ()