module Graphics.LambdaCube.RenderSystem.GL.VertexBuffer where

import Control.Monad
import Control.Applicative
import Data.IORef
import Data.Maybe
import Data.Ord
import Data.Word
import Foreign

import Graphics.Rendering.OpenGL.Raw.Core31

import Graphics.LambdaCube.HardwareBuffer
import Graphics.LambdaCube.HardwareVertexBuffer
import Graphics.LambdaCube.RenderSystem.GL.Utils

-- | Specialisation of HardwareVertexBuffer for GL
data GLVertexBuffer
    = GLVertexBuffer
    { glvbNumVertices      :: Int
    , glvbVertexSize       :: Int

    , glvbUsage            :: Usage
    , glvbLockInfo         :: IORef (Maybe (Int,Int,Bool)) -- LockStart LockSize RequireUpdate

    , glvbShadowBuffer     :: Maybe (Ptr Word8)
    , glvbBufferObject     :: GLuint
    }
    deriving Eq

-- TODO: inconsistent Eq vs. Ord!
instance Ord GLVertexBuffer where
    compare = comparing glvbBufferObject

instance HardwareVertexBuffer GLVertexBuffer where
    getVertexSize   = glvbVertexSize
    getNumVertices  = glvbNumVertices

instance HardwareBuffer GLVertexBuffer where
    getSizeInBytes b    = glvbVertexSize b * glvbNumVertices b
    isSystemMemory b    = 0 == glvbBufferObject b
    hasShadowBuffer b   = (isJust $ glvbShadowBuffer b) && (glvbBufferObject b /= 0)
    getUsage            = glvbUsage
    isLocked            = glvbIsLocked
    unlock              = glvbUnlock
    lock                = glvbLock

glvbIsLocked :: GLVertexBuffer -> IO Bool
glvbIsLocked b = do
    i <- readIORef $ glvbLockInfo b
    return $ isJust i

glvbLock :: GLVertexBuffer -> Int -> Int -> LockOptions -> IO (Ptr Word8)
glvbLock a offs len opts = do
    lockinfo <- readIORef (glvbLockInfo a)
    when (isJust lockinfo) $ error "Cannot lock this buffer, it is already locked!"
    writeIORef (glvbLockInfo a) $ Just (offs,len,opts /= HBL_READ_ONLY)
    case glvbShadowBuffer a of
        Just b    -> do
            --putStrLn "lock shadow VBO buffer"
            return $ plusPtr b offs
        Nothing   -> do
            --putStrLn "lock VBO buffer"
            glBindBuffer gl_ARRAY_BUFFER $ glvbBufferObject a
            -- Discard if required
            when (opts == HBL_DISCARD) $ glBufferData gl_ARRAY_BUFFER (fromIntegral $ getSizeInBytes a) nullPtr (getGLUsage $ getUsage a)
            let isWriteOnly = case getUsage a of
                    HBU_WRITE_ONLY                        -> True
                    HBU_STATIC_WRITE_ONLY                 -> True
                    HBU_DYNAMIC_WRITE_ONLY                -> True
                    HBU_DYNAMIC_WRITE_ONLY_DISCARDABLE    -> True
                    _                                     -> False
                access = case (isWriteOnly,opts == HBL_READ_ONLY) of
                    (False,False) -> gl_READ_WRITE
                    (False,True)  -> gl_READ_ONLY
                    (True,_)      -> gl_WRITE_ONLY
            b <- glMapBuffer gl_ARRAY_BUFFER access
            case b == nullPtr of
                True   -> error "Vertex Buffer: Out of memory"
                False  -> return $ plusPtr b offs

glvbUnlock :: GLVertexBuffer -> IO ()
glvbUnlock a = do
    lockinfo <- readIORef (glvbLockInfo a)
    let (lockStart,lockSize,reqUpdate) = case lockinfo of
            Just li   -> li
            Nothing   -> error "Cannot unlock this buffer, it is not locked!"
    writeIORef (glvbLockInfo a) Nothing
    case glvbShadowBuffer a of
        Just b    -> when reqUpdate $ do -- If we used the shadow buffer this time...
            --putStrLn "unlock shadow VBO buffer"
            glBindBuffer gl_ARRAY_BUFFER $ glvbBufferObject a
            case lockStart == 0 && lockSize == getSizeInBytes a of
                True  -> glBufferData gl_ARRAY_BUFFER (fromIntegral lockSize) b (getGLUsage $ getUsage a)
                False -> glBufferSubData gl_ARRAY_BUFFER (fromIntegral lockStart) (fromIntegral lockSize) b
        Nothing   -> do
            --putStrLn "unlock VBO buffer"
            glBindBuffer gl_ARRAY_BUFFER $ glvbBufferObject a
            ok <- glUnmapBuffer gl_ARRAY_BUFFER
            unless (ok /= (fromIntegral gl_FALSE)) $ error "Buffer data corrupted, please reload"

mkGLVertexBuffer :: Int -> Int -> Usage -> Bool -> IO GLVertexBuffer
mkGLVertexBuffer vertexSize numVerts usage useShadowBuffer = do
    let bufferSize = numVerts * vertexSize
    bufferObject <- alloca $ \buf -> glGenBuffers 1 buf >> peek buf
    --putStrLn $ "VBO ID: " ++ show bufferObject
    lockinfo <- newIORef Nothing
    glBindBuffer gl_ARRAY_BUFFER bufferObject
    glBufferData gl_ARRAY_BUFFER (fromIntegral bufferSize) nullPtr (getGLUsage usage)
    shadowBuffer <- case useShadowBuffer of
        True  -> Just <$> mallocBytes bufferSize
        False -> return Nothing
    return $ GLVertexBuffer
        { glvbNumVertices      = numVerts
        , glvbVertexSize       = vertexSize

        , glvbUsage            = usage
        , glvbLockInfo         = lockinfo

        , glvbShadowBuffer     = shadowBuffer
        , glvbBufferObject     = bufferObject
        }

rmGLVertexBuffer :: GLVertexBuffer -> IO ()
rmGLVertexBuffer a = do
    case glvbBufferObject a of
        0 -> return ()
        b -> with b $ \buf -> glDeleteBuffers 1 buf
    case glvbShadowBuffer a of
        Just b    -> free b
        Nothing   -> return ()