{-# language CPP #-}
module Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore ( getSemaphoreCounterValue
, waitSemaphores
, waitSemaphoresSafe
, signalSemaphore
, PhysicalDeviceTimelineSemaphoreFeatures(..)
, PhysicalDeviceTimelineSemaphoreProperties(..)
, SemaphoreTypeCreateInfo(..)
, TimelineSemaphoreSubmitInfo(..)
, SemaphoreWaitInfo(..)
, SemaphoreSignalInfo(..)
, StructureType(..)
, SemaphoreType(..)
, SemaphoreWaitFlagBits(..)
, SemaphoreWaitFlags
) where
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
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 (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import qualified Data.Vector (null)
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.Typeable (Typeable)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
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.CStruct.Utils (advancePtrBytes)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkGetSemaphoreCounterValue))
import Vulkan.Dynamic (DeviceCmds(pVkSignalSemaphore))
import Vulkan.Dynamic (DeviceCmds(pVkWaitSemaphores))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Handles (Semaphore)
import Vulkan.Core10.Handles (Semaphore(..))
import Vulkan.Core12.Enums.SemaphoreType (SemaphoreType)
import Vulkan.Core12.Enums.SemaphoreWaitFlagBits (SemaphoreWaitFlags)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_TIMELINE_SEMAPHORE_FEATURES))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_TIMELINE_SEMAPHORE_PROPERTIES))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SEMAPHORE_SIGNAL_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SEMAPHORE_TYPE_CREATE_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SEMAPHORE_WAIT_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_TIMELINE_SEMAPHORE_SUBMIT_INFO))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Core12.Enums.SemaphoreType (SemaphoreType(..))
import Vulkan.Core12.Enums.SemaphoreWaitFlagBits (SemaphoreWaitFlagBits(..))
import Vulkan.Core12.Enums.SemaphoreWaitFlagBits (SemaphoreWaitFlags)
import Vulkan.Core10.Enums.StructureType (StructureType(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkGetSemaphoreCounterValue
:: FunPtr (Ptr Device_T -> Semaphore -> Ptr Word64 -> IO Result) -> Ptr Device_T -> Semaphore -> Ptr Word64 -> IO Result
getSemaphoreCounterValue :: forall io
. (MonadIO io)
=>
Device
->
Semaphore
-> io (("value" ::: Word64))
getSemaphoreCounterValue :: forall (io :: * -> *).
MonadIO io =>
Device -> Semaphore -> io ("value" ::: Word64)
getSemaphoreCounterValue Device
device Semaphore
semaphore = 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 vkGetSemaphoreCounterValuePtr :: FunPtr
(Ptr Device_T
-> Semaphore
-> ("pValue" ::: Ptr ("value" ::: Word64))
-> IO Result)
vkGetSemaphoreCounterValuePtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> Semaphore
-> ("pValue" ::: Ptr ("value" ::: Word64))
-> IO Result)
pVkGetSemaphoreCounterValue (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
-> Semaphore
-> ("pValue" ::: Ptr ("value" ::: Word64))
-> IO Result)
vkGetSemaphoreCounterValuePtr 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 vkGetSemaphoreCounterValue is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkGetSemaphoreCounterValue' :: Ptr Device_T
-> Semaphore
-> ("pValue" ::: Ptr ("value" ::: Word64))
-> IO Result
vkGetSemaphoreCounterValue' = FunPtr
(Ptr Device_T
-> Semaphore
-> ("pValue" ::: Ptr ("value" ::: Word64))
-> IO Result)
-> Ptr Device_T
-> Semaphore
-> ("pValue" ::: Ptr ("value" ::: Word64))
-> IO Result
mkVkGetSemaphoreCounterValue FunPtr
(Ptr Device_T
-> Semaphore
-> ("pValue" ::: Ptr ("value" ::: Word64))
-> IO Result)
vkGetSemaphoreCounterValuePtr
"pValue" ::: Ptr ("value" ::: Word64)
pPValue <- 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 @Word64 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
"vkGetSemaphoreCounterValue" (Ptr Device_T
-> Semaphore
-> ("pValue" ::: Ptr ("value" ::: Word64))
-> IO Result
vkGetSemaphoreCounterValue'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(Semaphore
semaphore)
("pValue" ::: Ptr ("value" ::: Word64)
pPValue))
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))
"value" ::: Word64
pValue <- 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 @Word64 "pValue" ::: Ptr ("value" ::: Word64)
pPValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ("value" ::: Word64
pValue)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkWaitSemaphoresUnsafe
:: FunPtr (Ptr Device_T -> Ptr SemaphoreWaitInfo -> Word64 -> IO Result) -> Ptr Device_T -> Ptr SemaphoreWaitInfo -> Word64 -> IO Result
foreign import ccall
"dynamic" mkVkWaitSemaphoresSafe
:: FunPtr (Ptr Device_T -> Ptr SemaphoreWaitInfo -> Word64 -> IO Result) -> Ptr Device_T -> Ptr SemaphoreWaitInfo -> Word64 -> IO Result
waitSemaphoresSafeOrUnsafe :: forall io
. (MonadIO io)
=> (FunPtr (Ptr Device_T -> Ptr SemaphoreWaitInfo -> Word64 -> IO Result) -> Ptr Device_T -> Ptr SemaphoreWaitInfo -> Word64 -> IO Result)
->
Device
->
SemaphoreWaitInfo
->
("timeout" ::: Word64)
-> io (Result)
waitSemaphoresSafeOrUnsafe :: forall (io :: * -> *).
MonadIO io =>
(FunPtr
(Ptr Device_T
-> Ptr SemaphoreWaitInfo -> ("value" ::: Word64) -> IO Result)
-> Ptr Device_T
-> Ptr SemaphoreWaitInfo
-> ("value" ::: Word64)
-> IO Result)
-> Device -> SemaphoreWaitInfo -> ("value" ::: Word64) -> io Result
waitSemaphoresSafeOrUnsafe FunPtr
(Ptr Device_T
-> Ptr SemaphoreWaitInfo -> ("value" ::: Word64) -> IO Result)
-> Ptr Device_T
-> Ptr SemaphoreWaitInfo
-> ("value" ::: Word64)
-> IO Result
mkVkWaitSemaphores Device
device
SemaphoreWaitInfo
waitInfo
"value" ::: 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 vkWaitSemaphoresPtr :: FunPtr
(Ptr Device_T
-> Ptr SemaphoreWaitInfo -> ("value" ::: Word64) -> IO Result)
vkWaitSemaphoresPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> Ptr SemaphoreWaitInfo -> ("value" ::: Word64) -> IO Result)
pVkWaitSemaphores (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
-> Ptr SemaphoreWaitInfo -> ("value" ::: Word64) -> IO Result)
vkWaitSemaphoresPtr 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 vkWaitSemaphores is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkWaitSemaphores' :: Ptr Device_T
-> Ptr SemaphoreWaitInfo -> ("value" ::: Word64) -> IO Result
vkWaitSemaphores' = FunPtr
(Ptr Device_T
-> Ptr SemaphoreWaitInfo -> ("value" ::: Word64) -> IO Result)
-> Ptr Device_T
-> Ptr SemaphoreWaitInfo
-> ("value" ::: Word64)
-> IO Result
mkVkWaitSemaphores FunPtr
(Ptr Device_T
-> Ptr SemaphoreWaitInfo -> ("value" ::: Word64) -> IO Result)
vkWaitSemaphoresPtr
Ptr SemaphoreWaitInfo
pWaitInfo <- 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 (SemaphoreWaitInfo
waitInfo)
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
"vkWaitSemaphores" (Ptr Device_T
-> Ptr SemaphoreWaitInfo -> ("value" ::: Word64) -> IO Result
vkWaitSemaphores'
(Device -> Ptr Device_T
deviceHandle (Device
device))
Ptr SemaphoreWaitInfo
pWaitInfo
("value" ::: 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)
waitSemaphores :: forall io
. (MonadIO io)
=>
Device
->
SemaphoreWaitInfo
->
("timeout" ::: Word64)
-> io (Result)
waitSemaphores :: forall (io :: * -> *).
MonadIO io =>
Device -> SemaphoreWaitInfo -> ("value" ::: Word64) -> io Result
waitSemaphores = forall (io :: * -> *).
MonadIO io =>
(FunPtr
(Ptr Device_T
-> Ptr SemaphoreWaitInfo -> ("value" ::: Word64) -> IO Result)
-> Ptr Device_T
-> Ptr SemaphoreWaitInfo
-> ("value" ::: Word64)
-> IO Result)
-> Device -> SemaphoreWaitInfo -> ("value" ::: Word64) -> io Result
waitSemaphoresSafeOrUnsafe FunPtr
(Ptr Device_T
-> Ptr SemaphoreWaitInfo -> ("value" ::: Word64) -> IO Result)
-> Ptr Device_T
-> Ptr SemaphoreWaitInfo
-> ("value" ::: Word64)
-> IO Result
mkVkWaitSemaphoresUnsafe
waitSemaphoresSafe :: forall io
. (MonadIO io)
=>
Device
->
SemaphoreWaitInfo
->
("timeout" ::: Word64)
-> io (Result)
waitSemaphoresSafe :: forall (io :: * -> *).
MonadIO io =>
Device -> SemaphoreWaitInfo -> ("value" ::: Word64) -> io Result
waitSemaphoresSafe = forall (io :: * -> *).
MonadIO io =>
(FunPtr
(Ptr Device_T
-> Ptr SemaphoreWaitInfo -> ("value" ::: Word64) -> IO Result)
-> Ptr Device_T
-> Ptr SemaphoreWaitInfo
-> ("value" ::: Word64)
-> IO Result)
-> Device -> SemaphoreWaitInfo -> ("value" ::: Word64) -> io Result
waitSemaphoresSafeOrUnsafe FunPtr
(Ptr Device_T
-> Ptr SemaphoreWaitInfo -> ("value" ::: Word64) -> IO Result)
-> Ptr Device_T
-> Ptr SemaphoreWaitInfo
-> ("value" ::: Word64)
-> IO Result
mkVkWaitSemaphoresSafe
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkSignalSemaphore
:: FunPtr (Ptr Device_T -> Ptr SemaphoreSignalInfo -> IO Result) -> Ptr Device_T -> Ptr SemaphoreSignalInfo -> IO Result
signalSemaphore :: forall io
. (MonadIO io)
=>
Device
->
SemaphoreSignalInfo
-> io ()
signalSemaphore :: forall (io :: * -> *).
MonadIO io =>
Device -> SemaphoreSignalInfo -> io ()
signalSemaphore Device
device SemaphoreSignalInfo
signalInfo = 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 vkSignalSemaphorePtr :: FunPtr
(Ptr Device_T
-> ("pSignalInfo" ::: Ptr SemaphoreSignalInfo) -> IO Result)
vkSignalSemaphorePtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> ("pSignalInfo" ::: Ptr SemaphoreSignalInfo) -> IO Result)
pVkSignalSemaphore (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
-> ("pSignalInfo" ::: Ptr SemaphoreSignalInfo) -> IO Result)
vkSignalSemaphorePtr 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 vkSignalSemaphore is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkSignalSemaphore' :: Ptr Device_T
-> ("pSignalInfo" ::: Ptr SemaphoreSignalInfo) -> IO Result
vkSignalSemaphore' = FunPtr
(Ptr Device_T
-> ("pSignalInfo" ::: Ptr SemaphoreSignalInfo) -> IO Result)
-> Ptr Device_T
-> ("pSignalInfo" ::: Ptr SemaphoreSignalInfo)
-> IO Result
mkVkSignalSemaphore FunPtr
(Ptr Device_T
-> ("pSignalInfo" ::: Ptr SemaphoreSignalInfo) -> IO Result)
vkSignalSemaphorePtr
"pSignalInfo" ::: Ptr SemaphoreSignalInfo
pSignalInfo <- 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 (SemaphoreSignalInfo
signalInfo)
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
"vkSignalSemaphore" (Ptr Device_T
-> ("pSignalInfo" ::: Ptr SemaphoreSignalInfo) -> IO Result
vkSignalSemaphore'
(Device -> Ptr Device_T
deviceHandle (Device
device))
"pSignalInfo" ::: Ptr SemaphoreSignalInfo
pSignalInfo)
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))
data PhysicalDeviceTimelineSemaphoreFeatures = PhysicalDeviceTimelineSemaphoreFeatures
{
PhysicalDeviceTimelineSemaphoreFeatures -> Bool
timelineSemaphore :: Bool }
deriving (Typeable, PhysicalDeviceTimelineSemaphoreFeatures
-> PhysicalDeviceTimelineSemaphoreFeatures -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceTimelineSemaphoreFeatures
-> PhysicalDeviceTimelineSemaphoreFeatures -> Bool
$c/= :: PhysicalDeviceTimelineSemaphoreFeatures
-> PhysicalDeviceTimelineSemaphoreFeatures -> Bool
== :: PhysicalDeviceTimelineSemaphoreFeatures
-> PhysicalDeviceTimelineSemaphoreFeatures -> Bool
$c== :: PhysicalDeviceTimelineSemaphoreFeatures
-> PhysicalDeviceTimelineSemaphoreFeatures -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceTimelineSemaphoreFeatures)
#endif
deriving instance Show PhysicalDeviceTimelineSemaphoreFeatures
instance ToCStruct PhysicalDeviceTimelineSemaphoreFeatures where
withCStruct :: forall b.
PhysicalDeviceTimelineSemaphoreFeatures
-> (Ptr PhysicalDeviceTimelineSemaphoreFeatures -> IO b) -> IO b
withCStruct PhysicalDeviceTimelineSemaphoreFeatures
x Ptr PhysicalDeviceTimelineSemaphoreFeatures -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceTimelineSemaphoreFeatures
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceTimelineSemaphoreFeatures
p PhysicalDeviceTimelineSemaphoreFeatures
x (Ptr PhysicalDeviceTimelineSemaphoreFeatures -> IO b
f Ptr PhysicalDeviceTimelineSemaphoreFeatures
p)
pokeCStruct :: forall b.
Ptr PhysicalDeviceTimelineSemaphoreFeatures
-> PhysicalDeviceTimelineSemaphoreFeatures -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceTimelineSemaphoreFeatures
p PhysicalDeviceTimelineSemaphoreFeatures{Bool
timelineSemaphore :: Bool
$sel:timelineSemaphore:PhysicalDeviceTimelineSemaphoreFeatures :: PhysicalDeviceTimelineSemaphoreFeatures -> Bool
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTimelineSemaphoreFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_TIMELINE_SEMAPHORE_FEATURES)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTimelineSemaphoreFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTimelineSemaphoreFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
timelineSemaphore))
IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceTimelineSemaphoreFeatures -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceTimelineSemaphoreFeatures
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTimelineSemaphoreFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_TIMELINE_SEMAPHORE_FEATURES)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTimelineSemaphoreFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTimelineSemaphoreFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
IO b
f
instance FromCStruct PhysicalDeviceTimelineSemaphoreFeatures where
peekCStruct :: Ptr PhysicalDeviceTimelineSemaphoreFeatures
-> IO PhysicalDeviceTimelineSemaphoreFeatures
peekCStruct Ptr PhysicalDeviceTimelineSemaphoreFeatures
p = do
Bool32
timelineSemaphore <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceTimelineSemaphoreFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> PhysicalDeviceTimelineSemaphoreFeatures
PhysicalDeviceTimelineSemaphoreFeatures
(Bool32 -> Bool
bool32ToBool Bool32
timelineSemaphore)
instance Storable PhysicalDeviceTimelineSemaphoreFeatures where
sizeOf :: PhysicalDeviceTimelineSemaphoreFeatures -> Int
sizeOf ~PhysicalDeviceTimelineSemaphoreFeatures
_ = Int
24
alignment :: PhysicalDeviceTimelineSemaphoreFeatures -> Int
alignment ~PhysicalDeviceTimelineSemaphoreFeatures
_ = Int
8
peek :: Ptr PhysicalDeviceTimelineSemaphoreFeatures
-> IO PhysicalDeviceTimelineSemaphoreFeatures
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr PhysicalDeviceTimelineSemaphoreFeatures
-> PhysicalDeviceTimelineSemaphoreFeatures -> IO ()
poke Ptr PhysicalDeviceTimelineSemaphoreFeatures
ptr PhysicalDeviceTimelineSemaphoreFeatures
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceTimelineSemaphoreFeatures
ptr PhysicalDeviceTimelineSemaphoreFeatures
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDeviceTimelineSemaphoreFeatures where
zero :: PhysicalDeviceTimelineSemaphoreFeatures
zero = Bool -> PhysicalDeviceTimelineSemaphoreFeatures
PhysicalDeviceTimelineSemaphoreFeatures
forall a. Zero a => a
zero
data PhysicalDeviceTimelineSemaphoreProperties = PhysicalDeviceTimelineSemaphoreProperties
{
PhysicalDeviceTimelineSemaphoreProperties -> "value" ::: Word64
maxTimelineSemaphoreValueDifference :: Word64 }
deriving (Typeable, PhysicalDeviceTimelineSemaphoreProperties
-> PhysicalDeviceTimelineSemaphoreProperties -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceTimelineSemaphoreProperties
-> PhysicalDeviceTimelineSemaphoreProperties -> Bool
$c/= :: PhysicalDeviceTimelineSemaphoreProperties
-> PhysicalDeviceTimelineSemaphoreProperties -> Bool
== :: PhysicalDeviceTimelineSemaphoreProperties
-> PhysicalDeviceTimelineSemaphoreProperties -> Bool
$c== :: PhysicalDeviceTimelineSemaphoreProperties
-> PhysicalDeviceTimelineSemaphoreProperties -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceTimelineSemaphoreProperties)
#endif
deriving instance Show PhysicalDeviceTimelineSemaphoreProperties
instance ToCStruct PhysicalDeviceTimelineSemaphoreProperties where
withCStruct :: forall b.
PhysicalDeviceTimelineSemaphoreProperties
-> (Ptr PhysicalDeviceTimelineSemaphoreProperties -> IO b) -> IO b
withCStruct PhysicalDeviceTimelineSemaphoreProperties
x Ptr PhysicalDeviceTimelineSemaphoreProperties -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceTimelineSemaphoreProperties
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceTimelineSemaphoreProperties
p PhysicalDeviceTimelineSemaphoreProperties
x (Ptr PhysicalDeviceTimelineSemaphoreProperties -> IO b
f Ptr PhysicalDeviceTimelineSemaphoreProperties
p)
pokeCStruct :: forall b.
Ptr PhysicalDeviceTimelineSemaphoreProperties
-> PhysicalDeviceTimelineSemaphoreProperties -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceTimelineSemaphoreProperties
p PhysicalDeviceTimelineSemaphoreProperties{"value" ::: Word64
maxTimelineSemaphoreValueDifference :: "value" ::: Word64
$sel:maxTimelineSemaphoreValueDifference:PhysicalDeviceTimelineSemaphoreProperties :: PhysicalDeviceTimelineSemaphoreProperties -> "value" ::: Word64
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTimelineSemaphoreProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_TIMELINE_SEMAPHORE_PROPERTIES)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTimelineSemaphoreProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTimelineSemaphoreProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word64)) ("value" ::: Word64
maxTimelineSemaphoreValueDifference)
IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceTimelineSemaphoreProperties -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceTimelineSemaphoreProperties
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTimelineSemaphoreProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_TIMELINE_SEMAPHORE_PROPERTIES)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTimelineSemaphoreProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTimelineSemaphoreProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word64)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct PhysicalDeviceTimelineSemaphoreProperties where
peekCStruct :: Ptr PhysicalDeviceTimelineSemaphoreProperties
-> IO PhysicalDeviceTimelineSemaphoreProperties
peekCStruct Ptr PhysicalDeviceTimelineSemaphoreProperties
p = do
"value" ::: Word64
maxTimelineSemaphoreValueDifference <- forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr PhysicalDeviceTimelineSemaphoreProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word64))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ("value" ::: Word64) -> PhysicalDeviceTimelineSemaphoreProperties
PhysicalDeviceTimelineSemaphoreProperties
"value" ::: Word64
maxTimelineSemaphoreValueDifference
instance Storable PhysicalDeviceTimelineSemaphoreProperties where
sizeOf :: PhysicalDeviceTimelineSemaphoreProperties -> Int
sizeOf ~PhysicalDeviceTimelineSemaphoreProperties
_ = Int
24
alignment :: PhysicalDeviceTimelineSemaphoreProperties -> Int
alignment ~PhysicalDeviceTimelineSemaphoreProperties
_ = Int
8
peek :: Ptr PhysicalDeviceTimelineSemaphoreProperties
-> IO PhysicalDeviceTimelineSemaphoreProperties
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr PhysicalDeviceTimelineSemaphoreProperties
-> PhysicalDeviceTimelineSemaphoreProperties -> IO ()
poke Ptr PhysicalDeviceTimelineSemaphoreProperties
ptr PhysicalDeviceTimelineSemaphoreProperties
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceTimelineSemaphoreProperties
ptr PhysicalDeviceTimelineSemaphoreProperties
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDeviceTimelineSemaphoreProperties where
zero :: PhysicalDeviceTimelineSemaphoreProperties
zero = ("value" ::: Word64) -> PhysicalDeviceTimelineSemaphoreProperties
PhysicalDeviceTimelineSemaphoreProperties
forall a. Zero a => a
zero
data SemaphoreTypeCreateInfo = SemaphoreTypeCreateInfo
{
SemaphoreTypeCreateInfo -> SemaphoreType
semaphoreType :: SemaphoreType
,
SemaphoreTypeCreateInfo -> "value" ::: Word64
initialValue :: Word64
}
deriving (Typeable, SemaphoreTypeCreateInfo -> SemaphoreTypeCreateInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SemaphoreTypeCreateInfo -> SemaphoreTypeCreateInfo -> Bool
$c/= :: SemaphoreTypeCreateInfo -> SemaphoreTypeCreateInfo -> Bool
== :: SemaphoreTypeCreateInfo -> SemaphoreTypeCreateInfo -> Bool
$c== :: SemaphoreTypeCreateInfo -> SemaphoreTypeCreateInfo -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SemaphoreTypeCreateInfo)
#endif
deriving instance Show SemaphoreTypeCreateInfo
instance ToCStruct SemaphoreTypeCreateInfo where
withCStruct :: forall b.
SemaphoreTypeCreateInfo
-> (Ptr SemaphoreTypeCreateInfo -> IO b) -> IO b
withCStruct SemaphoreTypeCreateInfo
x Ptr SemaphoreTypeCreateInfo -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \Ptr SemaphoreTypeCreateInfo
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SemaphoreTypeCreateInfo
p SemaphoreTypeCreateInfo
x (Ptr SemaphoreTypeCreateInfo -> IO b
f Ptr SemaphoreTypeCreateInfo
p)
pokeCStruct :: forall b.
Ptr SemaphoreTypeCreateInfo
-> SemaphoreTypeCreateInfo -> IO b -> IO b
pokeCStruct Ptr SemaphoreTypeCreateInfo
p SemaphoreTypeCreateInfo{"value" ::: Word64
SemaphoreType
initialValue :: "value" ::: Word64
semaphoreType :: SemaphoreType
$sel:initialValue:SemaphoreTypeCreateInfo :: SemaphoreTypeCreateInfo -> "value" ::: Word64
$sel:semaphoreType:SemaphoreTypeCreateInfo :: SemaphoreTypeCreateInfo -> SemaphoreType
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SemaphoreTypeCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SEMAPHORE_TYPE_CREATE_INFO)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SemaphoreTypeCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SemaphoreTypeCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr SemaphoreType)) (SemaphoreType
semaphoreType)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SemaphoreTypeCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word64)) ("value" ::: Word64
initialValue)
IO b
f
cStructSize :: Int
cStructSize = Int
32
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b. Ptr SemaphoreTypeCreateInfo -> IO b -> IO b
pokeZeroCStruct Ptr SemaphoreTypeCreateInfo
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SemaphoreTypeCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SEMAPHORE_TYPE_CREATE_INFO)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SemaphoreTypeCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SemaphoreTypeCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr SemaphoreType)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SemaphoreTypeCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word64)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct SemaphoreTypeCreateInfo where
peekCStruct :: Ptr SemaphoreTypeCreateInfo -> IO SemaphoreTypeCreateInfo
peekCStruct Ptr SemaphoreTypeCreateInfo
p = do
SemaphoreType
semaphoreType <- forall a. Storable a => Ptr a -> IO a
peek @SemaphoreType ((Ptr SemaphoreTypeCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr SemaphoreType))
"value" ::: Word64
initialValue <- forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr SemaphoreTypeCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word64))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SemaphoreType -> ("value" ::: Word64) -> SemaphoreTypeCreateInfo
SemaphoreTypeCreateInfo
SemaphoreType
semaphoreType "value" ::: Word64
initialValue
instance Storable SemaphoreTypeCreateInfo where
sizeOf :: SemaphoreTypeCreateInfo -> Int
sizeOf ~SemaphoreTypeCreateInfo
_ = Int
32
alignment :: SemaphoreTypeCreateInfo -> Int
alignment ~SemaphoreTypeCreateInfo
_ = Int
8
peek :: Ptr SemaphoreTypeCreateInfo -> IO SemaphoreTypeCreateInfo
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr SemaphoreTypeCreateInfo -> SemaphoreTypeCreateInfo -> IO ()
poke Ptr SemaphoreTypeCreateInfo
ptr SemaphoreTypeCreateInfo
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SemaphoreTypeCreateInfo
ptr SemaphoreTypeCreateInfo
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero SemaphoreTypeCreateInfo where
zero :: SemaphoreTypeCreateInfo
zero = SemaphoreType -> ("value" ::: Word64) -> SemaphoreTypeCreateInfo
SemaphoreTypeCreateInfo
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data TimelineSemaphoreSubmitInfo = TimelineSemaphoreSubmitInfo
{
TimelineSemaphoreSubmitInfo -> Word32
waitSemaphoreValueCount :: Word32
,
TimelineSemaphoreSubmitInfo -> Vector ("value" ::: Word64)
waitSemaphoreValues :: Vector Word64
,
TimelineSemaphoreSubmitInfo -> Word32
signalSemaphoreValueCount :: Word32
,
TimelineSemaphoreSubmitInfo -> Vector ("value" ::: Word64)
signalSemaphoreValues :: Vector Word64
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (TimelineSemaphoreSubmitInfo)
#endif
deriving instance Show TimelineSemaphoreSubmitInfo
instance ToCStruct TimelineSemaphoreSubmitInfo where
withCStruct :: forall b.
TimelineSemaphoreSubmitInfo
-> (Ptr TimelineSemaphoreSubmitInfo -> IO b) -> IO b
withCStruct TimelineSemaphoreSubmitInfo
x Ptr TimelineSemaphoreSubmitInfo -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
48 forall a b. (a -> b) -> a -> b
$ \Ptr TimelineSemaphoreSubmitInfo
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr TimelineSemaphoreSubmitInfo
p TimelineSemaphoreSubmitInfo
x (Ptr TimelineSemaphoreSubmitInfo -> IO b
f Ptr TimelineSemaphoreSubmitInfo
p)
pokeCStruct :: forall b.
Ptr TimelineSemaphoreSubmitInfo
-> TimelineSemaphoreSubmitInfo -> IO b -> IO b
pokeCStruct Ptr TimelineSemaphoreSubmitInfo
p TimelineSemaphoreSubmitInfo{Word32
Vector ("value" ::: Word64)
signalSemaphoreValues :: Vector ("value" ::: Word64)
signalSemaphoreValueCount :: Word32
waitSemaphoreValues :: Vector ("value" ::: Word64)
waitSemaphoreValueCount :: Word32
$sel:signalSemaphoreValues:TimelineSemaphoreSubmitInfo :: TimelineSemaphoreSubmitInfo -> Vector ("value" ::: Word64)
$sel:signalSemaphoreValueCount:TimelineSemaphoreSubmitInfo :: TimelineSemaphoreSubmitInfo -> Word32
$sel:waitSemaphoreValues:TimelineSemaphoreSubmitInfo :: TimelineSemaphoreSubmitInfo -> Vector ("value" ::: Word64)
$sel:waitSemaphoreValueCount:TimelineSemaphoreSubmitInfo :: TimelineSemaphoreSubmitInfo -> Word32
..} 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 TimelineSemaphoreSubmitInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_TIMELINE_SEMAPHORE_SUBMIT_INFO)
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 TimelineSemaphoreSubmitInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
let pWaitSemaphoreValuesLength :: Int
pWaitSemaphoreValuesLength = forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector ("value" ::: Word64)
waitSemaphoreValues)
Word32
waitSemaphoreValueCount'' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ if (Word32
waitSemaphoreValueCount) forall a. Eq a => a -> a -> Bool
== Word32
0
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pWaitSemaphoreValuesLength
else do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pWaitSemaphoreValuesLength forall a. Eq a => a -> a -> Bool
== (Word32
waitSemaphoreValueCount) Bool -> Bool -> Bool
|| Int
pWaitSemaphoreValuesLength forall a. Eq a => a -> a -> Bool
== Int
0) 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
"pWaitSemaphoreValues must be empty or have 'waitSemaphoreValueCount' elements" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32
waitSemaphoreValueCount)
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 TimelineSemaphoreSubmitInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
waitSemaphoreValueCount'')
"pValue" ::: Ptr ("value" ::: Word64)
pWaitSemaphoreValues'' <- if forall a. Vector a -> Bool
Data.Vector.null (Vector ("value" ::: Word64)
waitSemaphoreValues)
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
else do
"pValue" ::: Ptr ("value" ::: Word64)
pPWaitSemaphoreValues <- 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 @Word64 (((forall a. Vector a -> Int
Data.Vector.length (Vector ("value" ::: Word64)
waitSemaphoreValues))) 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 "value" ::: Word64
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke ("pValue" ::: Ptr ("value" ::: Word64)
pPWaitSemaphoreValues forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word64) ("value" ::: Word64
e)) ((Vector ("value" ::: Word64)
waitSemaphoreValues))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ "pValue" ::: Ptr ("value" ::: Word64)
pPWaitSemaphoreValues
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 TimelineSemaphoreSubmitInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr Word64))) "pValue" ::: Ptr ("value" ::: Word64)
pWaitSemaphoreValues''
let pSignalSemaphoreValuesLength :: Int
pSignalSemaphoreValuesLength = forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector ("value" ::: Word64)
signalSemaphoreValues)
Word32
signalSemaphoreValueCount'' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ if (Word32
signalSemaphoreValueCount) forall a. Eq a => a -> a -> Bool
== Word32
0
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pSignalSemaphoreValuesLength
else do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pSignalSemaphoreValuesLength forall a. Eq a => a -> a -> Bool
== (Word32
signalSemaphoreValueCount) Bool -> Bool -> Bool
|| Int
pSignalSemaphoreValuesLength forall a. Eq a => a -> a -> Bool
== Int
0) 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
"pSignalSemaphoreValues must be empty or have 'signalSemaphoreValueCount' elements" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32
signalSemaphoreValueCount)
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 TimelineSemaphoreSubmitInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) (Word32
signalSemaphoreValueCount'')
"pValue" ::: Ptr ("value" ::: Word64)
pSignalSemaphoreValues'' <- if forall a. Vector a -> Bool
Data.Vector.null (Vector ("value" ::: Word64)
signalSemaphoreValues)
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
else do
"pValue" ::: Ptr ("value" ::: Word64)
pPSignalSemaphoreValues <- 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 @Word64 (((forall a. Vector a -> Int
Data.Vector.length (Vector ("value" ::: Word64)
signalSemaphoreValues))) 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 "value" ::: Word64
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke ("pValue" ::: Ptr ("value" ::: Word64)
pPSignalSemaphoreValues forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word64) ("value" ::: Word64
e)) ((Vector ("value" ::: Word64)
signalSemaphoreValues))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ "pValue" ::: Ptr ("value" ::: Word64)
pPSignalSemaphoreValues
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 TimelineSemaphoreSubmitInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr Word64))) "pValue" ::: Ptr ("value" ::: Word64)
pSignalSemaphoreValues''
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
48
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b. Ptr TimelineSemaphoreSubmitInfo -> IO b -> IO b
pokeZeroCStruct Ptr TimelineSemaphoreSubmitInfo
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr TimelineSemaphoreSubmitInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_TIMELINE_SEMAPHORE_SUBMIT_INFO)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr TimelineSemaphoreSubmitInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
IO b
f
instance FromCStruct TimelineSemaphoreSubmitInfo where
peekCStruct :: Ptr TimelineSemaphoreSubmitInfo -> IO TimelineSemaphoreSubmitInfo
peekCStruct Ptr TimelineSemaphoreSubmitInfo
p = do
Word32
waitSemaphoreValueCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr TimelineSemaphoreSubmitInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
"pValue" ::: Ptr ("value" ::: Word64)
pWaitSemaphoreValues <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr Word64) ((Ptr TimelineSemaphoreSubmitInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr Word64)))
let pWaitSemaphoreValuesLength :: Int
pWaitSemaphoreValuesLength = if "pValue" ::: Ptr ("value" ::: Word64)
pWaitSemaphoreValues forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr then Int
0 else (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
waitSemaphoreValueCount)
Vector ("value" ::: Word64)
pWaitSemaphoreValues' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM Int
pWaitSemaphoreValuesLength (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @Word64 (("pValue" ::: Ptr ("value" ::: Word64)
pWaitSemaphoreValues forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word64)))
Word32
signalSemaphoreValueCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr TimelineSemaphoreSubmitInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32))
"pValue" ::: Ptr ("value" ::: Word64)
pSignalSemaphoreValues <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr Word64) ((Ptr TimelineSemaphoreSubmitInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr Word64)))
let pSignalSemaphoreValuesLength :: Int
pSignalSemaphoreValuesLength = if "pValue" ::: Ptr ("value" ::: Word64)
pSignalSemaphoreValues forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr then Int
0 else (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
signalSemaphoreValueCount)
Vector ("value" ::: Word64)
pSignalSemaphoreValues' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM Int
pSignalSemaphoreValuesLength (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @Word64 (("pValue" ::: Ptr ("value" ::: Word64)
pSignalSemaphoreValues forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word64)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word32
-> Vector ("value" ::: Word64)
-> Word32
-> Vector ("value" ::: Word64)
-> TimelineSemaphoreSubmitInfo
TimelineSemaphoreSubmitInfo
Word32
waitSemaphoreValueCount
Vector ("value" ::: Word64)
pWaitSemaphoreValues'
Word32
signalSemaphoreValueCount
Vector ("value" ::: Word64)
pSignalSemaphoreValues'
instance Zero TimelineSemaphoreSubmitInfo where
zero :: TimelineSemaphoreSubmitInfo
zero = Word32
-> Vector ("value" ::: Word64)
-> Word32
-> Vector ("value" ::: Word64)
-> TimelineSemaphoreSubmitInfo
TimelineSemaphoreSubmitInfo
forall a. Zero a => a
zero
forall a. Monoid a => a
mempty
forall a. Zero a => a
zero
forall a. Monoid a => a
mempty
data SemaphoreWaitInfo = SemaphoreWaitInfo
{
SemaphoreWaitInfo -> SemaphoreWaitFlags
flags :: SemaphoreWaitFlags
,
SemaphoreWaitInfo -> Vector Semaphore
semaphores :: Vector Semaphore
,
SemaphoreWaitInfo -> Vector ("value" ::: Word64)
values :: Vector Word64
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SemaphoreWaitInfo)
#endif
deriving instance Show SemaphoreWaitInfo
instance ToCStruct SemaphoreWaitInfo where
withCStruct :: forall b.
SemaphoreWaitInfo -> (Ptr SemaphoreWaitInfo -> IO b) -> IO b
withCStruct SemaphoreWaitInfo
x Ptr SemaphoreWaitInfo -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
40 forall a b. (a -> b) -> a -> b
$ \Ptr SemaphoreWaitInfo
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SemaphoreWaitInfo
p SemaphoreWaitInfo
x (Ptr SemaphoreWaitInfo -> IO b
f Ptr SemaphoreWaitInfo
p)
pokeCStruct :: forall b.
Ptr SemaphoreWaitInfo -> SemaphoreWaitInfo -> IO b -> IO b
pokeCStruct Ptr SemaphoreWaitInfo
p SemaphoreWaitInfo{Vector ("value" ::: Word64)
Vector Semaphore
SemaphoreWaitFlags
values :: Vector ("value" ::: Word64)
semaphores :: Vector Semaphore
flags :: SemaphoreWaitFlags
$sel:values:SemaphoreWaitInfo :: SemaphoreWaitInfo -> Vector ("value" ::: Word64)
$sel:semaphores:SemaphoreWaitInfo :: SemaphoreWaitInfo -> Vector Semaphore
$sel:flags:SemaphoreWaitInfo :: SemaphoreWaitInfo -> SemaphoreWaitFlags
..} 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 SemaphoreWaitInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SEMAPHORE_WAIT_INFO)
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 SemaphoreWaitInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
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 SemaphoreWaitInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr SemaphoreWaitFlags)) (SemaphoreWaitFlags
flags)
let pSemaphoresLength :: Int
pSemaphoresLength = forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector Semaphore
semaphores)
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 ((forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector ("value" ::: Word64)
values)) forall a. Eq a => a -> a -> Bool
== Int
pSemaphoresLength) 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
"pValues and pSemaphores must have the same length" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
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 SemaphoreWaitInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) ((forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pSemaphoresLength :: Word32))
Ptr Semaphore
pPSemaphores' <- 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 @Semaphore ((forall a. Vector a -> Int
Data.Vector.length (Vector Semaphore
semaphores)) 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 Semaphore
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Semaphore
pPSemaphores' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Semaphore) (Semaphore
e)) (Vector Semaphore
semaphores)
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 SemaphoreWaitInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr Semaphore))) (Ptr Semaphore
pPSemaphores')
"pValue" ::: Ptr ("value" ::: Word64)
pPValues' <- 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 @Word64 ((forall a. Vector a -> Int
Data.Vector.length (Vector ("value" ::: Word64)
values)) 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 "value" ::: Word64
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke ("pValue" ::: Ptr ("value" ::: Word64)
pPValues' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word64) ("value" ::: Word64
e)) (Vector ("value" ::: Word64)
values)
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 SemaphoreWaitInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (Ptr Word64))) ("pValue" ::: Ptr ("value" ::: Word64)
pPValues')
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
40
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b. Ptr SemaphoreWaitInfo -> IO b -> IO b
pokeZeroCStruct Ptr SemaphoreWaitInfo
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SemaphoreWaitInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SEMAPHORE_WAIT_INFO)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SemaphoreWaitInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
IO b
f
instance FromCStruct SemaphoreWaitInfo where
peekCStruct :: Ptr SemaphoreWaitInfo -> IO SemaphoreWaitInfo
peekCStruct Ptr SemaphoreWaitInfo
p = do
SemaphoreWaitFlags
flags <- forall a. Storable a => Ptr a -> IO a
peek @SemaphoreWaitFlags ((Ptr SemaphoreWaitInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr SemaphoreWaitFlags))
Word32
semaphoreCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr SemaphoreWaitInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32))
Ptr Semaphore
pSemaphores <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr Semaphore) ((Ptr SemaphoreWaitInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr Semaphore)))
Vector Semaphore
pSemaphores' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
semaphoreCount) (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @Semaphore ((Ptr Semaphore
pSemaphores forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Semaphore)))
"pValue" ::: Ptr ("value" ::: Word64)
pValues <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr Word64) ((Ptr SemaphoreWaitInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (Ptr Word64)))
Vector ("value" ::: Word64)
pValues' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
semaphoreCount) (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @Word64 (("pValue" ::: Ptr ("value" ::: Word64)
pValues forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word64)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SemaphoreWaitFlags
-> Vector Semaphore
-> Vector ("value" ::: Word64)
-> SemaphoreWaitInfo
SemaphoreWaitInfo
SemaphoreWaitFlags
flags Vector Semaphore
pSemaphores' Vector ("value" ::: Word64)
pValues'
instance Zero SemaphoreWaitInfo where
zero :: SemaphoreWaitInfo
zero = SemaphoreWaitFlags
-> Vector Semaphore
-> Vector ("value" ::: Word64)
-> SemaphoreWaitInfo
SemaphoreWaitInfo
forall a. Zero a => a
zero
forall a. Monoid a => a
mempty
forall a. Monoid a => a
mempty
data SemaphoreSignalInfo = SemaphoreSignalInfo
{
SemaphoreSignalInfo -> Semaphore
semaphore :: Semaphore
,
SemaphoreSignalInfo -> "value" ::: Word64
value :: Word64
}
deriving (Typeable, SemaphoreSignalInfo -> SemaphoreSignalInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SemaphoreSignalInfo -> SemaphoreSignalInfo -> Bool
$c/= :: SemaphoreSignalInfo -> SemaphoreSignalInfo -> Bool
== :: SemaphoreSignalInfo -> SemaphoreSignalInfo -> Bool
$c== :: SemaphoreSignalInfo -> SemaphoreSignalInfo -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SemaphoreSignalInfo)
#endif
deriving instance Show SemaphoreSignalInfo
instance ToCStruct SemaphoreSignalInfo where
withCStruct :: forall b.
SemaphoreSignalInfo
-> (("pSignalInfo" ::: Ptr SemaphoreSignalInfo) -> IO b) -> IO b
withCStruct SemaphoreSignalInfo
x ("pSignalInfo" ::: Ptr SemaphoreSignalInfo) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \"pSignalInfo" ::: Ptr SemaphoreSignalInfo
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pSignalInfo" ::: Ptr SemaphoreSignalInfo
p SemaphoreSignalInfo
x (("pSignalInfo" ::: Ptr SemaphoreSignalInfo) -> IO b
f "pSignalInfo" ::: Ptr SemaphoreSignalInfo
p)
pokeCStruct :: forall b.
("pSignalInfo" ::: Ptr SemaphoreSignalInfo)
-> SemaphoreSignalInfo -> IO b -> IO b
pokeCStruct "pSignalInfo" ::: Ptr SemaphoreSignalInfo
p SemaphoreSignalInfo{"value" ::: Word64
Semaphore
value :: "value" ::: Word64
semaphore :: Semaphore
$sel:value:SemaphoreSignalInfo :: SemaphoreSignalInfo -> "value" ::: Word64
$sel:semaphore:SemaphoreSignalInfo :: SemaphoreSignalInfo -> Semaphore
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSignalInfo" ::: Ptr SemaphoreSignalInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SEMAPHORE_SIGNAL_INFO)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSignalInfo" ::: Ptr SemaphoreSignalInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSignalInfo" ::: Ptr SemaphoreSignalInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Semaphore)) (Semaphore
semaphore)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSignalInfo" ::: Ptr SemaphoreSignalInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word64)) ("value" ::: Word64
value)
IO b
f
cStructSize :: Int
cStructSize = Int
32
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
("pSignalInfo" ::: Ptr SemaphoreSignalInfo) -> IO b -> IO b
pokeZeroCStruct "pSignalInfo" ::: Ptr SemaphoreSignalInfo
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSignalInfo" ::: Ptr SemaphoreSignalInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SEMAPHORE_SIGNAL_INFO)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSignalInfo" ::: Ptr SemaphoreSignalInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSignalInfo" ::: Ptr SemaphoreSignalInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Semaphore)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSignalInfo" ::: Ptr SemaphoreSignalInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word64)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct SemaphoreSignalInfo where
peekCStruct :: ("pSignalInfo" ::: Ptr SemaphoreSignalInfo)
-> IO SemaphoreSignalInfo
peekCStruct "pSignalInfo" ::: Ptr SemaphoreSignalInfo
p = do
Semaphore
semaphore <- forall a. Storable a => Ptr a -> IO a
peek @Semaphore (("pSignalInfo" ::: Ptr SemaphoreSignalInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Semaphore))
"value" ::: Word64
value <- forall a. Storable a => Ptr a -> IO a
peek @Word64 (("pSignalInfo" ::: Ptr SemaphoreSignalInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word64))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Semaphore -> ("value" ::: Word64) -> SemaphoreSignalInfo
SemaphoreSignalInfo
Semaphore
semaphore "value" ::: Word64
value
instance Storable SemaphoreSignalInfo where
sizeOf :: SemaphoreSignalInfo -> Int
sizeOf ~SemaphoreSignalInfo
_ = Int
32
alignment :: SemaphoreSignalInfo -> Int
alignment ~SemaphoreSignalInfo
_ = Int
8
peek :: ("pSignalInfo" ::: Ptr SemaphoreSignalInfo)
-> IO SemaphoreSignalInfo
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: ("pSignalInfo" ::: Ptr SemaphoreSignalInfo)
-> SemaphoreSignalInfo -> IO ()
poke "pSignalInfo" ::: Ptr SemaphoreSignalInfo
ptr SemaphoreSignalInfo
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pSignalInfo" ::: Ptr SemaphoreSignalInfo
ptr SemaphoreSignalInfo
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero SemaphoreSignalInfo where
zero :: SemaphoreSignalInfo
zero = Semaphore -> ("value" ::: Word64) -> SemaphoreSignalInfo
SemaphoreSignalInfo
forall a. Zero a => a
zero
forall a. Zero a => a
zero