{-# language CPP #-}
-- No documentation found for Chapter "Promoted_From_VK_KHR_external_memory"
module Vulkan.Core11.Promoted_From_VK_KHR_external_memory  ( ExternalMemoryImageCreateInfo(..)
                                                           , ExternalMemoryBufferCreateInfo(..)
                                                           , ExportMemoryAllocateInfo(..)
                                                           , StructureType(..)
                                                           , Result(..)
                                                           , QUEUE_FAMILY_EXTERNAL
                                                           , pattern QUEUE_FAMILY_EXTERNAL
                                                           ) 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.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.Kind (Type)
import Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits (ExternalMemoryHandleTypeFlags)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_EXPORT_MEMORY_ALLOCATE_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_EXTERNAL_MEMORY_BUFFER_CREATE_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_EXTERNAL_MEMORY_IMAGE_CREATE_INFO))
import Vulkan.Core10.APIConstants (QUEUE_FAMILY_EXTERNAL)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.StructureType (StructureType(..))
import Vulkan.Core10.APIConstants (pattern QUEUE_FAMILY_EXTERNAL)
-- | VkExternalMemoryImageCreateInfo - Specify that an image may be backed by
-- external memory
--
-- = Members
--
-- Note
--
-- A 'ExternalMemoryImageCreateInfo' structure with a non-zero
-- @handleTypes@ field must be included in the creation parameters for an
-- image that will be bound to memory that is either exported or imported.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_1 VK_VERSION_1_1>,
-- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlags',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data ExternalMemoryImageCreateInfo = ExternalMemoryImageCreateInfo
  { -- | @handleTypes@ is zero, or a bitmask of
    -- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
    -- specifying one or more external memory handle types.
    --
    -- #VUID-VkExternalMemoryImageCreateInfo-handleTypes-parameter#
    -- @handleTypes@ /must/ be a valid combination of
    -- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
    -- values
    ExternalMemoryImageCreateInfo -> ExternalMemoryHandleTypeFlags
handleTypes :: ExternalMemoryHandleTypeFlags }
  deriving (Typeable, ExternalMemoryImageCreateInfo
-> ExternalMemoryImageCreateInfo -> Bool
(ExternalMemoryImageCreateInfo
 -> ExternalMemoryImageCreateInfo -> Bool)
-> (ExternalMemoryImageCreateInfo
    -> ExternalMemoryImageCreateInfo -> Bool)
-> Eq ExternalMemoryImageCreateInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExternalMemoryImageCreateInfo
-> ExternalMemoryImageCreateInfo -> Bool
$c/= :: ExternalMemoryImageCreateInfo
-> ExternalMemoryImageCreateInfo -> Bool
== :: ExternalMemoryImageCreateInfo
-> ExternalMemoryImageCreateInfo -> Bool
$c== :: ExternalMemoryImageCreateInfo
-> ExternalMemoryImageCreateInfo -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ExternalMemoryImageCreateInfo)
#endif
deriving instance Show ExternalMemoryImageCreateInfo

instance ToCStruct ExternalMemoryImageCreateInfo where
  withCStruct :: ExternalMemoryImageCreateInfo
-> (Ptr ExternalMemoryImageCreateInfo -> IO b) -> IO b
withCStruct ExternalMemoryImageCreateInfo
x Ptr ExternalMemoryImageCreateInfo -> IO b
f = Int -> (Ptr ExternalMemoryImageCreateInfo -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr ExternalMemoryImageCreateInfo -> IO b) -> IO b)
-> (Ptr ExternalMemoryImageCreateInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr ExternalMemoryImageCreateInfo
p -> Ptr ExternalMemoryImageCreateInfo
-> ExternalMemoryImageCreateInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ExternalMemoryImageCreateInfo
p ExternalMemoryImageCreateInfo
x (Ptr ExternalMemoryImageCreateInfo -> IO b
f Ptr ExternalMemoryImageCreateInfo
p)
  pokeCStruct :: Ptr ExternalMemoryImageCreateInfo
-> ExternalMemoryImageCreateInfo -> IO b -> IO b
pokeCStruct Ptr ExternalMemoryImageCreateInfo
p ExternalMemoryImageCreateInfo{ExternalMemoryHandleTypeFlags
handleTypes :: ExternalMemoryHandleTypeFlags
$sel:handleTypes:ExternalMemoryImageCreateInfo :: ExternalMemoryImageCreateInfo -> ExternalMemoryHandleTypeFlags
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExternalMemoryImageCreateInfo
p Ptr ExternalMemoryImageCreateInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_EXTERNAL_MEMORY_IMAGE_CREATE_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExternalMemoryImageCreateInfo
p Ptr ExternalMemoryImageCreateInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ExternalMemoryHandleTypeFlags
-> ExternalMemoryHandleTypeFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExternalMemoryImageCreateInfo
p Ptr ExternalMemoryImageCreateInfo
-> Int -> Ptr ExternalMemoryHandleTypeFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ExternalMemoryHandleTypeFlags)) (ExternalMemoryHandleTypeFlags
handleTypes)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr ExternalMemoryImageCreateInfo -> IO b -> IO b
pokeZeroCStruct Ptr ExternalMemoryImageCreateInfo
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExternalMemoryImageCreateInfo
p Ptr ExternalMemoryImageCreateInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_EXTERNAL_MEMORY_IMAGE_CREATE_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExternalMemoryImageCreateInfo
p Ptr ExternalMemoryImageCreateInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO b
f

