{-# language CPP #-}
module Vulkan.Extensions.VK_EXT_nested_command_buffer ( PhysicalDeviceNestedCommandBufferFeaturesEXT(..)
, PhysicalDeviceNestedCommandBufferPropertiesEXT(..)
, EXT_NESTED_COMMAND_BUFFER_SPEC_VERSION
, pattern EXT_NESTED_COMMAND_BUFFER_SPEC_VERSION
, EXT_NESTED_COMMAND_BUFFER_EXTENSION_NAME
, pattern EXT_NESTED_COMMAND_BUFFER_EXTENSION_NAME
) where
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
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 Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Kind (Type)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_NESTED_COMMAND_BUFFER_FEATURES_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_NESTED_COMMAND_BUFFER_PROPERTIES_EXT))
data PhysicalDeviceNestedCommandBufferFeaturesEXT = PhysicalDeviceNestedCommandBufferFeaturesEXT
{
PhysicalDeviceNestedCommandBufferFeaturesEXT -> Bool
nestedCommandBuffer :: Bool
,
PhysicalDeviceNestedCommandBufferFeaturesEXT -> Bool
nestedCommandBufferRendering :: Bool
,
PhysicalDeviceNestedCommandBufferFeaturesEXT -> Bool
nestedCommandBufferSimultaneousUse :: Bool
}
deriving (Typeable, PhysicalDeviceNestedCommandBufferFeaturesEXT
-> PhysicalDeviceNestedCommandBufferFeaturesEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceNestedCommandBufferFeaturesEXT
-> PhysicalDeviceNestedCommandBufferFeaturesEXT -> Bool
$c/= :: PhysicalDeviceNestedCommandBufferFeaturesEXT
-> PhysicalDeviceNestedCommandBufferFeaturesEXT -> Bool
== :: PhysicalDeviceNestedCommandBufferFeaturesEXT
-> PhysicalDeviceNestedCommandBufferFeaturesEXT -> Bool
$c== :: PhysicalDeviceNestedCommandBufferFeaturesEXT
-> PhysicalDeviceNestedCommandBufferFeaturesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceNestedCommandBufferFeaturesEXT)
#endif
deriving instance Show PhysicalDeviceNestedCommandBufferFeaturesEXT
instance ToCStruct PhysicalDeviceNestedCommandBufferFeaturesEXT where
withCStruct :: forall b.
PhysicalDeviceNestedCommandBufferFeaturesEXT
-> (Ptr PhysicalDeviceNestedCommandBufferFeaturesEXT -> IO b)
-> IO b
withCStruct PhysicalDeviceNestedCommandBufferFeaturesEXT
x Ptr PhysicalDeviceNestedCommandBufferFeaturesEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceNestedCommandBufferFeaturesEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceNestedCommandBufferFeaturesEXT
p PhysicalDeviceNestedCommandBufferFeaturesEXT
x (Ptr PhysicalDeviceNestedCommandBufferFeaturesEXT -> IO b
f Ptr PhysicalDeviceNestedCommandBufferFeaturesEXT
p)
pokeCStruct :: forall b.
Ptr PhysicalDeviceNestedCommandBufferFeaturesEXT
-> PhysicalDeviceNestedCommandBufferFeaturesEXT -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceNestedCommandBufferFeaturesEXT
p PhysicalDeviceNestedCommandBufferFeaturesEXT{Bool
nestedCommandBufferSimultaneousUse :: Bool
nestedCommandBufferRendering :: Bool
nestedCommandBuffer :: Bool
$sel:nestedCommandBufferSimultaneousUse:PhysicalDeviceNestedCommandBufferFeaturesEXT :: PhysicalDeviceNestedCommandBufferFeaturesEXT -> Bool
$sel:nestedCommandBufferRendering:PhysicalDeviceNestedCommandBufferFeaturesEXT :: PhysicalDeviceNestedCommandBufferFeaturesEXT -> Bool
$sel:nestedCommandBuffer:PhysicalDeviceNestedCommandBufferFeaturesEXT :: PhysicalDeviceNestedCommandBufferFeaturesEXT -> Bool
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceNestedCommandBufferFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_NESTED_COMMAND_BUFFER_FEATURES_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceNestedCommandBufferFeaturesEXT
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 PhysicalDeviceNestedCommandBufferFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
nestedCommandBuffer))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceNestedCommandBufferFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
nestedCommandBufferRendering))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceNestedCommandBufferFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
nestedCommandBufferSimultaneousUse))
IO b
f
cStructSize :: Int
cStructSize = Int
32
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceNestedCommandBufferFeaturesEXT -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceNestedCommandBufferFeaturesEXT
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceNestedCommandBufferFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_NESTED_COMMAND_BUFFER_FEATURES_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceNestedCommandBufferFeaturesEXT
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 PhysicalDeviceNestedCommandBufferFeaturesEXT
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 PhysicalDeviceNestedCommandBufferFeaturesEXT
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 PhysicalDeviceNestedCommandBufferFeaturesEXT
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 PhysicalDeviceNestedCommandBufferFeaturesEXT where
peekCStruct :: Ptr PhysicalDeviceNestedCommandBufferFeaturesEXT
-> IO PhysicalDeviceNestedCommandBufferFeaturesEXT
peekCStruct Ptr PhysicalDeviceNestedCommandBufferFeaturesEXT
p = do
Bool32
nestedCommandBuffer <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceNestedCommandBufferFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
Bool32
nestedCommandBufferRendering <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceNestedCommandBufferFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32))
Bool32
nestedCommandBufferSimultaneousUse <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceNestedCommandBufferFeaturesEXT
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 -> PhysicalDeviceNestedCommandBufferFeaturesEXT
PhysicalDeviceNestedCommandBufferFeaturesEXT
(Bool32 -> Bool
bool32ToBool Bool32
nestedCommandBuffer)
(Bool32 -> Bool
bool32ToBool Bool32
nestedCommandBufferRendering)
(Bool32 -> Bool
bool32ToBool Bool32
nestedCommandBufferSimultaneousUse)
instance Storable PhysicalDeviceNestedCommandBufferFeaturesEXT where
sizeOf :: PhysicalDeviceNestedCommandBufferFeaturesEXT -> Int
sizeOf ~PhysicalDeviceNestedCommandBufferFeaturesEXT
_ = Int
32
alignment :: PhysicalDeviceNestedCommandBufferFeaturesEXT -> Int
alignment ~PhysicalDeviceNestedCommandBufferFeaturesEXT
_ = Int
8
peek :: Ptr PhysicalDeviceNestedCommandBufferFeaturesEXT
-> IO PhysicalDeviceNestedCommandBufferFeaturesEXT
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr PhysicalDeviceNestedCommandBufferFeaturesEXT
-> PhysicalDeviceNestedCommandBufferFeaturesEXT -> IO ()
poke Ptr PhysicalDeviceNestedCommandBufferFeaturesEXT
ptr PhysicalDeviceNestedCommandBufferFeaturesEXT
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceNestedCommandBufferFeaturesEXT
ptr PhysicalDeviceNestedCommandBufferFeaturesEXT
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDeviceNestedCommandBufferFeaturesEXT where
zero :: PhysicalDeviceNestedCommandBufferFeaturesEXT
zero = Bool
-> Bool -> Bool -> PhysicalDeviceNestedCommandBufferFeaturesEXT
PhysicalDeviceNestedCommandBufferFeaturesEXT
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data PhysicalDeviceNestedCommandBufferPropertiesEXT = PhysicalDeviceNestedCommandBufferPropertiesEXT
{
PhysicalDeviceNestedCommandBufferPropertiesEXT -> Word32
maxCommandBufferNestingLevel :: Word32 }
deriving (Typeable, PhysicalDeviceNestedCommandBufferPropertiesEXT
-> PhysicalDeviceNestedCommandBufferPropertiesEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceNestedCommandBufferPropertiesEXT
-> PhysicalDeviceNestedCommandBufferPropertiesEXT -> Bool
$c/= :: PhysicalDeviceNestedCommandBufferPropertiesEXT
-> PhysicalDeviceNestedCommandBufferPropertiesEXT -> Bool
== :: PhysicalDeviceNestedCommandBufferPropertiesEXT
-> PhysicalDeviceNestedCommandBufferPropertiesEXT -> Bool
$c== :: PhysicalDeviceNestedCommandBufferPropertiesEXT
-> PhysicalDeviceNestedCommandBufferPropertiesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceNestedCommandBufferPropertiesEXT)
#endif
deriving instance Show PhysicalDeviceNestedCommandBufferPropertiesEXT
instance ToCStruct PhysicalDeviceNestedCommandBufferPropertiesEXT where
withCStruct :: forall b.
PhysicalDeviceNestedCommandBufferPropertiesEXT
-> (Ptr PhysicalDeviceNestedCommandBufferPropertiesEXT -> IO b)
-> IO b
withCStruct PhysicalDeviceNestedCommandBufferPropertiesEXT
x Ptr PhysicalDeviceNestedCommandBufferPropertiesEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceNestedCommandBufferPropertiesEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceNestedCommandBufferPropertiesEXT
p PhysicalDeviceNestedCommandBufferPropertiesEXT
x (Ptr PhysicalDeviceNestedCommandBufferPropertiesEXT -> IO b
f Ptr PhysicalDeviceNestedCommandBufferPropertiesEXT
p)
pokeCStruct :: forall b.
Ptr PhysicalDeviceNestedCommandBufferPropertiesEXT
-> PhysicalDeviceNestedCommandBufferPropertiesEXT -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceNestedCommandBufferPropertiesEXT
p PhysicalDeviceNestedCommandBufferPropertiesEXT{Word32
maxCommandBufferNestingLevel :: Word32
$sel:maxCommandBufferNestingLevel:PhysicalDeviceNestedCommandBufferPropertiesEXT :: PhysicalDeviceNestedCommandBufferPropertiesEXT -> Word32
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceNestedCommandBufferPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_NESTED_COMMAND_BUFFER_PROPERTIES_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceNestedCommandBufferPropertiesEXT
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 PhysicalDeviceNestedCommandBufferPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
maxCommandBufferNestingLevel)
IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceNestedCommandBufferPropertiesEXT -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceNestedCommandBufferPropertiesEXT
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceNestedCommandBufferPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_NESTED_COMMAND_BUFFER_PROPERTIES_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceNestedCommandBufferPropertiesEXT
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 PhysicalDeviceNestedCommandBufferPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct PhysicalDeviceNestedCommandBufferPropertiesEXT where
peekCStruct :: Ptr PhysicalDeviceNestedCommandBufferPropertiesEXT
-> IO PhysicalDeviceNestedCommandBufferPropertiesEXT
peekCStruct Ptr PhysicalDeviceNestedCommandBufferPropertiesEXT
p = do
Word32
maxCommandBufferNestingLevel <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceNestedCommandBufferPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word32 -> PhysicalDeviceNestedCommandBufferPropertiesEXT
PhysicalDeviceNestedCommandBufferPropertiesEXT
Word32
maxCommandBufferNestingLevel
instance Storable PhysicalDeviceNestedCommandBufferPropertiesEXT where
sizeOf :: PhysicalDeviceNestedCommandBufferPropertiesEXT -> Int
sizeOf ~PhysicalDeviceNestedCommandBufferPropertiesEXT
_ = Int
24
alignment :: PhysicalDeviceNestedCommandBufferPropertiesEXT -> Int
alignment ~PhysicalDeviceNestedCommandBufferPropertiesEXT
_ = Int
8
peek :: Ptr PhysicalDeviceNestedCommandBufferPropertiesEXT
-> IO PhysicalDeviceNestedCommandBufferPropertiesEXT
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr PhysicalDeviceNestedCommandBufferPropertiesEXT
-> PhysicalDeviceNestedCommandBufferPropertiesEXT -> IO ()
poke Ptr PhysicalDeviceNestedCommandBufferPropertiesEXT
ptr PhysicalDeviceNestedCommandBufferPropertiesEXT
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceNestedCommandBufferPropertiesEXT
ptr PhysicalDeviceNestedCommandBufferPropertiesEXT
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDeviceNestedCommandBufferPropertiesEXT where
zero :: PhysicalDeviceNestedCommandBufferPropertiesEXT
zero = Word32 -> PhysicalDeviceNestedCommandBufferPropertiesEXT
PhysicalDeviceNestedCommandBufferPropertiesEXT
forall a. Zero a => a
zero
type EXT_NESTED_COMMAND_BUFFER_SPEC_VERSION = 1
pattern EXT_NESTED_COMMAND_BUFFER_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_NESTED_COMMAND_BUFFER_SPEC_VERSION :: forall a. Integral a => a
$mEXT_NESTED_COMMAND_BUFFER_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_NESTED_COMMAND_BUFFER_SPEC_VERSION = 1
type EXT_NESTED_COMMAND_BUFFER_EXTENSION_NAME = "VK_EXT_nested_command_buffer"
pattern EXT_NESTED_COMMAND_BUFFER_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_NESTED_COMMAND_BUFFER_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mEXT_NESTED_COMMAND_BUFFER_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_NESTED_COMMAND_BUFFER_EXTENSION_NAME = "VK_EXT_nested_command_buffer"