{-# language CPP #-}
module Vulkan.Core10.Fence ( createFence
, withFence
, destroyFence
, resetFences
, getFenceStatus
, waitForFences
, waitForFencesSafe
, FenceCreateInfo(..)
, Fence(..)
, FenceCreateFlagBits(..)
, FenceCreateFlags
) where
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (castPtr)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.Type.Equality ((:~:)(Refl))
import Data.Typeable (Typeable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Word (Word64)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.CStruct.Extends (forgetExtensions)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.FundamentalTypes (Bool32(..))
import Vulkan.CStruct.Extends (Chain)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkCreateFence))
import Vulkan.Dynamic (DeviceCmds(pVkDestroyFence))
import Vulkan.Dynamic (DeviceCmds(pVkGetFenceStatus))
import Vulkan.Dynamic (DeviceCmds(pVkResetFences))
import Vulkan.Dynamic (DeviceCmds(pVkWaitForFences))
import Vulkan.Core10.Handles (Device_T)
import {-# SOURCE #-} Vulkan.Core11.Promoted_From_VK_KHR_external_fence (ExportFenceCreateInfo)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_external_fence_win32 (ExportFenceWin32HandleInfoKHR)
import Vulkan.CStruct.Extends (Extends)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.CStruct.Extends (Extensible(..))
import Vulkan.Core10.Handles (Fence)
import Vulkan.Core10.Handles (Fence(..))
import Vulkan.Core10.Enums.FenceCreateFlagBits (FenceCreateFlags)
import Vulkan.CStruct.Extends (PeekChain)
import Vulkan.CStruct.Extends (PeekChain(..))
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (PokeChain(..))
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.CStruct.Extends (SomeStruct)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_FENCE_CREATE_INFO))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Core10.Handles (Fence(..))
import Vulkan.Core10.Enums.FenceCreateFlagBits (FenceCreateFlagBits(..))
import Vulkan.Core10.Enums.FenceCreateFlagBits (FenceCreateFlags)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkCreateFence
:: FunPtr (Ptr Device_T -> Ptr (SomeStruct FenceCreateInfo) -> Ptr AllocationCallbacks -> Ptr Fence -> IO Result) -> Ptr Device_T -> Ptr (SomeStruct FenceCreateInfo) -> Ptr AllocationCallbacks -> Ptr Fence -> IO Result
createFence :: forall a io
. (Extendss FenceCreateInfo a, PokeChain a, MonadIO io)
=>
Device
->
(FenceCreateInfo a)
->
("allocator" ::: Maybe AllocationCallbacks)
-> io (Fence)
createFence :: forall (a :: [*]) (io :: * -> *).
(Extendss FenceCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> FenceCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io Fence
createFence Device
device FenceCreateInfo a
createInfo "allocator" ::: Maybe AllocationCallbacks
allocator = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkCreateFencePtr :: FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct FenceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pFence" ::: Ptr Fence)
-> IO Result)
vkCreateFencePtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct FenceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pFence" ::: Ptr Fence)
-> IO Result)
pVkCreateFence (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct FenceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pFence" ::: Ptr Fence)
-> IO Result)
vkCreateFencePtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCreateFence is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkCreateFence' :: Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct FenceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pFence" ::: Ptr Fence)
-> IO Result
vkCreateFence' = FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct FenceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pFence" ::: Ptr Fence)
-> IO Result)
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct FenceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pFence" ::: Ptr Fence)
-> IO Result
mkVkCreateFence FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct FenceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pFence" ::: Ptr Fence)
-> IO Result)
vkCreateFencePtr
Ptr (FenceCreateInfo a)
pCreateInfo <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (FenceCreateInfo a
createInfo)
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
"allocator" ::: Maybe AllocationCallbacks
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
Just AllocationCallbacks
j -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
"pFence" ::: Ptr Fence
pPFence <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @Fence Int
8) forall a. Ptr a -> IO ()
free
Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCreateFence" (Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct FenceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pFence" ::: Ptr Fence)
-> IO Result
vkCreateFence'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (FenceCreateInfo a)
pCreateInfo)
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator
("pFence" ::: Ptr Fence
pPFence))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
Fence
pFence <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Fence "pFence" ::: Ptr Fence
pPFence
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Fence
pFence)
withFence :: forall a io r . (Extendss FenceCreateInfo a, PokeChain a, MonadIO io) => Device -> FenceCreateInfo a -> Maybe AllocationCallbacks -> (io Fence -> (Fence -> io ()) -> r) -> r
withFence :: forall (a :: [*]) (io :: * -> *) r.
(Extendss FenceCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> FenceCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io Fence -> (Fence -> io ()) -> r)
-> r
withFence Device
device FenceCreateInfo a
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator io Fence -> (Fence -> io ()) -> r
b =
io Fence -> (Fence -> io ()) -> r
b (forall (a :: [*]) (io :: * -> *).
(Extendss FenceCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> FenceCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io Fence
createFence Device
device FenceCreateInfo a
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
(\(Fence
o0) -> forall (io :: * -> *).
MonadIO io =>
Device
-> Fence -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
destroyFence Device
device Fence
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkDestroyFence
:: FunPtr (Ptr Device_T -> Fence -> Ptr AllocationCallbacks -> IO ()) -> Ptr Device_T -> Fence -> Ptr AllocationCallbacks -> IO ()
destroyFence :: forall io
. (MonadIO io)
=>
Device
->
Fence
->
("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyFence :: forall (io :: * -> *).
MonadIO io =>
Device
-> Fence -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
destroyFence Device
device Fence
fence "allocator" ::: Maybe AllocationCallbacks
allocator = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkDestroyFencePtr :: FunPtr
(Ptr Device_T
-> Fence -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroyFencePtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> Fence -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
pVkDestroyFence (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> Fence -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroyFencePtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkDestroyFence is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkDestroyFence' :: Ptr Device_T
-> Fence -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroyFence' = FunPtr
(Ptr Device_T
-> Fence -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
-> Ptr Device_T
-> Fence
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroyFence FunPtr
(Ptr Device_T
-> Fence -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroyFencePtr
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
"allocator" ::: Maybe AllocationCallbacks
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
Just AllocationCallbacks
j -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkDestroyFence" (Ptr Device_T
-> Fence -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroyFence'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(Fence
fence)
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ()
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkResetFences
:: FunPtr (Ptr Device_T -> Word32 -> Ptr Fence -> IO Result) -> Ptr Device_T -> Word32 -> Ptr Fence -> IO Result
resetFences :: forall io
. (MonadIO io)
=>
Device
->
("fences" ::: Vector Fence)
-> io ()
resetFences :: forall (io :: * -> *).
MonadIO io =>
Device -> ("fences" ::: Vector Fence) -> io ()
resetFences Device
device "fences" ::: Vector Fence
fences = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkResetFencesPtr :: FunPtr
(Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> IO Result)
vkResetFencesPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> IO Result)
pVkResetFences (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> IO Result)
vkResetFencesPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkResetFences is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkResetFences' :: Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> IO Result
vkResetFences' = FunPtr
(Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> IO Result)
-> Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> IO Result
mkVkResetFences FunPtr
(Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> IO Result)
vkResetFencesPtr
"pFence" ::: Ptr Fence
pPFences <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @Fence ((forall a. Vector a -> Int
Data.Vector.length ("fences" ::: Vector Fence
fences)) forall a. Num a => a -> a -> a
* Int
8)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i Fence
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke ("pFence" ::: Ptr Fence
pPFences forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Fence) (Fence
e)) ("fences" ::: Vector Fence
fences)
Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkResetFences" (Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> IO Result
vkResetFences'
(Device -> Ptr Device_T
deviceHandle (Device
device))
((forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ ("fences" ::: Vector Fence
fences)) :: Word32))
("pFence" ::: Ptr Fence
pPFences))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkGetFenceStatus
:: FunPtr (Ptr Device_T -> Fence -> IO Result) -> Ptr Device_T -> Fence -> IO Result
getFenceStatus :: forall io
. (MonadIO io)
=>
Device
->
Fence
-> io (Result)
getFenceStatus :: forall (io :: * -> *). MonadIO io => Device -> Fence -> io Result
getFenceStatus Device
device Fence
fence = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
let vkGetFenceStatusPtr :: FunPtr (Ptr Device_T -> Fence -> IO Result)
vkGetFenceStatusPtr = DeviceCmds -> FunPtr (Ptr Device_T -> Fence -> IO Result)
pVkGetFenceStatus (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr (Ptr Device_T -> Fence -> IO Result)
vkGetFenceStatusPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetFenceStatus is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkGetFenceStatus' :: Ptr Device_T -> Fence -> IO Result
vkGetFenceStatus' = FunPtr (Ptr Device_T -> Fence -> IO Result)
-> Ptr Device_T -> Fence -> IO Result
mkVkGetFenceStatus FunPtr (Ptr Device_T -> Fence -> IO Result)
vkGetFenceStatusPtr
Result
r <- forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetFenceStatus" (Ptr Device_T -> Fence -> IO Result
vkGetFenceStatus'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(Fence
fence))
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Result
r)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkWaitForFencesUnsafe
:: FunPtr (Ptr Device_T -> Word32 -> Ptr Fence -> Bool32 -> Word64 -> IO Result) -> Ptr Device_T -> Word32 -> Ptr Fence -> Bool32 -> Word64 -> IO Result
foreign import ccall
"dynamic" mkVkWaitForFencesSafe
:: FunPtr (Ptr Device_T -> Word32 -> Ptr Fence -> Bool32 -> Word64 -> IO Result) -> Ptr Device_T -> Word32 -> Ptr Fence -> Bool32 -> Word64 -> IO Result
waitForFencesSafeOrUnsafe :: forall io
. (MonadIO io)
=> (FunPtr (Ptr Device_T -> Word32 -> Ptr Fence -> Bool32 -> Word64 -> IO Result) -> Ptr Device_T -> Word32 -> Ptr Fence -> Bool32 -> Word64 -> IO Result)
->
Device
->
("fences" ::: Vector Fence)
->
("waitAll" ::: Bool)
->
("timeout" ::: Word64)
-> io (Result)
waitForFencesSafeOrUnsafe :: forall (io :: * -> *).
MonadIO io =>
(FunPtr
(Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> Bool32
-> Word64
-> IO Result)
-> Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> Bool32
-> Word64
-> IO Result)
-> Device
-> ("fences" ::: Vector Fence)
-> Bool
-> Word64
-> io Result
waitForFencesSafeOrUnsafe FunPtr
(Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> Bool32
-> Word64
-> IO Result)
-> Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> Bool32
-> Word64
-> IO Result
mkVkWaitForFences Device
device
"fences" ::: Vector Fence
fences
Bool
waitAll
Word64
timeout = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkWaitForFencesPtr :: FunPtr
(Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> Bool32
-> Word64
-> IO Result)
vkWaitForFencesPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> Bool32
-> Word64
-> IO Result)
pVkWaitForFences (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> Bool32
-> Word64
-> IO Result)
vkWaitForFencesPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkWaitForFences is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkWaitForFences' :: Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> Bool32
-> Word64
-> IO Result
vkWaitForFences' = FunPtr
(Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> Bool32
-> Word64
-> IO Result)
-> Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> Bool32
-> Word64
-> IO Result
mkVkWaitForFences FunPtr
(Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> Bool32
-> Word64
-> IO Result)
vkWaitForFencesPtr
"pFence" ::: Ptr Fence
pPFences <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @Fence ((forall a. Vector a -> Int
Data.Vector.length ("fences" ::: Vector Fence
fences)) forall a. Num a => a -> a -> a
* Int
8)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i Fence
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke ("pFence" ::: Ptr Fence
pPFences forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Fence) (Fence
e)) ("fences" ::: Vector Fence
fences)
Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkWaitForFences" (Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> Bool32
-> Word64
-> IO Result
vkWaitForFences'
(Device -> Ptr Device_T
deviceHandle (Device
device))
((forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ ("fences" ::: Vector Fence
fences)) :: Word32))
("pFence" ::: Ptr Fence
pPFences)
(Bool -> Bool32
boolToBool32 (Bool
waitAll))
(Word64
timeout))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Result
r)
waitForFences :: forall io
. (MonadIO io)
=>
Device
->
("fences" ::: Vector Fence)
->
("waitAll" ::: Bool)
->
("timeout" ::: Word64)
-> io (Result)
waitForFences :: forall (io :: * -> *).
MonadIO io =>
Device
-> ("fences" ::: Vector Fence) -> Bool -> Word64 -> io Result
waitForFences = forall (io :: * -> *).
MonadIO io =>
(FunPtr
(Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> Bool32
-> Word64
-> IO Result)
-> Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> Bool32
-> Word64
-> IO Result)
-> Device
-> ("fences" ::: Vector Fence)
-> Bool
-> Word64
-> io Result
waitForFencesSafeOrUnsafe FunPtr
(Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> Bool32
-> Word64
-> IO Result)
-> Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> Bool32
-> Word64
-> IO Result
mkVkWaitForFencesUnsafe
waitForFencesSafe :: forall io
. (MonadIO io)
=>
Device
->
("fences" ::: Vector Fence)
->
("waitAll" ::: Bool)
->
("timeout" ::: Word64)
-> io (Result)
waitForFencesSafe :: forall (io :: * -> *).
MonadIO io =>
Device
-> ("fences" ::: Vector Fence) -> Bool -> Word64 -> io Result
waitForFencesSafe = forall (io :: * -> *).
MonadIO io =>
(FunPtr
(Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> Bool32
-> Word64
-> IO Result)
-> Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> Bool32
-> Word64
-> IO Result)
-> Device
-> ("fences" ::: Vector Fence)
-> Bool
-> Word64
-> io Result
waitForFencesSafeOrUnsafe FunPtr
(Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> Bool32
-> Word64
-> IO Result)
-> Ptr Device_T
-> ("fenceCount" ::: Word32)
-> ("pFence" ::: Ptr Fence)
-> Bool32
-> Word64
-> IO Result
mkVkWaitForFencesSafe
data FenceCreateInfo (es :: [Type]) = FenceCreateInfo
{
forall (es :: [*]). FenceCreateInfo es -> Chain es
next :: Chain es
,
forall (es :: [*]). FenceCreateInfo es -> FenceCreateFlags
flags :: FenceCreateFlags
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (FenceCreateInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (FenceCreateInfo es)
instance Extensible FenceCreateInfo where
extensibleTypeName :: String
extensibleTypeName = String
"FenceCreateInfo"
setNext :: forall (ds :: [*]) (es :: [*]).
FenceCreateInfo ds -> Chain es -> FenceCreateInfo es
setNext FenceCreateInfo{Chain ds
FenceCreateFlags
flags :: FenceCreateFlags
next :: Chain ds
$sel:flags:FenceCreateInfo :: forall (es :: [*]). FenceCreateInfo es -> FenceCreateFlags
$sel:next:FenceCreateInfo :: forall (es :: [*]). FenceCreateInfo es -> Chain es
..} Chain es
next' = FenceCreateInfo{$sel:next:FenceCreateInfo :: Chain es
next = Chain es
next', FenceCreateFlags
flags :: FenceCreateFlags
$sel:flags:FenceCreateInfo :: FenceCreateFlags
..}
getNext :: forall (es :: [*]). FenceCreateInfo es -> Chain es
getNext FenceCreateInfo{Chain es
FenceCreateFlags
flags :: FenceCreateFlags
next :: Chain es
$sel:flags:FenceCreateInfo :: forall (es :: [*]). FenceCreateInfo es -> FenceCreateFlags
$sel:next:FenceCreateInfo :: forall (es :: [*]). FenceCreateInfo es -> Chain es
..} = Chain es
next
extends :: forall e b proxy. Typeable e => proxy e -> (Extends FenceCreateInfo e => b) -> Maybe b
extends :: forall e b (proxy :: * -> *).
Typeable e =>
proxy e -> (Extends FenceCreateInfo e => b) -> Maybe b
extends proxy e
_ Extends FenceCreateInfo e => b
f
| Just e :~: ExportFenceWin32HandleInfoKHR
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ExportFenceWin32HandleInfoKHR = forall a. a -> Maybe a
Just Extends FenceCreateInfo e => b
f
| Just e :~: ExportFenceCreateInfo
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ExportFenceCreateInfo = forall a. a -> Maybe a
Just Extends FenceCreateInfo e => b
f
| Bool
otherwise = forall a. Maybe a
Nothing
instance ( Extendss FenceCreateInfo es
, PokeChain es ) => ToCStruct (FenceCreateInfo es) where
withCStruct :: forall b.
FenceCreateInfo es -> (Ptr (FenceCreateInfo es) -> IO b) -> IO b
withCStruct FenceCreateInfo es
x Ptr (FenceCreateInfo es) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr (FenceCreateInfo es)
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (FenceCreateInfo es)
p FenceCreateInfo es
x (Ptr (FenceCreateInfo es) -> IO b
f Ptr (FenceCreateInfo es)
p)
pokeCStruct :: forall b.
Ptr (FenceCreateInfo es) -> FenceCreateInfo es -> IO b -> IO b
pokeCStruct Ptr (FenceCreateInfo es)
p FenceCreateInfo{Chain es
FenceCreateFlags
flags :: FenceCreateFlags
next :: Chain es
$sel:flags:FenceCreateInfo :: forall (es :: [*]). FenceCreateInfo es -> FenceCreateFlags
$sel:next:FenceCreateInfo :: forall (es :: [*]). FenceCreateInfo es -> Chain es
..} IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (FenceCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_FENCE_CREATE_INFO)
Ptr ()
pNext'' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. Ptr a -> Ptr b
castPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (FenceCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext''
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (FenceCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr FenceCreateFlags)) (FenceCreateFlags
flags)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b. Ptr (FenceCreateInfo es) -> IO b -> IO b
pokeZeroCStruct Ptr (FenceCreateInfo es)
p IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (FenceCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_FENCE_CREATE_INFO)
Ptr ()
pNext' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. Ptr a -> Ptr b
castPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (FenceCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext'
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
instance ( Extendss FenceCreateInfo es
, PeekChain es ) => FromCStruct (FenceCreateInfo es) where
peekCStruct :: Ptr (FenceCreateInfo es) -> IO (FenceCreateInfo es)
peekCStruct Ptr (FenceCreateInfo es)
p = do
Ptr ()
pNext <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (FenceCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ())))
Chain es
next <- forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
FenceCreateFlags
flags <- forall a. Storable a => Ptr a -> IO a
peek @FenceCreateFlags ((Ptr (FenceCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr FenceCreateFlags))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (es :: [*]).
Chain es -> FenceCreateFlags -> FenceCreateInfo es
FenceCreateInfo
Chain es
next FenceCreateFlags
flags
instance es ~ '[] => Zero (FenceCreateInfo es) where
zero :: FenceCreateInfo es
zero = forall (es :: [*]).
Chain es -> FenceCreateFlags -> FenceCreateInfo es
FenceCreateInfo
()
forall a. Zero a => a
zero