instance FromCStruct ExternalMemoryImageCreateInfo where
  peekCStruct :: Ptr ExternalMemoryImageCreateInfo
-> IO ExternalMemoryImageCreateInfo
peekCStruct Ptr ExternalMemoryImageCreateInfo
p = do
    ExternalMemoryHandleTypeFlags
handleTypes <- Ptr ExternalMemoryHandleTypeFlags
-> IO ExternalMemoryHandleTypeFlags
forall a. Storable a => Ptr a -> IO a
peek @ExternalMemoryHandleTypeFlags ((Ptr ExternalMemoryImageCreateInfo
p Ptr ExternalMemoryImageCreateInfo
-> Int -> Ptr ExternalMemoryHandleTypeFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ExternalMemoryHandleTypeFlags))
    ExternalMemoryImageCreateInfo -> IO ExternalMemoryImageCreateInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExternalMemoryImageCreateInfo -> IO ExternalMemoryImageCreateInfo)
-> ExternalMemoryImageCreateInfo
-> IO ExternalMemoryImageCreateInfo
forall a b. (a -> b) -> a -> b
$ ExternalMemoryHandleTypeFlags -> ExternalMemoryImageCreateInfo
ExternalMemoryImageCreateInfo
             ExternalMemoryHandleTypeFlags
handleTypes

instance Storable ExternalMemoryImageCreateInfo where
  sizeOf :: ExternalMemoryImageCreateInfo -> Int
sizeOf ~ExternalMemoryImageCreateInfo
_ = Int
24
  alignment :: ExternalMemoryImageCreateInfo -> Int
alignment ~ExternalMemoryImageCreateInfo
_ = Int
8
  peek :: Ptr ExternalMemoryImageCreateInfo
-> IO ExternalMemoryImageCreateInfo
peek = Ptr ExternalMemoryImageCreateInfo
-> IO ExternalMemoryImageCreateInfo
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr ExternalMemoryImageCreateInfo
-> ExternalMemoryImageCreateInfo -> IO ()
poke Ptr ExternalMemoryImageCreateInfo
ptr ExternalMemoryImageCreateInfo
poked = Ptr ExternalMemoryImageCreateInfo
-> ExternalMemoryImageCreateInfo -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ExternalMemoryImageCreateInfo
ptr ExternalMemoryImageCreateInfo
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero ExternalMemoryImageCreateInfo where
  zero :: ExternalMemoryImageCreateInfo
zero = ExternalMemoryHandleTypeFlags -> ExternalMemoryImageCreateInfo
ExternalMemoryImageCreateInfo
           ExternalMemoryHandleTypeFlags
forall a. Zero a => a
zero


