module Graphics.Caramia.Sync
(
fence
, waitFence
, isFenceSignalled
, Fence() )
where
import Control.Monad.Catch
import Control.Monad.IO.Class
import Graphics.Caramia.Internal.OpenGLCApi
import Graphics.Caramia.Prelude
import Graphics.Caramia.Resource
data Fence = Fence { resource :: !(Resource GLsync)
, ordIndex :: !Unique }
deriving ( Eq, Typeable )
instance Ord Fence where
(ordIndex -> o1) `compare` (ordIndex -> o2) = o1 `compare` o2
fence :: (MonadIO m, MonadMask m) => m Fence
fence = mask_ $ 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