{-# language CPP #-}
module Vulkan.Extensions.VK_NV_device_generated_commands_compute ( cmdUpdatePipelineIndirectBufferNV
, getPipelineIndirectMemoryRequirementsNV
, getPipelineIndirectDeviceAddressNV
, ComputePipelineIndirectBufferInfoNV(..)
, PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV(..)
, PipelineIndirectDeviceAddressInfoNV(..)
, BindPipelineIndirectCommandNV(..)
, NV_DEVICE_GENERATED_COMMANDS_COMPUTE_SPEC_VERSION
, pattern NV_DEVICE_GENERATED_COMMANDS_COMPUTE_SPEC_VERSION
, NV_DEVICE_GENERATED_COMMANDS_COMPUTE_EXTENSION_NAME
, pattern NV_DEVICE_GENERATED_COMMANDS_COMPUTE_EXTENSION_NAME
, IndirectCommandsTokenTypeNV(..)
) where
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytes)
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.String (IsString)
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.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.CStruct.Extends (forgetExtensions)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Handles (CommandBuffer)
import Vulkan.Core10.Handles (CommandBuffer(..))
import Vulkan.Core10.Handles (CommandBuffer(CommandBuffer))
import Vulkan.Core10.Handles (CommandBuffer_T)
import Vulkan.Core10.Pipeline (ComputePipelineCreateInfo)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Core10.FundamentalTypes (DeviceAddress)
import Vulkan.Dynamic (DeviceCmds(pVkCmdUpdatePipelineIndirectBufferNV))
import Vulkan.Dynamic (DeviceCmds(pVkGetPipelineIndirectDeviceAddressNV))
import Vulkan.Dynamic (DeviceCmds(pVkGetPipelineIndirectMemoryRequirementsNV))
import Vulkan.Core10.FundamentalTypes (DeviceSize)
import Vulkan.Core10.Handles (Device_T)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.Core11.Promoted_From_VK_KHR_get_memory_requirements2 (MemoryRequirements2)
import Vulkan.CStruct.Extends (PeekChain)
import Vulkan.Core10.Handles (Pipeline)
import Vulkan.Core10.Handles (Pipeline(..))
import Vulkan.Core10.Enums.PipelineBindPoint (PipelineBindPoint)
import Vulkan.Core10.Enums.PipelineBindPoint (PipelineBindPoint(..))
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (SomeStruct)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_COMPUTE_PIPELINE_INDIRECT_BUFFER_INFO_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_DEVICE_GENERATED_COMMANDS_COMPUTE_FEATURES_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_INDIRECT_DEVICE_ADDRESS_INFO_NV))
import Vulkan.Extensions.VK_NV_device_generated_commands (IndirectCommandsTokenTypeNV(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkCmdUpdatePipelineIndirectBufferNV
:: FunPtr (Ptr CommandBuffer_T -> PipelineBindPoint -> Pipeline -> IO ()) -> Ptr CommandBuffer_T -> PipelineBindPoint -> Pipeline -> IO ()
cmdUpdatePipelineIndirectBufferNV :: forall io
. (MonadIO io)
=>
CommandBuffer
->
PipelineBindPoint
->
Pipeline
-> io ()
cmdUpdatePipelineIndirectBufferNV :: forall (io :: * -> *).
MonadIO io =>
CommandBuffer -> PipelineBindPoint -> Pipeline -> io ()
cmdUpdatePipelineIndirectBufferNV CommandBuffer
commandBuffer
PipelineBindPoint
pipelineBindPoint
Pipeline
pipeline = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
let vkCmdUpdatePipelineIndirectBufferNVPtr :: FunPtr
(Ptr CommandBuffer_T -> PipelineBindPoint -> Pipeline -> IO ())
vkCmdUpdatePipelineIndirectBufferNVPtr = DeviceCmds
-> FunPtr
(Ptr CommandBuffer_T -> PipelineBindPoint -> Pipeline -> IO ())
pVkCmdUpdatePipelineIndirectBufferNV (case CommandBuffer
commandBuffer of CommandBuffer{DeviceCmds
$sel:deviceCmds:CommandBuffer :: CommandBuffer -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr CommandBuffer_T -> PipelineBindPoint -> Pipeline -> IO ())
vkCmdUpdatePipelineIndirectBufferNVPtr 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 vkCmdUpdatePipelineIndirectBufferNV is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkCmdUpdatePipelineIndirectBufferNV' :: Ptr CommandBuffer_T -> PipelineBindPoint -> Pipeline -> IO ()
vkCmdUpdatePipelineIndirectBufferNV' = FunPtr
(Ptr CommandBuffer_T -> PipelineBindPoint -> Pipeline -> IO ())
-> Ptr CommandBuffer_T -> PipelineBindPoint -> Pipeline -> IO ()
mkVkCmdUpdatePipelineIndirectBufferNV FunPtr
(Ptr CommandBuffer_T -> PipelineBindPoint -> Pipeline -> IO ())
vkCmdUpdatePipelineIndirectBufferNVPtr
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdUpdatePipelineIndirectBufferNV" (Ptr CommandBuffer_T -> PipelineBindPoint -> Pipeline -> IO ()
vkCmdUpdatePipelineIndirectBufferNV'
(CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer))
(PipelineBindPoint
pipelineBindPoint)
(Pipeline
pipeline))
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" mkVkGetPipelineIndirectMemoryRequirementsNV
:: FunPtr (Ptr Device_T -> Ptr (SomeStruct ComputePipelineCreateInfo) -> Ptr (SomeStruct MemoryRequirements2) -> IO ()) -> Ptr Device_T -> Ptr (SomeStruct ComputePipelineCreateInfo) -> Ptr (SomeStruct MemoryRequirements2) -> IO ()
getPipelineIndirectMemoryRequirementsNV :: forall a b io
. ( Extendss ComputePipelineCreateInfo a
, PokeChain a
, Extendss MemoryRequirements2 b
, PokeChain b
, PeekChain b
, MonadIO io )
=>
Device
->
(ComputePipelineCreateInfo a)
-> io (MemoryRequirements2 b)
getPipelineIndirectMemoryRequirementsNV :: forall (a :: [*]) (b :: [*]) (io :: * -> *).
(Extendss ComputePipelineCreateInfo a, PokeChain a,
Extendss MemoryRequirements2 b, PokeChain b, PeekChain b,
MonadIO io) =>
Device -> ComputePipelineCreateInfo a -> io (MemoryRequirements2 b)
getPipelineIndirectMemoryRequirementsNV Device
device
ComputePipelineCreateInfo a
createInfo = 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 vkGetPipelineIndirectMemoryRequirementsNVPtr :: FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
-> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2))
-> IO ())
vkGetPipelineIndirectMemoryRequirementsNVPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
-> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2))
-> IO ())
pVkGetPipelineIndirectMemoryRequirementsNV (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
-> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2))
-> IO ())
vkGetPipelineIndirectMemoryRequirementsNVPtr 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 vkGetPipelineIndirectMemoryRequirementsNV is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkGetPipelineIndirectMemoryRequirementsNV' :: Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
-> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2))
-> IO ()
vkGetPipelineIndirectMemoryRequirementsNV' = FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
-> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2))
-> IO ())
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
-> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2))
-> IO ()
mkVkGetPipelineIndirectMemoryRequirementsNV FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
-> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2))
-> IO ())
vkGetPipelineIndirectMemoryRequirementsNVPtr
Ptr (ComputePipelineCreateInfo a)
pCreateInfo <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (ComputePipelineCreateInfo a
createInfo)
Ptr (MemoryRequirements2 b)
pPMemoryRequirements <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @(MemoryRequirements2 _))
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
"vkGetPipelineIndirectMemoryRequirementsNV" (Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
-> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2))
-> IO ()
vkGetPipelineIndirectMemoryRequirementsNV'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (ComputePipelineCreateInfo a)
pCreateInfo)
(forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (MemoryRequirements2 b)
pPMemoryRequirements)))
MemoryRequirements2 b
pMemoryRequirements <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @(MemoryRequirements2 _) Ptr (MemoryRequirements2 b)
pPMemoryRequirements
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (MemoryRequirements2 b
pMemoryRequirements)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkGetPipelineIndirectDeviceAddressNV
:: FunPtr (Ptr Device_T -> Ptr PipelineIndirectDeviceAddressInfoNV -> IO DeviceAddress) -> Ptr Device_T -> Ptr PipelineIndirectDeviceAddressInfoNV -> IO DeviceAddress
getPipelineIndirectDeviceAddressNV :: forall io
. (MonadIO io)
=>
Device
->
PipelineIndirectDeviceAddressInfoNV
-> io (DeviceAddress)
getPipelineIndirectDeviceAddressNV :: forall (io :: * -> *).
MonadIO io =>
Device -> PipelineIndirectDeviceAddressInfoNV -> io DeviceAddress
getPipelineIndirectDeviceAddressNV Device
device PipelineIndirectDeviceAddressInfoNV
info = 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 vkGetPipelineIndirectDeviceAddressNVPtr :: FunPtr
(Ptr Device_T
-> ("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV)
-> IO DeviceAddress)
vkGetPipelineIndirectDeviceAddressNVPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> ("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV)
-> IO DeviceAddress)
pVkGetPipelineIndirectDeviceAddressNV (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
-> ("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV)
-> IO DeviceAddress)
vkGetPipelineIndirectDeviceAddressNVPtr 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 vkGetPipelineIndirectDeviceAddressNV is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkGetPipelineIndirectDeviceAddressNV' :: Ptr Device_T
-> ("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV)
-> IO DeviceAddress
vkGetPipelineIndirectDeviceAddressNV' = FunPtr
(Ptr Device_T
-> ("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV)
-> IO DeviceAddress)
-> Ptr Device_T
-> ("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV)
-> IO DeviceAddress
mkVkGetPipelineIndirectDeviceAddressNV FunPtr
(Ptr Device_T
-> ("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV)
-> IO DeviceAddress)
vkGetPipelineIndirectDeviceAddressNVPtr
"pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
pInfo <- 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 (PipelineIndirectDeviceAddressInfoNV
info)
DeviceAddress
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
"vkGetPipelineIndirectDeviceAddressNV" (Ptr Device_T
-> ("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV)
-> IO DeviceAddress
vkGetPipelineIndirectDeviceAddressNV'
(Device -> Ptr Device_T
deviceHandle (Device
device))
"pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
pInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (DeviceAddress
r)
data ComputePipelineIndirectBufferInfoNV = ComputePipelineIndirectBufferInfoNV
{
ComputePipelineIndirectBufferInfoNV -> DeviceAddress
deviceAddress :: DeviceAddress
,
ComputePipelineIndirectBufferInfoNV -> DeviceAddress
size :: DeviceSize
,
ComputePipelineIndirectBufferInfoNV -> DeviceAddress
pipelineDeviceAddressCaptureReplay :: DeviceAddress
}
deriving (Typeable, ComputePipelineIndirectBufferInfoNV
-> ComputePipelineIndirectBufferInfoNV -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComputePipelineIndirectBufferInfoNV
-> ComputePipelineIndirectBufferInfoNV -> Bool
$c/= :: ComputePipelineIndirectBufferInfoNV
-> ComputePipelineIndirectBufferInfoNV -> Bool
== :: ComputePipelineIndirectBufferInfoNV
-> ComputePipelineIndirectBufferInfoNV -> Bool
$c== :: ComputePipelineIndirectBufferInfoNV
-> ComputePipelineIndirectBufferInfoNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ComputePipelineIndirectBufferInfoNV)
#endif
deriving instance Show ComputePipelineIndirectBufferInfoNV
instance ToCStruct ComputePipelineIndirectBufferInfoNV where
withCStruct :: forall b.
ComputePipelineIndirectBufferInfoNV
-> (Ptr ComputePipelineIndirectBufferInfoNV -> IO b) -> IO b
withCStruct ComputePipelineIndirectBufferInfoNV
x Ptr ComputePipelineIndirectBufferInfoNV -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
40 forall a b. (a -> b) -> a -> b
$ \Ptr ComputePipelineIndirectBufferInfoNV
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ComputePipelineIndirectBufferInfoNV
p ComputePipelineIndirectBufferInfoNV
x (Ptr ComputePipelineIndirectBufferInfoNV -> IO b
f Ptr ComputePipelineIndirectBufferInfoNV
p)
pokeCStruct :: forall b.
Ptr ComputePipelineIndirectBufferInfoNV
-> ComputePipelineIndirectBufferInfoNV -> IO b -> IO b
pokeCStruct Ptr ComputePipelineIndirectBufferInfoNV
p ComputePipelineIndirectBufferInfoNV{DeviceAddress
pipelineDeviceAddressCaptureReplay :: DeviceAddress
size :: DeviceAddress
deviceAddress :: DeviceAddress
$sel:pipelineDeviceAddressCaptureReplay:ComputePipelineIndirectBufferInfoNV :: ComputePipelineIndirectBufferInfoNV -> DeviceAddress
$sel:size:ComputePipelineIndirectBufferInfoNV :: ComputePipelineIndirectBufferInfoNV -> DeviceAddress
$sel:deviceAddress:ComputePipelineIndirectBufferInfoNV :: ComputePipelineIndirectBufferInfoNV -> DeviceAddress
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ComputePipelineIndirectBufferInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COMPUTE_PIPELINE_INDIRECT_BUFFER_INFO_NV)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ComputePipelineIndirectBufferInfoNV
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 ComputePipelineIndirectBufferInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceAddress)) (DeviceAddress
deviceAddress)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ComputePipelineIndirectBufferInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DeviceSize)) (DeviceAddress
size)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ComputePipelineIndirectBufferInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr DeviceAddress)) (DeviceAddress
pipelineDeviceAddressCaptureReplay)
IO b
f
cStructSize :: Int
cStructSize = Int
40
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b. Ptr ComputePipelineIndirectBufferInfoNV -> IO b -> IO b
pokeZeroCStruct Ptr ComputePipelineIndirectBufferInfoNV
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ComputePipelineIndirectBufferInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COMPUTE_PIPELINE_INDIRECT_BUFFER_INFO_NV)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ComputePipelineIndirectBufferInfoNV
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 ComputePipelineIndirectBufferInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceAddress)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ComputePipelineIndirectBufferInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ComputePipelineIndirectBufferInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr DeviceAddress)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct ComputePipelineIndirectBufferInfoNV where
peekCStruct :: Ptr ComputePipelineIndirectBufferInfoNV
-> IO ComputePipelineIndirectBufferInfoNV
peekCStruct Ptr ComputePipelineIndirectBufferInfoNV
p = do
DeviceAddress
deviceAddress <- forall a. Storable a => Ptr a -> IO a
peek @DeviceAddress ((Ptr ComputePipelineIndirectBufferInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceAddress))
DeviceAddress
size <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr ComputePipelineIndirectBufferInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DeviceSize))
DeviceAddress
pipelineDeviceAddressCaptureReplay <- forall a. Storable a => Ptr a -> IO a
peek @DeviceAddress ((Ptr ComputePipelineIndirectBufferInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr DeviceAddress))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DeviceAddress
-> DeviceAddress
-> DeviceAddress
-> ComputePipelineIndirectBufferInfoNV
ComputePipelineIndirectBufferInfoNV
DeviceAddress
deviceAddress DeviceAddress
size DeviceAddress
pipelineDeviceAddressCaptureReplay
instance Storable ComputePipelineIndirectBufferInfoNV where
sizeOf :: ComputePipelineIndirectBufferInfoNV -> Int
sizeOf ~ComputePipelineIndirectBufferInfoNV
_ = Int
40
alignment :: ComputePipelineIndirectBufferInfoNV -> Int
alignment ~ComputePipelineIndirectBufferInfoNV
_ = Int
8
peek :: Ptr ComputePipelineIndirectBufferInfoNV
-> IO ComputePipelineIndirectBufferInfoNV
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr ComputePipelineIndirectBufferInfoNV
-> ComputePipelineIndirectBufferInfoNV -> IO ()
poke Ptr ComputePipelineIndirectBufferInfoNV
ptr ComputePipelineIndirectBufferInfoNV
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ComputePipelineIndirectBufferInfoNV
ptr ComputePipelineIndirectBufferInfoNV
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero ComputePipelineIndirectBufferInfoNV where
zero :: ComputePipelineIndirectBufferInfoNV
zero = DeviceAddress
-> DeviceAddress
-> DeviceAddress
-> ComputePipelineIndirectBufferInfoNV
ComputePipelineIndirectBufferInfoNV
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV = PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
{
PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV -> Bool
deviceGeneratedCompute :: Bool
,
PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV -> Bool
deviceGeneratedComputePipelines :: Bool
,
PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV -> Bool
deviceGeneratedComputeCaptureReplay :: Bool
}
deriving (Typeable, PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
-> PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
-> PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV -> Bool
$c/= :: PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
-> PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV -> Bool
== :: PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
-> PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV -> Bool
$c== :: PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
-> PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV)
#endif
deriving instance Show PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
instance ToCStruct PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV where
withCStruct :: forall b.
PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
-> (Ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
-> IO b)
-> IO b
withCStruct PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
x Ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
p PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
x (Ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV -> IO b
f Ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
p)
pokeCStruct :: forall b.
Ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
-> PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
-> IO b
-> IO b
pokeCStruct Ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
p PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV{Bool
deviceGeneratedComputeCaptureReplay :: Bool
deviceGeneratedComputePipelines :: Bool
deviceGeneratedCompute :: Bool
$sel:deviceGeneratedComputeCaptureReplay:PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV :: PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV -> Bool
$sel:deviceGeneratedComputePipelines:PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV :: PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV -> Bool
$sel:deviceGeneratedCompute:PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV :: PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV -> Bool
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_DEVICE_GENERATED_COMMANDS_COMPUTE_FEATURES_NV)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
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 PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
deviceGeneratedCompute))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
deviceGeneratedComputePipelines))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
deviceGeneratedComputeCaptureReplay))
IO b
f
cStructSize :: Int
cStructSize = Int
32
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
-> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_DEVICE_GENERATED_COMMANDS_COMPUTE_FEATURES_NV)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
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 PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
IO b
f
instance FromCStruct PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV where
peekCStruct :: Ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
-> IO PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
peekCStruct Ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
p = do
Bool32
deviceGeneratedCompute <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
Bool32
deviceGeneratedComputePipelines <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32))
Bool32
deviceGeneratedComputeCaptureReplay <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Bool32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool
-> Bool
-> Bool
-> PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
(Bool32 -> Bool
bool32ToBool Bool32
deviceGeneratedCompute)
(Bool32 -> Bool
bool32ToBool Bool32
deviceGeneratedComputePipelines)
(Bool32 -> Bool
bool32ToBool Bool32
deviceGeneratedComputeCaptureReplay)
instance Storable PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV where
sizeOf :: PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV -> Int
sizeOf ~PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
_ = Int
32
alignment :: PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV -> Int
alignment ~PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
_ = Int
8
peek :: Ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
-> IO PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
-> PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV -> IO ()
poke Ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
ptr PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV where
zero :: PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
zero = Bool
-> Bool
-> Bool
-> PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data PipelineIndirectDeviceAddressInfoNV = PipelineIndirectDeviceAddressInfoNV
{
PipelineIndirectDeviceAddressInfoNV -> PipelineBindPoint
pipelineBindPoint :: PipelineBindPoint
,
PipelineIndirectDeviceAddressInfoNV -> Pipeline
pipeline :: Pipeline
}
deriving (Typeable, PipelineIndirectDeviceAddressInfoNV
-> PipelineIndirectDeviceAddressInfoNV -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PipelineIndirectDeviceAddressInfoNV
-> PipelineIndirectDeviceAddressInfoNV -> Bool
$c/= :: PipelineIndirectDeviceAddressInfoNV
-> PipelineIndirectDeviceAddressInfoNV -> Bool
== :: PipelineIndirectDeviceAddressInfoNV
-> PipelineIndirectDeviceAddressInfoNV -> Bool
$c== :: PipelineIndirectDeviceAddressInfoNV
-> PipelineIndirectDeviceAddressInfoNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PipelineIndirectDeviceAddressInfoNV)
#endif
deriving instance Show PipelineIndirectDeviceAddressInfoNV
instance ToCStruct PipelineIndirectDeviceAddressInfoNV where
withCStruct :: forall b.
PipelineIndirectDeviceAddressInfoNV
-> (("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV) -> IO b)
-> IO b
withCStruct PipelineIndirectDeviceAddressInfoNV
x ("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \"pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p PipelineIndirectDeviceAddressInfoNV
x (("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV) -> IO b
f "pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p)
pokeCStruct :: forall b.
("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV)
-> PipelineIndirectDeviceAddressInfoNV -> IO b -> IO b
pokeCStruct "pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p PipelineIndirectDeviceAddressInfoNV{PipelineBindPoint
Pipeline
pipeline :: Pipeline
pipelineBindPoint :: PipelineBindPoint
$sel:pipeline:PipelineIndirectDeviceAddressInfoNV :: PipelineIndirectDeviceAddressInfoNV -> Pipeline
$sel:pipelineBindPoint:PipelineIndirectDeviceAddressInfoNV :: PipelineIndirectDeviceAddressInfoNV -> PipelineBindPoint
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_INDIRECT_DEVICE_ADDRESS_INFO_NV)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
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 (("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PipelineBindPoint)) (PipelineBindPoint
pipelineBindPoint)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Pipeline)) (Pipeline
pipeline)
IO b
f
cStructSize :: Int
cStructSize = Int
32
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV)
-> IO b -> IO b
pokeZeroCStruct "pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_INDIRECT_DEVICE_ADDRESS_INFO_NV)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
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 (("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PipelineBindPoint)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Pipeline)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct PipelineIndirectDeviceAddressInfoNV where
peekCStruct :: ("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV)
-> IO PipelineIndirectDeviceAddressInfoNV
peekCStruct "pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p = do
PipelineBindPoint
pipelineBindPoint <- forall a. Storable a => Ptr a -> IO a
peek @PipelineBindPoint (("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PipelineBindPoint))
Pipeline
pipeline <- forall a. Storable a => Ptr a -> IO a
peek @Pipeline (("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Pipeline))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PipelineBindPoint
-> Pipeline -> PipelineIndirectDeviceAddressInfoNV
PipelineIndirectDeviceAddressInfoNV
PipelineBindPoint
pipelineBindPoint Pipeline
pipeline
instance Storable PipelineIndirectDeviceAddressInfoNV where
sizeOf :: PipelineIndirectDeviceAddressInfoNV -> Int
sizeOf ~PipelineIndirectDeviceAddressInfoNV
_ = Int
32
alignment :: PipelineIndirectDeviceAddressInfoNV -> Int
alignment ~PipelineIndirectDeviceAddressInfoNV
_ = Int
8
peek :: ("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV)
-> IO PipelineIndirectDeviceAddressInfoNV
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: ("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV)
-> PipelineIndirectDeviceAddressInfoNV -> IO ()
poke "pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
ptr PipelineIndirectDeviceAddressInfoNV
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
ptr PipelineIndirectDeviceAddressInfoNV
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PipelineIndirectDeviceAddressInfoNV where
zero :: PipelineIndirectDeviceAddressInfoNV
zero = PipelineBindPoint
-> Pipeline -> PipelineIndirectDeviceAddressInfoNV
PipelineIndirectDeviceAddressInfoNV
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data BindPipelineIndirectCommandNV = BindPipelineIndirectCommandNV
{
BindPipelineIndirectCommandNV -> DeviceAddress
pipelineAddress :: DeviceAddress }
deriving (Typeable, BindPipelineIndirectCommandNV
-> BindPipelineIndirectCommandNV -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BindPipelineIndirectCommandNV
-> BindPipelineIndirectCommandNV -> Bool
$c/= :: BindPipelineIndirectCommandNV
-> BindPipelineIndirectCommandNV -> Bool
== :: BindPipelineIndirectCommandNV
-> BindPipelineIndirectCommandNV -> Bool
$c== :: BindPipelineIndirectCommandNV
-> BindPipelineIndirectCommandNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (BindPipelineIndirectCommandNV)
#endif
deriving instance Show BindPipelineIndirectCommandNV
instance ToCStruct BindPipelineIndirectCommandNV where
withCStruct :: forall b.
BindPipelineIndirectCommandNV
-> (Ptr BindPipelineIndirectCommandNV -> IO b) -> IO b
withCStruct BindPipelineIndirectCommandNV
x Ptr BindPipelineIndirectCommandNV -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
8 forall a b. (a -> b) -> a -> b
$ \Ptr BindPipelineIndirectCommandNV
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr BindPipelineIndirectCommandNV
p BindPipelineIndirectCommandNV
x (Ptr BindPipelineIndirectCommandNV -> IO b
f Ptr BindPipelineIndirectCommandNV
p)
pokeCStruct :: forall b.
Ptr BindPipelineIndirectCommandNV
-> BindPipelineIndirectCommandNV -> IO b -> IO b
pokeCStruct Ptr BindPipelineIndirectCommandNV
p BindPipelineIndirectCommandNV{DeviceAddress
pipelineAddress :: DeviceAddress
$sel:pipelineAddress:BindPipelineIndirectCommandNV :: BindPipelineIndirectCommandNV -> DeviceAddress
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindPipelineIndirectCommandNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DeviceAddress)) (DeviceAddress
pipelineAddress)
IO b
f
cStructSize :: Int
cStructSize = Int
8
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b. Ptr BindPipelineIndirectCommandNV -> IO b -> IO b
pokeZeroCStruct Ptr BindPipelineIndirectCommandNV
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindPipelineIndirectCommandNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DeviceAddress)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct BindPipelineIndirectCommandNV where
peekCStruct :: Ptr BindPipelineIndirectCommandNV
-> IO BindPipelineIndirectCommandNV
peekCStruct Ptr BindPipelineIndirectCommandNV
p = do
DeviceAddress
pipelineAddress <- forall a. Storable a => Ptr a -> IO a
peek @DeviceAddress ((Ptr BindPipelineIndirectCommandNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DeviceAddress))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DeviceAddress -> BindPipelineIndirectCommandNV
BindPipelineIndirectCommandNV
DeviceAddress
pipelineAddress
instance Storable BindPipelineIndirectCommandNV where
sizeOf :: BindPipelineIndirectCommandNV -> Int
sizeOf ~BindPipelineIndirectCommandNV
_ = Int
8
alignment :: BindPipelineIndirectCommandNV -> Int
alignment ~BindPipelineIndirectCommandNV
_ = Int
8
peek :: Ptr BindPipelineIndirectCommandNV
-> IO BindPipelineIndirectCommandNV
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr BindPipelineIndirectCommandNV
-> BindPipelineIndirectCommandNV -> IO ()
poke Ptr BindPipelineIndirectCommandNV
ptr BindPipelineIndirectCommandNV
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr BindPipelineIndirectCommandNV
ptr BindPipelineIndirectCommandNV
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero BindPipelineIndirectCommandNV where
zero :: BindPipelineIndirectCommandNV
zero = DeviceAddress -> BindPipelineIndirectCommandNV
BindPipelineIndirectCommandNV
forall a. Zero a => a
zero
type NV_DEVICE_GENERATED_COMMANDS_COMPUTE_SPEC_VERSION = 2
pattern NV_DEVICE_GENERATED_COMMANDS_COMPUTE_SPEC_VERSION :: forall a . Integral a => a
pattern $bNV_DEVICE_GENERATED_COMMANDS_COMPUTE_SPEC_VERSION :: forall a. Integral a => a
$mNV_DEVICE_GENERATED_COMMANDS_COMPUTE_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
NV_DEVICE_GENERATED_COMMANDS_COMPUTE_SPEC_VERSION = 2
type NV_DEVICE_GENERATED_COMMANDS_COMPUTE_EXTENSION_NAME = "VK_NV_device_generated_commands_compute"
pattern NV_DEVICE_GENERATED_COMMANDS_COMPUTE_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bNV_DEVICE_GENERATED_COMMANDS_COMPUTE_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mNV_DEVICE_GENERATED_COMMANDS_COMPUTE_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
NV_DEVICE_GENERATED_COMMANDS_COMPUTE_EXTENSION_NAME = "VK_NV_device_generated_commands_compute"