-- | VkExternalMemoryBufferCreateInfo - Specify that a buffer may be backed
-- by external memory
--
-- = Members
--
-- Note
--
-- A 'ExternalMemoryBufferCreateInfo' structure with a non-zero
-- @handleTypes@ field must be included in the creation parameters for a
-- buffer that will be bound to memory that is either exported or imported.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_1 VK_VERSION_1_1>,
-- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlags',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data ExternalMemoryBufferCreateInfo = ExternalMemoryBufferCreateInfo
  { -- | @handleTypes@ is zero, or a bitmask of
    -- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
    -- specifying one or more external memory handle types.
    --
    -- #VUID-VkExternalMemoryBufferCreateInfo-handleTypes-parameter#
    -- @handleTypes@ /must/ be a valid combination of
    -- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
    -- values
    ExternalMemoryBufferCreateInfo -> ExternalMemoryHandleTypeFlags
handleTypes :: ExternalMemoryHandleTypeFlags }
  deriving (Typeable, ExternalMemoryBufferCreateInfo
-> ExternalMemoryBufferCreateInfo -> Bool
(ExternalMemoryBufferCreateInfo
 -> ExternalMemoryBufferCreateInfo -> Bool)
-> (ExternalMemoryBufferCreateInfo
    -> ExternalMemoryBufferCreateInfo -> Bool)
-> Eq ExternalMemoryBufferCreateInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExternalMemoryBufferCreateInfo
-> ExternalMemoryBufferCreateInfo -> Bool
$c/= :: ExternalMemoryBufferCreateInfo
-> ExternalMemoryBufferCreateInfo -> Bool
== :: ExternalMemoryBufferCreateInfo
-> ExternalMemoryBufferCreateInfo -> Bool
$c== :: ExternalMemoryBufferCreateInfo
-> ExternalMemoryBufferCreateInfo -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ExternalMemoryBufferCreateInfo)
#endif
deriving instance Show ExternalMemoryBufferCreateInfo

instance ToCStruct ExternalMemoryBufferCreateInfo where
  withCStruct :: ExternalMemoryBufferCreateInfo
-> (Ptr ExternalMemoryBufferCreateInfo -> IO b) -> IO b
withCStruct ExternalMemoryBufferCreateInfo
x Ptr ExternalMemoryBufferCreateInfo -> IO b
f = Int -> (Ptr ExternalMemoryBufferCreateInfo -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr ExternalMemoryBufferCreateInfo -> IO b) -> IO b)
-> (Ptr ExternalMemoryBufferCreateInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr ExternalMemoryBufferCreateInfo
p -> Ptr ExternalMemoryBufferCreateInfo
-> ExternalMemoryBufferCreateInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ExternalMemoryBufferCreateInfo
p ExternalMemoryBufferCreateInfo
x (Ptr ExternalMemoryBufferCreateInfo -> IO b
f Ptr ExternalMemoryBufferCreateInfo
p)
  pokeCStruct :: Ptr ExternalMemoryBufferCreateInfo
-> ExternalMemoryBufferCreateInfo -> IO b -> IO b
pokeCStruct Ptr ExternalMemoryBufferCreateInfo
p ExternalMemoryBufferCreateInfo{ExternalMemoryHandleTypeFlags
handleTypes :: ExternalMemoryHandleTypeFlags
$sel:handleTypes:ExternalMemoryBufferCreateInfo :: ExternalMemoryBufferCreateInfo -> ExternalMemoryHandleTypeFlags
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExternalMemoryBufferCreateInfo
p Ptr ExternalMemoryBufferCreateInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_EXTERNAL_MEMORY_BUFFER_CREATE_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExternalMemoryBufferCreateInfo
p Ptr ExternalMemoryBufferCreateInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ExternalMemoryHandleTypeFlags
-> ExternalMemoryHandleTypeFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExternalMemoryBufferCreateInfo
p Ptr ExternalMemoryBufferCreateInfo
-> Int -> Ptr ExternalMemoryHandleTypeFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ExternalMemoryHandleTypeFlags)) (ExternalMemoryHandleTypeFlags
handleTypes)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr ExternalMemoryBufferCreateInfo -> IO b -> IO b
pokeZeroCStruct Ptr ExternalMemoryBufferCreateInfo
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExternalMemoryBufferCreateInfo
p Ptr ExternalMemoryBufferCreateInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_EXTERNAL_MEMORY_BUFFER_CREATE_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExternalMemoryBufferCreateInfo
p Ptr ExternalMemoryBufferCreateInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO b
f

instance FromCStruct ExternalMemoryBufferCreateInfo where
  peekCStruct :: Ptr ExternalMemoryBufferCreateInfo
-> IO ExternalMemoryBufferCreateInfo
peekCStruct Ptr ExternalMemoryBufferCreateInfo
p = do
    ExternalMemoryHandleTypeFlags
