module Graphics.LambdaCube.RenderSystem.GL.IndexBuffer where

import Control.Applicative
import Control.Monad
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.HardwareIndexBuffer
import Graphics.LambdaCube.RenderSystem.GL.Utils

-- | Specialisation of HardwareIndexBuffer for GL
data GLIndexBuffer
    = GLIndexBuffer
    { glibType         :: IndexType
    , glibNumIndexes   :: Int

    , glibUsage        :: Usage
    , glibLockInfo     :: IORef (Maybe (Int,Int,Bool)) -- LockStart LockSize RequireUpdate

    , glibShadowBuffer :: Maybe (Ptr Word8)
    , glibBufferObject :: GLuint
    }
    deriving Eq

-- TODO: inconsistent Eq vs. Ord!
instance Ord GLIndexBuffer where
    compare = comparing glibBufferObject

instance HardwareIndexBuffer GLIndexBuffer where
    getIndexType    = glibType
    getNumIndexes   = glibNumIndexes
    getIndexSize b  = case getIndexType b of
        IT_16BIT -> 2
        IT_32BIT -> 4

instance HardwareBuffer GLIndexBuffer where
    getSizeInBytes b    = getIndexSize b * glibNumIndexes b
    isSystemMemory b    = 0 == glibBufferObject b
    hasShadowBuffer b   = (isJust $ glibShadowBuffer b) && (0 /= glibBufferObject b)
    getUsage            = glibUsage
    isLocked            = glibIsLocked
    unlock              = glibUnlock
    lock                = glibLock

glibIsLocked :: GLIndexBuffer -> IO Bool
glibIsLocked b = do
    i <- readIORef $ glibLockInfo b
    return $ isJust i

glibLock :: GLIndexBuffer -> Int -> Int -> LockOptions -> IO (Ptr Word8)
glibLock a offs len opts = do
    lockinfo <- readIORef (glibLockInfo a)
    when (isJust lockinfo) $ error "Cannot lock this buffer, it is already locked!"
    writeIORef (glibLockInfo a) $ Just (offs,len,opts /= HBL_READ_ONLY)
    case glibShadowBuffer a of
        Just b    -> do
            --putStrLn "lock shadow IBO buffer"
            return $ plusPtr b offs
        Nothing   -> do
            --putStrLn "lock IBO buffer"
            glBindBuffer gl_ELEMENT_ARRAY_BUFFER $ glibBufferObject a
            -- Discard if required
            when (opts == HBL_DISCARD) $ glBufferData gl_ELEMENT_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_ELEMENT_ARRAY_BUFFER access
            case b == nullPtr of
                True   -> error "Index Buffer: Out of memory"
                False  -> return $ plusPtr b offs

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

mkGLIndexBuffer :: IndexType -> Int -> Usage -> Bool -> IO GLIndexBuffer
mkGLIndexBuffer itype numIndexes usage useShadowBuffer = do
    let isize = case itype of
            IT_16BIT -> 2
            IT_32BIT -> 4
        bufferSize = numIndexes * isize
    bufferObject <- alloca $ \buf -> glGenBuffers 1 buf >> peek buf
    --putStrLn $ "IBO ID: " ++ show bufferObject
    lockinfo <- newIORef Nothing
    glBindBuffer gl_ELEMENT_ARRAY_BUFFER bufferObject
    glBufferData gl_ELEMENT_ARRAY_BUFFER (fromIntegral bufferSize) nullPtr (getGLUsage usage)
    shadowBuffer <- case useShadowBuffer of
        True  -> Just <$> mallocBytes bufferSize
        False -> return Nothing
    return $ GLIndexBuffer
        { glibType         = itype
        , glibNumIndexes   = numIndexes

        , glibUsage        = usage
        , glibLockInfo     = lockinfo

        , glibShadowBuffer = shadowBuffer
        , glibBufferObject = bufferObject
        }

rmGLIndexBuffer :: GLIndexBuffer -> IO ()
rmGLIndexBuffer a = do
    case glibBufferObject a of
        0 -> return ()
        b -> with b $ \buf -> glDeleteBuffers 1 buf
    case glibShadowBuffer a of
        Just b    -> free b
        Nothing   -> return ()