{-# language CPP #-}
module Vulkan.Core10.QueueSemaphore ( createSemaphore
, withSemaphore
, destroySemaphore
, SemaphoreCreateInfo(..)
) where
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytesAligned)
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 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.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Vulkan.NamedType ((:::))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks)
import Vulkan.CStruct.Extends (Chain)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Dynamic (DeviceCmds(pVkCreateSemaphore))
import Vulkan.Dynamic (DeviceCmds(pVkDestroySemaphore))
import Vulkan.Core10.Handles (Device_T)
import {-# SOURCE #-} Vulkan.Core11.Promoted_From_VK_KHR_external_semaphore (ExportSemaphoreCreateInfo)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_external_semaphore_win32 (ExportSemaphoreWin32HandleInfoKHR)
import Vulkan.CStruct.Extends (Extends)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.CStruct.Extends (Extensible(..))
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
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.Core10.Handles (Semaphore)
import Vulkan.Core10.Handles (Semaphore(..))
import Vulkan.Core10.Enums.SemaphoreCreateFlags (SemaphoreCreateFlags)
import {-# SOURCE #-} Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore (SemaphoreTypeCreateInfo)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Exception (VulkanException(..))
import Vulkan.Zero (Zero(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SEMAPHORE_CREATE_INFO))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkCreateSemaphore
:: FunPtr (Ptr Device_T -> Ptr (SemaphoreCreateInfo a) -> Ptr AllocationCallbacks -> Ptr Semaphore -> IO Result) -> Ptr Device_T -> Ptr (SemaphoreCreateInfo a) -> Ptr AllocationCallbacks -> Ptr Semaphore -> IO Result
createSemaphore :: forall a io . (Extendss SemaphoreCreateInfo a, PokeChain a, MonadIO io) => Device -> SemaphoreCreateInfo a -> ("allocator" ::: Maybe AllocationCallbacks) -> io (Semaphore)
createSemaphore :: Device
-> SemaphoreCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io Semaphore
createSemaphore device :: Device
device createInfo :: SemaphoreCreateInfo a
createInfo allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO Semaphore -> io Semaphore
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Semaphore -> io Semaphore)
-> (ContT Semaphore IO Semaphore -> IO Semaphore)
-> ContT Semaphore IO Semaphore
-> io Semaphore
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Semaphore IO Semaphore -> IO Semaphore
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Semaphore IO Semaphore -> io Semaphore)
-> ContT Semaphore IO Semaphore -> io Semaphore
forall a b. (a -> b) -> a -> b
$ do
let vkCreateSemaphorePtr :: FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SemaphoreCreateInfo a))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSemaphore" ::: Ptr Semaphore)
-> IO Result)
vkCreateSemaphorePtr = DeviceCmds
-> forall (a :: [*]).
FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SemaphoreCreateInfo a))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSemaphore" ::: Ptr Semaphore)
-> IO Result)
pVkCreateSemaphore (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
IO () -> ContT Semaphore IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Semaphore IO ()) -> IO () -> ContT Semaphore IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SemaphoreCreateInfo a))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSemaphore" ::: Ptr Semaphore)
-> IO Result)
vkCreateSemaphorePtr FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SemaphoreCreateInfo a))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSemaphore" ::: Ptr Semaphore)
-> IO Result)
-> FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SemaphoreCreateInfo a))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSemaphore" ::: Ptr Semaphore)
-> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SemaphoreCreateInfo a))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSemaphore" ::: Ptr Semaphore)
-> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkCreateSemaphore is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
let vkCreateSemaphore' :: Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SemaphoreCreateInfo a))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSemaphore" ::: Ptr Semaphore)
-> IO Result
vkCreateSemaphore' = FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SemaphoreCreateInfo a))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSemaphore" ::: Ptr Semaphore)
-> IO Result)
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SemaphoreCreateInfo a))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSemaphore" ::: Ptr Semaphore)
-> IO Result
forall (a :: [*]).
FunPtr
(Ptr Device_T
-> Ptr (SemaphoreCreateInfo a)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSemaphore" ::: Ptr Semaphore)
-> IO Result)
-> Ptr Device_T
-> Ptr (SemaphoreCreateInfo a)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSemaphore" ::: Ptr Semaphore)
-> IO Result
mkVkCreateSemaphore FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SemaphoreCreateInfo a))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSemaphore" ::: Ptr Semaphore)
-> IO Result)
vkCreateSemaphorePtr
"pCreateInfo" ::: Ptr (SemaphoreCreateInfo a)
pCreateInfo <- ((("pCreateInfo" ::: Ptr (SemaphoreCreateInfo a)) -> IO Semaphore)
-> IO Semaphore)
-> ContT
Semaphore IO ("pCreateInfo" ::: Ptr (SemaphoreCreateInfo a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pCreateInfo" ::: Ptr (SemaphoreCreateInfo a)) -> IO Semaphore)
-> IO Semaphore)
-> ContT
Semaphore IO ("pCreateInfo" ::: Ptr (SemaphoreCreateInfo a)))
-> ((("pCreateInfo" ::: Ptr (SemaphoreCreateInfo a))
-> IO Semaphore)
-> IO Semaphore)
-> ContT
Semaphore IO ("pCreateInfo" ::: Ptr (SemaphoreCreateInfo a))
forall a b. (a -> b) -> a -> b
$ SemaphoreCreateInfo a
-> (("pCreateInfo" ::: Ptr (SemaphoreCreateInfo a))
-> IO Semaphore)
-> IO Semaphore
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (SemaphoreCreateInfo a
createInfo)
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT Semaphore IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO Semaphore)
-> IO Semaphore)
-> ContT Semaphore IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO Semaphore)
-> IO Semaphore)
-> ContT Semaphore IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO Semaphore)
-> IO Semaphore)
-> ContT Semaphore IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO Semaphore)
-> IO Semaphore
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
"pSemaphore" ::: Ptr Semaphore
pPSemaphore <- ((("pSemaphore" ::: Ptr Semaphore) -> IO Semaphore)
-> IO Semaphore)
-> ContT Semaphore IO ("pSemaphore" ::: Ptr Semaphore)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pSemaphore" ::: Ptr Semaphore) -> IO Semaphore)
-> IO Semaphore)
-> ContT Semaphore IO ("pSemaphore" ::: Ptr Semaphore))
-> ((("pSemaphore" ::: Ptr Semaphore) -> IO Semaphore)
-> IO Semaphore)
-> ContT Semaphore IO ("pSemaphore" ::: Ptr Semaphore)
forall a b. (a -> b) -> a -> b
$ IO ("pSemaphore" ::: Ptr Semaphore)
-> (("pSemaphore" ::: Ptr Semaphore) -> IO ())
-> (("pSemaphore" ::: Ptr Semaphore) -> IO Semaphore)
-> IO Semaphore
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pSemaphore" ::: Ptr Semaphore)
forall a. Int -> IO (Ptr a)
callocBytes @Semaphore 8) ("pSemaphore" ::: Ptr Semaphore) -> IO ()
forall a. Ptr a -> IO ()
free
Result
r <- IO Result -> ContT Semaphore IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT Semaphore IO Result)
-> IO Result -> ContT Semaphore IO Result
forall a b. (a -> b) -> a -> b
$ Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SemaphoreCreateInfo a))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pSemaphore" ::: Ptr Semaphore)
-> IO Result
vkCreateSemaphore' (Device -> Ptr Device_T
deviceHandle (Device
device)) "pCreateInfo" ::: Ptr (SemaphoreCreateInfo a)
pCreateInfo "pAllocator" ::: Ptr AllocationCallbacks
pAllocator ("pSemaphore" ::: Ptr Semaphore
pPSemaphore)
IO () -> ContT Semaphore IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Semaphore IO ()) -> IO () -> ContT Semaphore IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
Semaphore
pSemaphore <- IO Semaphore -> ContT Semaphore IO Semaphore
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Semaphore -> ContT Semaphore IO Semaphore)
-> IO Semaphore -> ContT Semaphore IO Semaphore
forall a b. (a -> b) -> a -> b
$ ("pSemaphore" ::: Ptr Semaphore) -> IO Semaphore
forall a. Storable a => Ptr a -> IO a
peek @Semaphore "pSemaphore" ::: Ptr Semaphore
pPSemaphore
Semaphore -> ContT Semaphore IO Semaphore
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Semaphore -> ContT Semaphore IO Semaphore)
-> Semaphore -> ContT Semaphore IO Semaphore
forall a b. (a -> b) -> a -> b
$ (Semaphore
pSemaphore)
withSemaphore :: forall a io r . (Extendss SemaphoreCreateInfo a, PokeChain a, MonadIO io) => Device -> SemaphoreCreateInfo a -> Maybe AllocationCallbacks -> (io (Semaphore) -> ((Semaphore) -> io ()) -> r) -> r
withSemaphore :: Device
-> SemaphoreCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io Semaphore -> (Semaphore -> io ()) -> r)
-> r
withSemaphore device :: Device
device pCreateInfo :: SemaphoreCreateInfo a
pCreateInfo pAllocator :: "allocator" ::: Maybe AllocationCallbacks
pAllocator b :: io Semaphore -> (Semaphore -> io ()) -> r
b =
io Semaphore -> (Semaphore -> io ()) -> r
b (Device
-> SemaphoreCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io Semaphore
forall (a :: [*]) (io :: * -> *).
(Extendss SemaphoreCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> SemaphoreCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io Semaphore
createSemaphore Device
device SemaphoreCreateInfo a
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
(\(Semaphore
o0) -> Device
-> Semaphore
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
forall (io :: * -> *).
MonadIO io =>
Device
-> Semaphore
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroySemaphore Device
device Semaphore
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkDestroySemaphore
:: FunPtr (Ptr Device_T -> Semaphore -> Ptr AllocationCallbacks -> IO ()) -> Ptr Device_T -> Semaphore -> Ptr AllocationCallbacks -> IO ()
destroySemaphore :: forall io . MonadIO io => Device -> Semaphore -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
destroySemaphore :: Device
-> Semaphore
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroySemaphore device :: Device
device semaphore :: Semaphore
semaphore allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> io ()) -> ContT () IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
let vkDestroySemaphorePtr :: FunPtr
(Ptr Device_T
-> Semaphore
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
vkDestroySemaphorePtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> Semaphore
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
pVkDestroySemaphore (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> Semaphore
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
vkDestroySemaphorePtr FunPtr
(Ptr Device_T
-> Semaphore
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
-> FunPtr
(Ptr Device_T
-> Semaphore
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(Ptr Device_T
-> Semaphore
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkDestroySemaphore is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
let vkDestroySemaphore' :: Ptr Device_T
-> Semaphore -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroySemaphore' = FunPtr
(Ptr Device_T
-> Semaphore
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
-> Ptr Device_T
-> Semaphore
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroySemaphore FunPtr
(Ptr Device_T
-> Semaphore
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
vkDestroySemaphorePtr
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Device_T
-> Semaphore -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroySemaphore' (Device -> Ptr Device_T
deviceHandle (Device
device)) (Semaphore
semaphore) "pAllocator" ::: Ptr AllocationCallbacks
pAllocator
() -> ContT () IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()
data SemaphoreCreateInfo (es :: [Type]) = SemaphoreCreateInfo
{
SemaphoreCreateInfo es -> Chain es
next :: Chain es
,
SemaphoreCreateInfo es -> SemaphoreCreateFlags
flags :: SemaphoreCreateFlags
}
deriving (Typeable)
deriving instance Show (Chain es) => Show (SemaphoreCreateInfo es)
instance Extensible SemaphoreCreateInfo where
extensibleType :: StructureType
extensibleType = StructureType
STRUCTURE_TYPE_SEMAPHORE_CREATE_INFO
setNext :: SemaphoreCreateInfo ds -> Chain es -> SemaphoreCreateInfo es
setNext x :: SemaphoreCreateInfo ds
x next :: Chain es
next = SemaphoreCreateInfo ds
x{$sel:next:SemaphoreCreateInfo :: Chain es
next = Chain es
next}
getNext :: SemaphoreCreateInfo es -> Chain es
getNext SemaphoreCreateInfo{..} = Chain es
next
extends :: forall e b proxy. Typeable e => proxy e -> (Extends SemaphoreCreateInfo e => b) -> Maybe b
extends :: proxy e -> (Extends SemaphoreCreateInfo e => b) -> Maybe b
extends _ f :: Extends SemaphoreCreateInfo e => b
f
| Just Refl <- (Typeable e, Typeable SemaphoreTypeCreateInfo) =>
Maybe (e :~: SemaphoreTypeCreateInfo)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @SemaphoreTypeCreateInfo = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SemaphoreCreateInfo e => b
f
| Just Refl <- (Typeable e, Typeable ExportSemaphoreWin32HandleInfoKHR) =>
Maybe (e :~: ExportSemaphoreWin32HandleInfoKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ExportSemaphoreWin32HandleInfoKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SemaphoreCreateInfo e => b
f
| Just Refl <- (Typeable e, Typeable ExportSemaphoreCreateInfo) =>
Maybe (e :~: ExportSemaphoreCreateInfo)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ExportSemaphoreCreateInfo = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SemaphoreCreateInfo e => b
f
| Bool
otherwise = Maybe b
forall a. Maybe a
Nothing
instance (Extendss SemaphoreCreateInfo es, PokeChain es) => ToCStruct (SemaphoreCreateInfo es) where
withCStruct :: SemaphoreCreateInfo es
-> (Ptr (SemaphoreCreateInfo es) -> IO b) -> IO b
withCStruct x :: SemaphoreCreateInfo es
x f :: Ptr (SemaphoreCreateInfo es) -> IO b
f = Int -> Int -> (Ptr (SemaphoreCreateInfo es) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 24 8 ((Ptr (SemaphoreCreateInfo es) -> IO b) -> IO b)
-> (Ptr (SemaphoreCreateInfo es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr (SemaphoreCreateInfo es)
p -> Ptr (SemaphoreCreateInfo es)
-> SemaphoreCreateInfo es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (SemaphoreCreateInfo es)
p SemaphoreCreateInfo es
x (Ptr (SemaphoreCreateInfo es) -> IO b
f Ptr (SemaphoreCreateInfo es)
p)
pokeCStruct :: Ptr (SemaphoreCreateInfo es)
-> SemaphoreCreateInfo es -> IO b -> IO b
pokeCStruct p :: Ptr (SemaphoreCreateInfo es)
p SemaphoreCreateInfo{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SemaphoreCreateInfo es)
p Ptr (SemaphoreCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SEMAPHORE_CREATE_INFO)
Ptr ()
pNext'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SemaphoreCreateInfo es)
p Ptr (SemaphoreCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext''
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SemaphoreCreateFlags -> SemaphoreCreateFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SemaphoreCreateInfo es)
p Ptr (SemaphoreCreateInfo es) -> Int -> Ptr SemaphoreCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr SemaphoreCreateFlags)) (SemaphoreCreateFlags
flags)
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = 24
cStructAlignment :: Int
cStructAlignment = 8
pokeZeroCStruct :: Ptr (SemaphoreCreateInfo es) -> IO b -> IO b
pokeZeroCStruct p :: Ptr (SemaphoreCreateInfo es)
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SemaphoreCreateInfo es)
p Ptr (SemaphoreCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SEMAPHORE_CREATE_INFO)
Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ forall a. PokeChain es => (Ptr (Chain es) -> IO a) -> IO a
forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SemaphoreCreateInfo es)
p Ptr (SemaphoreCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext'
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
instance (Extendss SemaphoreCreateInfo es, PeekChain es) => FromCStruct (SemaphoreCreateInfo es) where
peekCStruct :: Ptr (SemaphoreCreateInfo es) -> IO (SemaphoreCreateInfo es)
peekCStruct p :: Ptr (SemaphoreCreateInfo es)
p = do
Ptr ()
pNext <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (SemaphoreCreateInfo es)
p Ptr (SemaphoreCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ())))
Chain es
next <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
SemaphoreCreateFlags
flags <- Ptr SemaphoreCreateFlags -> IO SemaphoreCreateFlags
forall a. Storable a => Ptr a -> IO a
peek @SemaphoreCreateFlags ((Ptr (SemaphoreCreateInfo es)
p Ptr (SemaphoreCreateInfo es) -> Int -> Ptr SemaphoreCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr SemaphoreCreateFlags))
SemaphoreCreateInfo es -> IO (SemaphoreCreateInfo es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SemaphoreCreateInfo es -> IO (SemaphoreCreateInfo es))
-> SemaphoreCreateInfo es -> IO (SemaphoreCreateInfo es)
forall a b. (a -> b) -> a -> b
$ Chain es -> SemaphoreCreateFlags -> SemaphoreCreateInfo es
forall (es :: [*]).
Chain es -> SemaphoreCreateFlags -> SemaphoreCreateInfo es
SemaphoreCreateInfo
Chain es
next SemaphoreCreateFlags
flags
instance es ~ '[] => Zero (SemaphoreCreateInfo es) where
zero :: SemaphoreCreateInfo es
zero = Chain es -> SemaphoreCreateFlags -> SemaphoreCreateInfo es
forall (es :: [*]).
Chain es -> SemaphoreCreateFlags -> SemaphoreCreateInfo es
SemaphoreCreateInfo
()
SemaphoreCreateFlags
forall a. Zero a => a
zero