module Graphics.Caramia.Sync
(
fence
, waitFence
, isFenceSignalled
, Fence() )
where
import Control.Monad.Catch
import Control.Monad.IO.Class
import Graphics.Caramia.Internal.Exception
import Graphics.Caramia.Internal.OpenGLCApi
import Graphics.Caramia.OpenGLResource
import Graphics.Caramia.Prelude
import Graphics.Caramia.Resource
import Graphics.GL.Ext.ARB.Sync ( gl_ARB_sync )
data Fence = Fence { resource :: !(Resource GLsync)
, ordIndex :: !Unique }
deriving ( Eq, Typeable )
instance OpenGLResource GLsync Fence where
getRaw (Fence r _) = getRaw $ WrappedOpenGLResource r
touch (Fence r _) = touch $ WrappedOpenGLResource r
finalize (Fence r _) = finalize $ WrappedOpenGLResource r
instance Ord Fence where
(ordIndex -> o1) `compare` (ordIndex -> o2) = o1 `compare` o2
fence :: MonadIO m => m Fence
fence = liftIO $ mask_ $ do
checkOpenGLOrExtensionM (OpenGLVersion 3 2)
"GL_ARB_sync"
gl_ARB_sync $ do
resource <- newResource createFence glDeleteSync (return ())
unique <- liftIO newUnique
return $ Fence { resource = resource
, ordIndex = unique }
where
createFence = glFenceSync GL_SYNC_GPU_COMMANDS_COMPLETE 0
waitFence :: MonadIO m
=> Int
-> Fence
-> m Bool
waitFence useconds (Fence{ resource = resource }) =
withResource resource $ \fencesync -> do
ret <- glClientWaitSync fencesync GL_SYNC_FLUSH_COMMANDS_BIT
(fromIntegral actual_seconds)
if | ret == GL_ALREADY_SIGNALED -> return True
| ret == GL_TIMEOUT_EXPIRED -> return False
| ret == GL_CONDITION_SATISFIED -> return True
| ret == GL_WAIT_FAILED -> return True
where
actual_seconds :: Word64
actual_seconds =
if useconds * 1000 < useconds
then maxBound
else safeFromIntegral $ useconds * 1000
isFenceSignalled :: MonadIO m => Fence -> m Bool
isFenceSignalled = waitFence 0