handleTypes <- Ptr ExternalMemoryHandleTypeFlags
-> IO ExternalMemoryHandleTypeFlags
forall a. Storable a => Ptr a -> IO a
peek @ExternalMemoryHandleTypeFlags ((Ptr ExternalMemoryBufferCreateInfo
p Ptr ExternalMemoryBufferCreateInfo
-> Int -> Ptr ExternalMemoryHandleTypeFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ExternalMemoryHandleTypeFlags))
    ExternalMemoryBufferCreateInfo -> IO ExternalMemoryBufferCreateInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExternalMemoryBufferCreateInfo
 -> IO ExternalMemoryBufferCreateInfo)
-> ExternalMemoryBufferCreateInfo
-> IO ExternalMemoryBufferCreateInfo
forall a b. (a -> b) -> a -> b
$ ExternalMemoryHandleTypeFlags -> ExternalMemoryBufferCreateInfo
ExternalMemoryBufferCreateInfo
             ExternalMemoryHandleTypeFlags
handleTypes

instance Storable ExternalMemoryBufferCreateInfo where
  sizeOf :: ExternalMemoryBufferCreateInfo -> Int
sizeOf ~ExternalMemoryBufferCreateInfo
_ = Int
24
  alignment :: ExternalMemoryBufferCreateInfo -> Int
alignment ~ExternalMemoryBufferCreateInfo
_ = Int
8
  peek :: Ptr ExternalMemoryBufferCreateInfo
-> IO ExternalMemoryBufferCreateInfo
peek = Ptr ExternalMemoryBufferCreateInfo
-> IO ExternalMemoryBufferCreateInfo
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr ExternalMemoryBufferCreateInfo
-> ExternalMemoryBufferCreateInfo -> IO ()
poke Ptr ExternalMemoryBufferCreateInfo
ptr ExternalMemoryBufferCreateInfo
poked = Ptr ExternalMemoryBufferCreateInfo
-> ExternalMemoryBufferCreateInfo -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ExternalMemoryBufferCreateInfo
ptr ExternalMemoryBufferCreateInfo
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero ExternalMemoryBufferCreateInfo where
  zero :: ExternalMemoryBufferCreateInfo
zero = ExternalMemoryHandleTypeFlags -> ExternalMemoryBufferCreateInfo
ExternalMemoryBufferCreateInfo
           ExternalMemoryHandleTypeFlags
forall a. Zero a => a
zero


-- | VkExportMemoryAllocateInfo - Specify exportable handle types for a
-- device memory object
--
-- == Valid Usage
--
-- -   #VUID-VkExportMemoryAllocateInfo-handleTypes-00656# The bits in
--     @handleTypes@ /must/ be supported and compatible, as reported by
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory_capabilities.ExternalImageFormatProperties'
--     or
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory_capabilities.ExternalBufferProperties'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkExportMemoryAllocateInfo-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_EXPORT_MEMORY_ALLOCATE_INFO'
--
-- -   #VUID-VkExportMemoryAllocateInfo-handleTypes-parameter#
--     @handleTypes@ /must/ be a valid combination of
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
--     values
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_1 VK_VERSION_1_1>,
-- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlags',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data ExportMemoryAllocateInfo = ExportMemoryAllocateInfo
  { -- | @handleTypes@ is a bitmask of
    -- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
    -- specifying one or more memory handle types the application /can/ export
    -- from the resulting allocation. The application /can/ request multiple
    -- handle types for the same allocation.
    ExportMemoryAllocateInfo -> ExternalMemoryHandleTypeFlags
handleTypes :: ExternalMemoryHandleTypeFlags }
  deriving (Typeable, ExportMemoryAllocateInfo -> ExportMemoryAllocateInfo -> Bool
(ExportMemoryAllocateInfo -> ExportMemoryAllocateInfo -> Bool)
-> (ExportMemoryAllocateInfo -> ExportMemoryAllocateInfo -> Bool)
-> Eq ExportMemoryAllocateInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportMemoryAllocateInfo -> ExportMemoryAllocateInfo -> Bool
$c/= :: ExportMemoryAllocateInfo -> ExportMemoryAllocateInfo -> Bool
== :: ExportMemoryAllocateInfo -> ExportMemoryAllocateInfo -> Bool
$c== :: ExportMemoryAllocateInfo -> ExportMemoryAllocateInfo -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ExportMemoryAllocateInfo)
#endif
deriving instance Show ExportMemoryAllocateInfo

instance ToCStruct ExportMemoryAllocateInfo where
  withCStruct :: ExportMemoryAllocateInfo
