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

import Control.Monad
import Data.Foldable
import Data.Int
import Data.IORef
import Data.Maybe
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 CPtrdiff -- Current count of Floats in the ring buffer.
    , rStart        :: IORef CPtrdiff -- Float-index where next vector will be added. TODO: rename this.
    , ringCapacity  :: CPtrdiff       -- Maximum number of floats 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
            , rStart        = startRef
            , ringCapacity  = 3 * fromIntegral sz
            , rPosition     = k
            }
    updateRingCommands r
    return r

updateRingCommands :: Ring -> IO ()
updateRingCommands r = do
    start <- fmap (fromIntegral . (`div` 3)) $ readIORef $ rStart r
    size  <- fmap (fromIntegral . (`div` 3)) $ readIORef $ rSize r
    let mask 0   = []
        mask cnt = case cnt + start - size of
            st | st > cnt  -> [(st - cnt,size)]
               | otherwise -> [(0,start), (st,cnt - st)]
    updateCommands (rStorage r) (rObject r) mask
    readIORef (objCommands $ rObject r) >>= mapM_ print
    return ()

pushBack :: Ring -> Float -> Float -> Float -> IO ()
pushBack r x y z = allocaArray 3 $ \ptr -> do
    pokeElemOff ptr 0 x
    pokeElemOff ptr 1 y
    pokeElemOff ptr 2 z
    start <- readIORef $ rStart r
    writeIORef (rStart r) (mod (start + 3) (ringCapacity r))
    -- incrementalUpdateBuffer (rBufferObject r) (4*start) (4*3) ptr
    updateAttributes (fromIntegral (start `div` 3)) $ do
        rPosition r @<- V3 x y z -- (fromList [x,y,z] :: Vector Float)
    -- glFlush
    -- glFinish
    sz <- readIORef (rSize r)
    putStrLn $ "pushBack "++show (sz,start,(x,y,z))
    when (sz < ringCapacity r) $ do
        writeIORef (rSize r) (sz + 3)
    updateRingCommands r

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