{-# language CPP #-}
module Vulkan.Core10.CommandPool ( createCommandPool
, withCommandPool
, destroyCommandPool
, resetCommandPool
, CommandPoolCreateInfo(..)
, CommandPool(..)
, CommandPoolCreateFlagBits(..)
, CommandPoolCreateFlags
, CommandPoolResetFlagBits(..)
, CommandPoolResetFlags
) 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 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.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Vulkan.NamedType ((:::))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks)
import Vulkan.Core10.Handles (CommandPool)
import Vulkan.Core10.Handles (CommandPool(..))
import Vulkan.Core10.Enums.CommandPoolCreateFlagBits (CommandPoolCreateFlags)
import Vulkan.Core10.Enums.CommandPoolResetFlagBits (CommandPoolResetFlagBits(..))
import Vulkan.Core10.Enums.CommandPoolResetFlagBits (CommandPoolResetFlags)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkCreateCommandPool))
import Vulkan.Dynamic (DeviceCmds(pVkDestroyCommandPool))
import Vulkan.Dynamic (DeviceCmds(pVkResetCommandPool))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_COMMAND_POOL_CREATE_INFO))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Core10.Handles (CommandPool(..))
import Vulkan.Core10.Enums.CommandPoolCreateFlagBits (CommandPoolCreateFlagBits(..))
import Vulkan.Core10.Enums.CommandPoolCreateFlagBits (CommandPoolCreateFlags)
import Vulkan.Core10.Enums.CommandPoolResetFlagBits (CommandPoolResetFlagBits(..))
import Vulkan.Core10.Enums.CommandPoolResetFlagBits (CommandPoolResetFlags)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkCreateCommandPool
:: FunPtr (Ptr Device_T -> Ptr CommandPoolCreateInfo -> Ptr AllocationCallbacks -> Ptr CommandPool -> IO Result) -> Ptr Device_T -> Ptr CommandPoolCreateInfo -> Ptr AllocationCallbacks -> Ptr CommandPool -> IO Result
createCommandPool :: forall io
. (MonadIO io)
=>
Device
->
CommandPoolCreateInfo
->
("allocator" ::: Maybe AllocationCallbacks)
-> io (CommandPool)
createCommandPool :: forall (io :: * -> *).
MonadIO io =>
Device
-> CommandPoolCreateInfo
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io CommandPool
createCommandPool Device
device CommandPoolCreateInfo
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 vkCreateCommandPoolPtr :: FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr CommandPoolCreateInfo)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pCommandPool" ::: Ptr CommandPool)
-> IO Result)
vkCreateCommandPoolPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr CommandPoolCreateInfo)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pCommandPool" ::: Ptr CommandPool)
-> IO Result)
pVkCreateCommandPool (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 CommandPoolCreateInfo)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pCommandPool" ::: Ptr CommandPool)
-> IO Result)
vkCreateCommandPoolPtr 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 vkCreateCommandPool is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkCreateCommandPool' :: Ptr Device_T
-> ("pCreateInfo" ::: Ptr CommandPoolCreateInfo)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pCommandPool" ::: Ptr CommandPool)
-> IO Result
vkCreateCommandPool' = FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr CommandPoolCreateInfo)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pCommandPool" ::: Ptr CommandPool)
-> IO Result)
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr CommandPoolCreateInfo)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pCommandPool" ::: Ptr CommandPool)
-> IO Result
mkVkCreateCommandPool FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr CommandPoolCreateInfo)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pCommandPool" ::: Ptr CommandPool)
-> IO Result)
vkCreateCommandPoolPtr
"pCreateInfo" ::: Ptr CommandPoolCreateInfo
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 (CommandPoolCreateInfo
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)
"pCommandPool" ::: Ptr CommandPool
pPCommandPool <- 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 @CommandPool 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
"vkCreateCommandPool" (Ptr Device_T
-> ("pCreateInfo" ::: Ptr CommandPoolCreateInfo)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pCommandPool" ::: Ptr CommandPool)
-> IO Result
vkCreateCommandPool'
(Device -> Ptr Device_T
deviceHandle (Device
device))
"pCreateInfo" ::: Ptr CommandPoolCreateInfo
pCreateInfo
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator
("pCommandPool" ::: Ptr CommandPool
pPCommandPool))
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))
CommandPool
pCommandPool <- 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 @CommandPool "pCommandPool" ::: Ptr CommandPool
pPCommandPool
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (CommandPool
pCommandPool)
withCommandPool :: forall io r . MonadIO io => Device -> CommandPoolCreateInfo -> Maybe AllocationCallbacks -> (io CommandPool -> (CommandPool -> io ()) -> r) -> r
withCommandPool :: forall (io :: * -> *) r.
MonadIO io =>
Device
-> CommandPoolCreateInfo
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io CommandPool -> (CommandPool -> io ()) -> r)
-> r
withCommandPool Device
device CommandPoolCreateInfo
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator io CommandPool -> (CommandPool -> io ()) -> r
b =
io CommandPool -> (CommandPool -> io ()) -> r
b (forall (io :: * -> *).
MonadIO io =>
Device
-> CommandPoolCreateInfo
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io CommandPool
createCommandPool Device
device CommandPoolCreateInfo
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
(\(CommandPool
o0) -> forall (io :: * -> *).
MonadIO io =>
Device
-> CommandPool
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyCommandPool Device
device CommandPool
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkDestroyCommandPool
:: FunPtr (Ptr Device_T -> CommandPool -> Ptr AllocationCallbacks -> IO ()) -> Ptr Device_T -> CommandPool -> Ptr AllocationCallbacks -> IO ()
destroyCommandPool :: forall io
. (MonadIO io)
=>
Device
->
CommandPool
->
("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyCommandPool :: forall (io :: * -> *).
MonadIO io =>
Device
-> CommandPool
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyCommandPool Device
device CommandPool
commandPool "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 vkDestroyCommandPoolPtr :: FunPtr
(Ptr Device_T
-> CommandPool
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
vkDestroyCommandPoolPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> CommandPool
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
pVkDestroyCommandPool (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
-> CommandPool
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
vkDestroyCommandPoolPtr 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 vkDestroyCommandPool is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkDestroyCommandPool' :: Ptr Device_T
-> CommandPool
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyCommandPool' = FunPtr
(Ptr Device_T
-> CommandPool
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
-> Ptr Device_T
-> CommandPool
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroyCommandPool FunPtr
(Ptr Device_T
-> CommandPool
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
vkDestroyCommandPoolPtr
"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
"vkDestroyCommandPool" (Ptr Device_T
-> CommandPool
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyCommandPool'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(CommandPool
commandPool)
"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" mkVkResetCommandPool
:: FunPtr (Ptr Device_T -> CommandPool -> CommandPoolResetFlags -> IO Result) -> Ptr Device_T -> CommandPool -> CommandPoolResetFlags -> IO Result
resetCommandPool :: forall io
. (MonadIO io)
=>
Device
->
CommandPool
->
CommandPoolResetFlags
-> io ()
resetCommandPool :: forall (io :: * -> *).
MonadIO io =>
Device -> CommandPool -> CommandPoolResetFlags -> io ()
resetCommandPool Device
device CommandPool
commandPool CommandPoolResetFlags
flags = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
let vkResetCommandPoolPtr :: FunPtr
(Ptr Device_T -> CommandPool -> CommandPoolResetFlags -> IO Result)
vkResetCommandPoolPtr = DeviceCmds
-> FunPtr
(Ptr Device_T -> CommandPool -> CommandPoolResetFlags -> IO Result)
pVkResetCommandPool (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 -> CommandPool -> CommandPoolResetFlags -> IO Result)
vkResetCommandPoolPtr 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 vkResetCommandPool is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkResetCommandPool' :: Ptr Device_T -> CommandPool -> CommandPoolResetFlags -> IO Result
vkResetCommandPool' = FunPtr
(Ptr Device_T -> CommandPool -> CommandPoolResetFlags -> IO Result)
-> Ptr Device_T
-> CommandPool
-> CommandPoolResetFlags
-> IO Result
mkVkResetCommandPool FunPtr
(Ptr Device_T -> CommandPool -> CommandPoolResetFlags -> IO Result)
vkResetCommandPoolPtr
Result
r <- forall a. String -> IO a -> IO a
traceAroundEvent String
"vkResetCommandPool" (Ptr Device_T -> CommandPool -> CommandPoolResetFlags -> IO Result
vkResetCommandPool'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(CommandPool
commandPool)
(CommandPoolResetFlags
flags))
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 CommandPoolCreateInfo = CommandPoolCreateInfo
{
CommandPoolCreateInfo -> CommandPoolCreateFlags
flags :: CommandPoolCreateFlags
,
CommandPoolCreateInfo -> Word32
queueFamilyIndex :: Word32
}
deriving (Typeable, CommandPoolCreateInfo -> CommandPoolCreateInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommandPoolCreateInfo -> CommandPoolCreateInfo -> Bool
$c/= :: CommandPoolCreateInfo -> CommandPoolCreateInfo -> Bool
== :: CommandPoolCreateInfo -> CommandPoolCreateInfo -> Bool
$c== :: CommandPoolCreateInfo -> CommandPoolCreateInfo -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CommandPoolCreateInfo)
#endif
deriving instance Show CommandPoolCreateInfo
instance ToCStruct CommandPoolCreateInfo where
withCStruct :: forall b.
CommandPoolCreateInfo
-> (("pCreateInfo" ::: Ptr CommandPoolCreateInfo) -> IO b) -> IO b
withCStruct CommandPoolCreateInfo
x ("pCreateInfo" ::: Ptr CommandPoolCreateInfo) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \"pCreateInfo" ::: Ptr CommandPoolCreateInfo
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCreateInfo" ::: Ptr CommandPoolCreateInfo
p CommandPoolCreateInfo
x (("pCreateInfo" ::: Ptr CommandPoolCreateInfo) -> IO b
f "pCreateInfo" ::: Ptr CommandPoolCreateInfo
p)
pokeCStruct :: forall b.
("pCreateInfo" ::: Ptr CommandPoolCreateInfo)
-> CommandPoolCreateInfo -> IO b -> IO b
pokeCStruct "pCreateInfo" ::: Ptr CommandPoolCreateInfo
p CommandPoolCreateInfo{Word32
CommandPoolCreateFlags
queueFamilyIndex :: Word32
flags :: CommandPoolCreateFlags
$sel:queueFamilyIndex:CommandPoolCreateInfo :: CommandPoolCreateInfo -> Word32
$sel:flags:CommandPoolCreateInfo :: CommandPoolCreateInfo -> CommandPoolCreateFlags
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CommandPoolCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COMMAND_POOL_CREATE_INFO)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CommandPoolCreateInfo
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 (("pCreateInfo" ::: Ptr CommandPoolCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CommandPoolCreateFlags)) (CommandPoolCreateFlags
flags)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CommandPoolCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (Word32
queueFamilyIndex)
IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
("pCreateInfo" ::: Ptr CommandPoolCreateInfo) -> IO b -> IO b
pokeZeroCStruct "pCreateInfo" ::: Ptr CommandPoolCreateInfo
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CommandPoolCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COMMAND_POOL_CREATE_INFO)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CommandPoolCreateInfo
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 (("pCreateInfo" ::: Ptr CommandPoolCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct CommandPoolCreateInfo where
peekCStruct :: ("pCreateInfo" ::: Ptr CommandPoolCreateInfo)
-> IO CommandPoolCreateInfo
peekCStruct "pCreateInfo" ::: Ptr CommandPoolCreateInfo
p = do
CommandPoolCreateFlags
flags <- forall a. Storable a => Ptr a -> IO a
peek @CommandPoolCreateFlags (("pCreateInfo" ::: Ptr CommandPoolCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CommandPoolCreateFlags))
Word32
queueFamilyIndex <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pCreateInfo" ::: Ptr CommandPoolCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ CommandPoolCreateFlags -> Word32 -> CommandPoolCreateInfo
CommandPoolCreateInfo
CommandPoolCreateFlags
flags Word32
queueFamilyIndex
instance Storable CommandPoolCreateInfo where
sizeOf :: CommandPoolCreateInfo -> Int
sizeOf ~CommandPoolCreateInfo
_ = Int
24
alignment :: CommandPoolCreateInfo -> Int
alignment ~CommandPoolCreateInfo
_ = Int
8
peek :: ("pCreateInfo" ::: Ptr CommandPoolCreateInfo)
-> IO CommandPoolCreateInfo
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: ("pCreateInfo" ::: Ptr CommandPoolCreateInfo)
-> CommandPoolCreateInfo -> IO ()
poke "pCreateInfo" ::: Ptr CommandPoolCreateInfo
ptr CommandPoolCreateInfo
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCreateInfo" ::: Ptr CommandPoolCreateInfo
ptr CommandPoolCreateInfo
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero CommandPoolCreateInfo where
zero :: CommandPoolCreateInfo
zero = CommandPoolCreateFlags -> Word32 -> CommandPoolCreateInfo
CommandPoolCreateInfo
forall a. Zero a => a
zero
forall a. Zero a => a
zero