-> (Ptr ExportMemoryAllocateInfo -> IO b) -> IO b
withCStruct ExportMemoryAllocateInfo
x Ptr ExportMemoryAllocateInfo -> IO b
f = Int -> (Ptr ExportMemoryAllocateInfo -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr ExportMemoryAllocateInfo -> IO b) -> IO b)
-> (Ptr ExportMemoryAllocateInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr ExportMemoryAllocateInfo
p -> Ptr ExportMemoryAllocateInfo
-> ExportMemoryAllocateInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ExportMemoryAllocateInfo
p ExportMemoryAllocateInfo
x (Ptr ExportMemoryAllocateInfo -> IO b
f Ptr ExportMemoryAllocateInfo
p)
  pokeCStruct :: Ptr ExportMemoryAllocateInfo
-> ExportMemoryAllocateInfo -> IO b -> IO b
pokeCStruct Ptr ExportMemoryAllocateInfo
p ExportMemoryAllocateInfo{ExternalMemoryHandleTypeFlags
handleTypes :: ExternalMemoryHandleTypeFlags
$sel:handleTypes:ExportMemoryAllocateInfo :: ExportMemoryAllocateInfo -> ExternalMemoryHandleTypeFlags
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExportMemoryAllocateInfo
p Ptr ExportMemoryAllocateInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_EXPORT_MEMORY_ALLOCATE_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExportMemoryAllocateInfo
p Ptr ExportMemoryAllocateInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ExternalMemoryHandleTypeFlags
-> ExternalMemoryHandleTypeFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExportMemoryAllocateInfo
p Ptr ExportMemoryAllocateInfo
-> Int -> Ptr ExternalMemoryHandleTypeFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ExternalMemoryHandleTypeFlags)) (ExternalMemoryHandleTypeFlags
handleTypes)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr ExportMemoryAllocateInfo -> IO b -> IO b
pokeZeroCStruct Ptr ExportMemoryAllocateInfo
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExportMemoryAllocateInfo
p Ptr ExportMemoryAllocateInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_EXPORT_MEMORY_ALLOCATE_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExportMemoryAllocateInfo
p Ptr ExportMemoryAllocateInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO b
f

instance FromCStruct ExportMemoryAllocateInfo where
  peekCStruct :: Ptr ExportMemoryAllocateInfo -> IO ExportMemoryAllocateInfo
peekCStruct Ptr ExportMemoryAllocateInfo
p = do
    ExternalMemoryHandleTypeFlags
handleTypes <- Ptr ExternalMemoryHandleTypeFlags
-> IO ExternalMemoryHandleTypeFlags
forall a. Storable a => Ptr a -> IO a
peek @ExternalMemoryHandleTypeFlags ((Ptr ExportMemoryAllocateInfo
p Ptr ExportMemoryAllocateInfo
-> Int -> Ptr ExternalMemoryHandleTypeFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ExternalMemoryHandleTypeFlags))
    ExportMemoryAllocateInfo -> IO ExportMemoryAllocateInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExportMemoryAllocateInfo -> IO ExportMemoryAllocateInfo)
-> ExportMemoryAllocateInfo -> IO ExportMemoryAllocateInfo
forall a b. (a -> b) -> a -> b
$ ExternalMemoryHandleTypeFlags -> ExportMemoryAllocateInfo
ExportMemoryAllocateInfo
             ExternalMemoryHandleTypeFlags
handleTypes

instance Storable ExportMemoryAllocateInfo where
  sizeOf :: ExportMemoryAllocateInfo -> Int
sizeOf ~ExportMemoryAllocateInfo
_ = Int
24
  alignment :: ExportMemoryAllocateInfo -> Int
alignment ~ExportMemoryAllocateInfo
_ = Int
8
  peek :: Ptr ExportMemoryAllocateInfo -> IO ExportMemoryAllocateInfo
peek = Ptr ExportMemoryAllocateInfo -> IO ExportMemoryAllocateInfo
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr ExportMemoryAllocateInfo -> ExportMemoryAllocateInfo -> IO ()
poke Ptr ExportMemoryAllocateInfo
ptr ExportMemoryAllocateInfo
poked = Ptr ExportMemoryAllocateInfo
-> ExportMemoryAllocateInfo -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ExportMemoryAllocateInfo
ptr ExportMemoryAllocateInfo
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero ExportMemoryAllocateInfo where
  zero :: ExportMemoryAllocateInfo
zero = ExternalMemoryHandleTypeFlags -> ExportMemoryAllocateInfo
ExportMemoryAllocateInfo
           ExternalMemoryHandleTypeFlags
forall a. Zero a => a
zero