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
data GLIndexBuffer
= GLIndexBuffer
{ glibType :: IndexType
, glibNumIndexes :: Int
, glibUsage :: Usage
, glibLockInfo :: IORef (Maybe (Int,Int,Bool))
, glibShadowBuffer :: Maybe (Ptr Word8)
, glibBufferObject :: GLuint
}
deriving Eq
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
return $ plusPtr b offs
Nothing -> do
glBindBuffer gl_ELEMENT_ARRAY_BUFFER $ glibBufferObject a
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
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
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
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 ()