{-# language CPP #-}
-- | = Name
--
-- VK_KHR_external_memory_win32 - device extension
--
-- == VK_KHR_external_memory_win32
--
-- [__Name String__]
--     @VK_KHR_external_memory_win32@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     74
--
-- [__Revision__]
--     1
--
-- [__Extension and Version Dependencies__]
--
--     -   Requires Vulkan 1.0
--
--     -   Requires @VK_KHR_external_memory@
--
-- [__Contact__]
--
--     -   James Jones
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_KHR_external_memory_win32] @cubanismo%0A<<Here describe the issue or question you have about the VK_KHR_external_memory_win32 extension>> >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2016-10-21
--
-- [__IP Status__]
--     No known IP claims.
--
-- [__Contributors__]
--
--     -   James Jones, NVIDIA
--
--     -   Jeff Juliano, NVIDIA
--
--     -   Carsten Rohde, NVIDIA
--
-- == Description
--
-- An application may wish to reference device memory in multiple Vulkan
-- logical devices or instances, in multiple processes, and\/or in multiple
-- APIs. This extension enables an application to export Windows handles
-- from Vulkan memory objects and to import Vulkan memory objects from
-- Windows handles exported from other Vulkan memory objects or from
-- similar resources in other APIs.
--
-- == New Commands
--
-- -   'getMemoryWin32HandleKHR'
--
-- -   'getMemoryWin32HandlePropertiesKHR'
--
-- == New Structures
--
-- -   'MemoryGetWin32HandleInfoKHR'
--
-- -   'MemoryWin32HandlePropertiesKHR'
--
-- -   Extending 'Vulkan.Core10.Memory.MemoryAllocateInfo':
--
--     -   'ExportMemoryWin32HandleInfoKHR'
--
--     -   'ImportMemoryWin32HandleInfoKHR'
--
-- == New Enum Constants
--
-- -   'KHR_EXTERNAL_MEMORY_WIN32_EXTENSION_NAME'
--
-- -   'KHR_EXTERNAL_MEMORY_WIN32_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_EXPORT_MEMORY_WIN32_HANDLE_INFO_KHR'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_IMPORT_MEMORY_WIN32_HANDLE_INFO_KHR'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_MEMORY_GET_WIN32_HANDLE_INFO_KHR'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_MEMORY_WIN32_HANDLE_PROPERTIES_KHR'
--
-- == Issues
--
-- 1) Do applications need to call @CloseHandle@() on the values returned
-- from 'getMemoryWin32HandleKHR' when @handleType@ is
-- 'Vulkan.Extensions.VK_KHR_external_memory_capabilities.EXTERNAL_MEMORY_HANDLE_TYPE_OPAQUE_WIN32_BIT_KHR'?
--
-- __RESOLVED__: Yes, unless it is passed back in to another driver
-- instance to import the object. A successful get call transfers ownership
-- of the handle to the application. Destroying the memory object will not
-- destroy the handle or the handle’s reference to the underlying memory
-- resource.
--
-- 2) Should the language regarding KMT\/Windows 7 handles be moved to a
-- separate extension so that it can be deprecated over time?
--
-- __RESOLVED__: No. Support for them can be deprecated by drivers if they
-- choose, by no longer returning them in the supported handle types of the
-- instance level queries.
--
-- 3) How should the valid size and memory type for windows memory handles
-- created outside of Vulkan be specified?
--
-- __RESOLVED__: The valid memory types are queried directly from the
-- external handle. The size is determined by the associated image or
-- buffer memory requirements for external handle types that require
-- dedicated allocations, and by the size specified when creating the
-- object from which the handle was exported for other external handle
-- types.
--
-- == Version History
--
-- -   Revision 1, 2016-10-21 (James Jones)
--
--     -   Initial revision
--
-- = See Also
--
-- 'ExportMemoryWin32HandleInfoKHR', 'ImportMemoryWin32HandleInfoKHR',
-- 'MemoryGetWin32HandleInfoKHR', 'MemoryWin32HandlePropertiesKHR',
-- 'getMemoryWin32HandleKHR', 'getMemoryWin32HandlePropertiesKHR'
--
-- = Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_external_memory_win32 Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_KHR_external_memory_win32  ( getMemoryWin32HandleKHR
                                                       , getMemoryWin32HandlePropertiesKHR
                                                       , ImportMemoryWin32HandleInfoKHR(..)
                                                       , ExportMemoryWin32HandleInfoKHR(..)
                                                       , MemoryWin32HandlePropertiesKHR(..)
                                                       , MemoryGetWin32HandleInfoKHR(..)
                                                       , KHR_EXTERNAL_MEMORY_WIN32_SPEC_VERSION
                                                       , pattern KHR_EXTERNAL_MEMORY_WIN32_SPEC_VERSION
                                                       , KHR_EXTERNAL_MEMORY_WIN32_EXTENSION_NAME
                                                       , pattern KHR_EXTERNAL_MEMORY_WIN32_EXTENSION_NAME
                                                       , LPCWSTR
                                                       , HANDLE
                                                       , DWORD
                                                       , SECURITY_ATTRIBUTES
                                                       ) 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.String (IsString)
import Data.Typeable (Typeable)
import Foreign.C.Types (CWchar)
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.Extensions.VK_NV_external_memory_win32 (DWORD)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Dynamic (DeviceCmds(pVkGetMemoryWin32HandleKHR))
import Vulkan.Dynamic (DeviceCmds(pVkGetMemoryWin32HandlePropertiesKHR))
import Vulkan.Core10.Handles (DeviceMemory)
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits (ExternalMemoryHandleTypeFlagBits)
import Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits (ExternalMemoryHandleTypeFlagBits(..))
import Vulkan.Extensions.VK_NV_external_memory_win32 (HANDLE)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Extensions.VK_NV_external_memory_win32 (SECURITY_ATTRIBUTES)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_EXPORT_MEMORY_WIN32_HANDLE_INFO_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_IMPORT_MEMORY_WIN32_HANDLE_INFO_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_MEMORY_GET_WIN32_HANDLE_INFO_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_MEMORY_WIN32_HANDLE_PROPERTIES_KHR))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Extensions.VK_NV_external_memory_win32 (DWORD)
import Vulkan.Extensions.VK_NV_external_memory_win32 (HANDLE)
import Vulkan.Extensions.VK_NV_external_memory_win32 (SECURITY_ATTRIBUTES)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetMemoryWin32HandleKHR
  :: FunPtr (Ptr Device_T -> Ptr MemoryGetWin32HandleInfoKHR -> Ptr HANDLE -> IO Result) -> Ptr Device_T -> Ptr MemoryGetWin32HandleInfoKHR -> Ptr HANDLE -> IO Result

-- | vkGetMemoryWin32HandleKHR - Get a Windows HANDLE for a memory object
--
-- = Description
--
-- For handle types defined as NT handles, the handles returned by
-- 'getMemoryWin32HandleKHR' are owned by the application and hold a
-- reference to their payload. To avoid leaking resources, the application
-- /must/ release ownership of them using the @CloseHandle@ system call
-- when they are no longer needed.
--
-- Note
--
-- Non-NT handle types do not add a reference to their associated payload.
-- If the original object owning the payload is destroyed, all resources
-- and handles sharing that payload will become invalid.
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_TOO_MANY_OBJECTS'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_external_memory_win32 VK_KHR_external_memory_win32>,
-- 'Vulkan.Core10.Handles.Device', 'MemoryGetWin32HandleInfoKHR'
getMemoryWin32HandleKHR :: forall io
                         . (MonadIO io)
                        => -- | @device@ is the logical device that created the device memory being
                           -- exported.
                           --
                           -- #VUID-vkGetMemoryWin32HandleKHR-device-parameter# @device@ /must/ be a
                           -- valid 'Vulkan.Core10.Handles.Device' handle
                           Device
                        -> -- | @pGetWin32HandleInfo@ is a pointer to a 'MemoryGetWin32HandleInfoKHR'
                           -- structure containing parameters of the export operation.
                           --
                           -- #VUID-vkGetMemoryWin32HandleKHR-pGetWin32HandleInfo-parameter#
                           -- @pGetWin32HandleInfo@ /must/ be a valid pointer to a valid
                           -- 'MemoryGetWin32HandleInfoKHR' structure
                           MemoryGetWin32HandleInfoKHR
                        -> io (HANDLE)
getMemoryWin32HandleKHR :: Device -> MemoryGetWin32HandleInfoKHR -> io HANDLE
getMemoryWin32HandleKHR Device
device MemoryGetWin32HandleInfoKHR
getWin32HandleInfo = IO HANDLE -> io HANDLE
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HANDLE -> io HANDLE)
-> (ContT HANDLE IO HANDLE -> IO HANDLE)
-> ContT HANDLE IO HANDLE
-> io HANDLE
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT HANDLE IO HANDLE -> IO HANDLE
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT HANDLE IO HANDLE -> io HANDLE)
-> ContT HANDLE IO HANDLE -> io HANDLE
forall a b. (a -> b) -> a -> b
$ do
  let vkGetMemoryWin32HandleKHRPtr :: FunPtr
  (Ptr Device_T
   -> ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
   -> ("pHandle" ::: Ptr HANDLE)
   -> IO Result)
vkGetMemoryWin32HandleKHRPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
      -> ("pHandle" ::: Ptr HANDLE)
      -> IO Result)
pVkGetMemoryWin32HandleKHR (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  IO () -> ContT HANDLE IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT HANDLE IO ()) -> IO () -> ContT HANDLE IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
   -> ("pHandle" ::: Ptr HANDLE)
   -> IO Result)
vkGetMemoryWin32HandleKHRPtr FunPtr
  (Ptr Device_T
   -> ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
   -> ("pHandle" ::: Ptr HANDLE)
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
      -> ("pHandle" ::: Ptr HANDLE)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
   -> ("pHandle" ::: Ptr HANDLE)
   -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetMemoryWin32HandleKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetMemoryWin32HandleKHR' :: Ptr Device_T
-> ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
-> ("pHandle" ::: Ptr HANDLE)
-> IO Result
vkGetMemoryWin32HandleKHR' = FunPtr
  (Ptr Device_T
   -> ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
   -> ("pHandle" ::: Ptr HANDLE)
   -> IO Result)
-> Ptr Device_T
-> ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
-> ("pHandle" ::: Ptr HANDLE)
-> IO Result
mkVkGetMemoryWin32HandleKHR FunPtr
  (Ptr Device_T
   -> ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
   -> ("pHandle" ::: Ptr HANDLE)
   -> IO Result)
vkGetMemoryWin32HandleKHRPtr
  "pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR
pGetWin32HandleInfo <- ((("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
  -> IO HANDLE)
 -> IO HANDLE)
-> ContT
     HANDLE
     IO
     ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
   -> IO HANDLE)
  -> IO HANDLE)
 -> ContT
      HANDLE
      IO
      ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR))
-> ((("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
     -> IO HANDLE)
    -> IO HANDLE)
-> ContT
     HANDLE
     IO
     ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
forall a b. (a -> b) -> a -> b
$ MemoryGetWin32HandleInfoKHR
-> (("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
    -> IO HANDLE)
-> IO HANDLE
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (MemoryGetWin32HandleInfoKHR
getWin32HandleInfo)
  "pHandle" ::: Ptr HANDLE
pPHandle <- ((("pHandle" ::: Ptr HANDLE) -> IO HANDLE) -> IO HANDLE)
-> ContT HANDLE IO ("pHandle" ::: Ptr HANDLE)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pHandle" ::: Ptr HANDLE) -> IO HANDLE) -> IO HANDLE)
 -> ContT HANDLE IO ("pHandle" ::: Ptr HANDLE))
-> ((("pHandle" ::: Ptr HANDLE) -> IO HANDLE) -> IO HANDLE)
-> ContT HANDLE IO ("pHandle" ::: Ptr HANDLE)
forall a b. (a -> b) -> a -> b
$ IO ("pHandle" ::: Ptr HANDLE)
-> (("pHandle" ::: Ptr HANDLE) -> IO ())
-> (("pHandle" ::: Ptr HANDLE) -> IO HANDLE)
-> IO HANDLE
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pHandle" ::: Ptr HANDLE)
forall a. Int -> IO (Ptr a)
callocBytes @HANDLE Int
8) ("pHandle" ::: Ptr HANDLE) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT HANDLE IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT HANDLE IO Result)
-> IO Result -> ContT HANDLE IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetMemoryWin32HandleKHR" (Ptr Device_T
-> ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
-> ("pHandle" ::: Ptr HANDLE)
-> IO Result
vkGetMemoryWin32HandleKHR' (Device -> Ptr Device_T
deviceHandle (Device
device)) "pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR
pGetWin32HandleInfo ("pHandle" ::: Ptr HANDLE
pPHandle))
  IO () -> ContT HANDLE IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT HANDLE IO ()) -> IO () -> ContT HANDLE IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  HANDLE
pHandle <- IO HANDLE -> ContT HANDLE IO HANDLE
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO HANDLE -> ContT HANDLE IO HANDLE)
-> IO HANDLE -> ContT HANDLE IO HANDLE
forall a b. (a -> b) -> a -> b
$ ("pHandle" ::: Ptr HANDLE) -> IO HANDLE
forall a. Storable a => Ptr a -> IO a
peek @HANDLE "pHandle" ::: Ptr HANDLE
pPHandle
  HANDLE -> ContT HANDLE IO HANDLE
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HANDLE -> ContT HANDLE IO HANDLE)
-> HANDLE -> ContT HANDLE IO HANDLE
forall a b. (a -> b) -> a -> b
$ (HANDLE
pHandle)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetMemoryWin32HandlePropertiesKHR
  :: FunPtr (Ptr Device_T -> ExternalMemoryHandleTypeFlagBits -> HANDLE -> Ptr MemoryWin32HandlePropertiesKHR -> IO Result) -> Ptr Device_T -> ExternalMemoryHandleTypeFlagBits -> HANDLE -> Ptr MemoryWin32HandlePropertiesKHR -> IO Result

-- | vkGetMemoryWin32HandlePropertiesKHR - Get Properties of External Memory
-- Win32 Handles
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_INVALID_EXTERNAL_HANDLE'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_external_memory_win32 VK_KHR_external_memory_win32>,
-- 'Vulkan.Core10.Handles.Device',
-- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits',
-- 'MemoryWin32HandlePropertiesKHR'
getMemoryWin32HandlePropertiesKHR :: forall io
                                   . (MonadIO io)
                                  => -- | @device@ is the logical device that will be importing @handle@.
                                     --
                                     -- #VUID-vkGetMemoryWin32HandlePropertiesKHR-device-parameter# @device@
                                     -- /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
                                     Device
                                  -> -- | @handleType@ is a
                                     -- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
                                     -- value specifying the type of the handle @handle@.
                                     --
                                     -- #VUID-vkGetMemoryWin32HandlePropertiesKHR-handleType-00666# @handleType@
                                     -- /must/ not be one of the handle types defined as opaque
                                     --
                                     -- #VUID-vkGetMemoryWin32HandlePropertiesKHR-handleType-parameter#
                                     -- @handleType@ /must/ be a valid
                                     -- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
                                     -- value
                                     ExternalMemoryHandleTypeFlagBits
                                  -> -- | @handle@ is the handle which will be imported.
                                     --
                                     -- #VUID-vkGetMemoryWin32HandlePropertiesKHR-handle-00665# @handle@ /must/
                                     -- be an external memory handle created outside of the Vulkan API
                                     HANDLE
                                  -> io (MemoryWin32HandlePropertiesKHR)
getMemoryWin32HandlePropertiesKHR :: Device
-> ExternalMemoryHandleTypeFlagBits
-> HANDLE
-> io MemoryWin32HandlePropertiesKHR
getMemoryWin32HandlePropertiesKHR Device
device ExternalMemoryHandleTypeFlagBits
handleType HANDLE
handle = IO MemoryWin32HandlePropertiesKHR
-> io MemoryWin32HandlePropertiesKHR
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MemoryWin32HandlePropertiesKHR
 -> io MemoryWin32HandlePropertiesKHR)
-> (ContT
      MemoryWin32HandlePropertiesKHR IO MemoryWin32HandlePropertiesKHR
    -> IO MemoryWin32HandlePropertiesKHR)
-> ContT
     MemoryWin32HandlePropertiesKHR IO MemoryWin32HandlePropertiesKHR
-> io MemoryWin32HandlePropertiesKHR
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  MemoryWin32HandlePropertiesKHR IO MemoryWin32HandlePropertiesKHR
-> IO MemoryWin32HandlePropertiesKHR
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   MemoryWin32HandlePropertiesKHR IO MemoryWin32HandlePropertiesKHR
 -> io MemoryWin32HandlePropertiesKHR)
-> ContT
     MemoryWin32HandlePropertiesKHR IO MemoryWin32HandlePropertiesKHR
-> io MemoryWin32HandlePropertiesKHR
forall a b. (a -> b) -> a -> b
$ do
  let vkGetMemoryWin32HandlePropertiesKHRPtr :: FunPtr
  (Ptr Device_T
   -> ExternalMemoryHandleTypeFlagBits
   -> HANDLE
   -> ("pMemoryWin32HandleProperties"
       ::: Ptr MemoryWin32HandlePropertiesKHR)
   -> IO Result)
vkGetMemoryWin32HandlePropertiesKHRPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ExternalMemoryHandleTypeFlagBits
      -> HANDLE
      -> ("pMemoryWin32HandleProperties"
          ::: Ptr MemoryWin32HandlePropertiesKHR)
      -> IO Result)
pVkGetMemoryWin32HandlePropertiesKHR (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  IO () -> ContT MemoryWin32HandlePropertiesKHR IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT MemoryWin32HandlePropertiesKHR IO ())
-> IO () -> ContT MemoryWin32HandlePropertiesKHR IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ExternalMemoryHandleTypeFlagBits
   -> HANDLE
   -> ("pMemoryWin32HandleProperties"
       ::: Ptr MemoryWin32HandlePropertiesKHR)
   -> IO Result)
vkGetMemoryWin32HandlePropertiesKHRPtr FunPtr
  (Ptr Device_T
   -> ExternalMemoryHandleTypeFlagBits
   -> HANDLE
   -> ("pMemoryWin32HandleProperties"
       ::: Ptr MemoryWin32HandlePropertiesKHR)
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> ExternalMemoryHandleTypeFlagBits
      -> HANDLE
      -> ("pMemoryWin32HandleProperties"
          ::: Ptr MemoryWin32HandlePropertiesKHR)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ExternalMemoryHandleTypeFlagBits
   -> HANDLE
   -> ("pMemoryWin32HandleProperties"
       ::: Ptr MemoryWin32HandlePropertiesKHR)
   -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetMemoryWin32HandlePropertiesKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetMemoryWin32HandlePropertiesKHR' :: Ptr Device_T
-> ExternalMemoryHandleTypeFlagBits
-> HANDLE
-> ("pMemoryWin32HandleProperties"
    ::: Ptr MemoryWin32HandlePropertiesKHR)
-> IO Result
vkGetMemoryWin32HandlePropertiesKHR' = FunPtr
  (Ptr Device_T
   -> ExternalMemoryHandleTypeFlagBits
   -> HANDLE
   -> ("pMemoryWin32HandleProperties"
       ::: Ptr MemoryWin32HandlePropertiesKHR)
   -> IO Result)
-> Ptr Device_T
-> ExternalMemoryHandleTypeFlagBits
-> HANDLE
-> ("pMemoryWin32HandleProperties"
    ::: Ptr MemoryWin32HandlePropertiesKHR)
-> IO Result
mkVkGetMemoryWin32HandlePropertiesKHR FunPtr
  (Ptr Device_T
   -> ExternalMemoryHandleTypeFlagBits
   -> HANDLE
   -> ("pMemoryWin32HandleProperties"
       ::: Ptr MemoryWin32HandlePropertiesKHR)
   -> IO Result)
vkGetMemoryWin32HandlePropertiesKHRPtr
  "pMemoryWin32HandleProperties"
::: Ptr MemoryWin32HandlePropertiesKHR
pPMemoryWin32HandleProperties <- ((("pMemoryWin32HandleProperties"
   ::: Ptr MemoryWin32HandlePropertiesKHR)
  -> IO MemoryWin32HandlePropertiesKHR)
 -> IO MemoryWin32HandlePropertiesKHR)
-> ContT
     MemoryWin32HandlePropertiesKHR
     IO
     ("pMemoryWin32HandleProperties"
      ::: Ptr MemoryWin32HandlePropertiesKHR)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct MemoryWin32HandlePropertiesKHR =>
(("pMemoryWin32HandleProperties"
  ::: Ptr MemoryWin32HandlePropertiesKHR)
 -> IO b)
-> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @MemoryWin32HandlePropertiesKHR)
  Result
r <- IO Result -> ContT MemoryWin32HandlePropertiesKHR IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT MemoryWin32HandlePropertiesKHR IO Result)
-> IO Result -> ContT MemoryWin32HandlePropertiesKHR IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetMemoryWin32HandlePropertiesKHR" (Ptr Device_T
-> ExternalMemoryHandleTypeFlagBits
-> HANDLE
-> ("pMemoryWin32HandleProperties"
    ::: Ptr MemoryWin32HandlePropertiesKHR)
-> IO Result
vkGetMemoryWin32HandlePropertiesKHR' (Device -> Ptr Device_T
deviceHandle (Device
device)) (ExternalMemoryHandleTypeFlagBits
handleType) (HANDLE
handle) ("pMemoryWin32HandleProperties"
::: Ptr MemoryWin32HandlePropertiesKHR
pPMemoryWin32HandleProperties))
  IO () -> ContT MemoryWin32HandlePropertiesKHR IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT MemoryWin32HandlePropertiesKHR IO ())
-> IO () -> ContT MemoryWin32HandlePropertiesKHR IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  MemoryWin32HandlePropertiesKHR
pMemoryWin32HandleProperties <- IO MemoryWin32HandlePropertiesKHR
-> ContT
     MemoryWin32HandlePropertiesKHR IO MemoryWin32HandlePropertiesKHR
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO MemoryWin32HandlePropertiesKHR
 -> ContT
      MemoryWin32HandlePropertiesKHR IO MemoryWin32HandlePropertiesKHR)
-> IO MemoryWin32HandlePropertiesKHR
-> ContT
     MemoryWin32HandlePropertiesKHR IO MemoryWin32HandlePropertiesKHR
forall a b. (a -> b) -> a -> b
$ ("pMemoryWin32HandleProperties"
 ::: Ptr MemoryWin32HandlePropertiesKHR)
-> IO MemoryWin32HandlePropertiesKHR
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @MemoryWin32HandlePropertiesKHR "pMemoryWin32HandleProperties"
::: Ptr MemoryWin32HandlePropertiesKHR
pPMemoryWin32HandleProperties
  MemoryWin32HandlePropertiesKHR
-> ContT
     MemoryWin32HandlePropertiesKHR IO MemoryWin32HandlePropertiesKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MemoryWin32HandlePropertiesKHR
 -> ContT
      MemoryWin32HandlePropertiesKHR IO MemoryWin32HandlePropertiesKHR)
-> MemoryWin32HandlePropertiesKHR
-> ContT
     MemoryWin32HandlePropertiesKHR IO MemoryWin32HandlePropertiesKHR
forall a b. (a -> b) -> a -> b
$ (MemoryWin32HandlePropertiesKHR
pMemoryWin32HandleProperties)


-- | VkImportMemoryWin32HandleInfoKHR - Import Win32 memory created on the
-- same physical device
--
-- = Description
--
-- Importing memory object payloads from Windows handles does not transfer
-- ownership of the handle to the Vulkan implementation. For handle types
-- defined as NT handles, the application /must/ release handle ownership
-- using the @CloseHandle@ system call when the handle is no longer needed.
-- For handle types defined as NT handles, the imported memory object holds
-- a reference to its payload.
--
-- Note
--
-- Non-NT handle import operations do not add a reference to their
-- associated payload. If the original object owning the payload is
-- destroyed, all resources and handles sharing that payload will become
-- invalid.
--
-- Applications /can/ import the same payload into multiple instances of
-- Vulkan, into the same instance from which it was exported, and multiple
-- times into a given Vulkan instance. In all cases, each import operation
-- /must/ create a distinct 'Vulkan.Core10.Handles.DeviceMemory' object.
--
-- == Valid Usage
--
-- -   #VUID-VkImportMemoryWin32HandleInfoKHR-handleType-00658# If
--     @handleType@ is not @0@, it /must/ be supported for import, as
--     reported by
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory_capabilities.ExternalImageFormatProperties'
--     or
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory_capabilities.ExternalBufferProperties'
--
-- -   #VUID-VkImportMemoryWin32HandleInfoKHR-handle-00659# The memory from
--     which @handle@ was exported, or the memory named by @name@ /must/
--     have been created on the same underlying physical device as @device@
--
-- -   #VUID-VkImportMemoryWin32HandleInfoKHR-handleType-00660# If
--     @handleType@ is not @0@, it /must/ be defined as an NT handle or a
--     global share handle
--
-- -   #VUID-VkImportMemoryWin32HandleInfoKHR-handleType-01439# If
--     @handleType@ is not
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_OPAQUE_WIN32_BIT',
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_D3D11_TEXTURE_BIT',
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_D3D12_HEAP_BIT',
--     or
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_D3D12_RESOURCE_BIT',
--     @name@ /must/ be @NULL@
--
-- -   #VUID-VkImportMemoryWin32HandleInfoKHR-handleType-01440# If
--     @handleType@ is not @0@ and @handle@ is @NULL@, @name@ /must/ name a
--     valid memory resource of the type specified by @handleType@
--
-- -   #VUID-VkImportMemoryWin32HandleInfoKHR-handleType-00661# If
--     @handleType@ is not @0@ and @name@ is @NULL@, @handle@ /must/ be a
--     valid handle of the type specified by @handleType@
--
-- -   #VUID-VkImportMemoryWin32HandleInfoKHR-handle-01441# if @handle@ is
--     not @NULL@, @name@ /must/ be @NULL@
--
-- -   #VUID-VkImportMemoryWin32HandleInfoKHR-handle-01518# If @handle@ is
--     not @NULL@, it /must/ obey any requirements listed for @handleType@
--     in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#external-memory-handle-types-compatibility external memory handle types compatibility>
--
-- -   #VUID-VkImportMemoryWin32HandleInfoKHR-name-01519# If @name@ is not
--     @NULL@, it /must/ obey any requirements listed for @handleType@ in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#external-memory-handle-types-compatibility external memory handle types compatibility>
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkImportMemoryWin32HandleInfoKHR-sType-sType# @sType@ /must/
--     be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_IMPORT_MEMORY_WIN32_HANDLE_INFO_KHR'
--
-- -   #VUID-VkImportMemoryWin32HandleInfoKHR-handleType-parameter# If
--     @handleType@ is not @0@, @handleType@ /must/ be a valid
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
--     value
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_external_memory_win32 VK_KHR_external_memory_win32>,
-- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data ImportMemoryWin32HandleInfoKHR = ImportMemoryWin32HandleInfoKHR
  { -- | @handleType@ is a
    -- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
    -- value specifying the type of @handle@ or @name@.
    ImportMemoryWin32HandleInfoKHR -> ExternalMemoryHandleTypeFlagBits
handleType :: ExternalMemoryHandleTypeFlagBits
  , -- | @handle@ is @NULL@ or the external handle to import.
    ImportMemoryWin32HandleInfoKHR -> HANDLE
handle :: HANDLE
  , -- | @name@ is @NULL@ or a null-terminated UTF-16 string naming the payload
    -- to import.
    ImportMemoryWin32HandleInfoKHR -> LPCWSTR
name :: LPCWSTR
  }
  deriving (Typeable, ImportMemoryWin32HandleInfoKHR
-> ImportMemoryWin32HandleInfoKHR -> Bool
(ImportMemoryWin32HandleInfoKHR
 -> ImportMemoryWin32HandleInfoKHR -> Bool)
-> (ImportMemoryWin32HandleInfoKHR
    -> ImportMemoryWin32HandleInfoKHR -> Bool)
-> Eq ImportMemoryWin32HandleInfoKHR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportMemoryWin32HandleInfoKHR
-> ImportMemoryWin32HandleInfoKHR -> Bool
$c/= :: ImportMemoryWin32HandleInfoKHR
-> ImportMemoryWin32HandleInfoKHR -> Bool
== :: ImportMemoryWin32HandleInfoKHR
-> ImportMemoryWin32HandleInfoKHR -> Bool
$c== :: ImportMemoryWin32HandleInfoKHR
-> ImportMemoryWin32HandleInfoKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ImportMemoryWin32HandleInfoKHR)
#endif
deriving instance Show ImportMemoryWin32HandleInfoKHR

instance ToCStruct ImportMemoryWin32HandleInfoKHR where
  withCStruct :: ImportMemoryWin32HandleInfoKHR
-> (Ptr ImportMemoryWin32HandleInfoKHR -> IO b) -> IO b
withCStruct ImportMemoryWin32HandleInfoKHR
x Ptr ImportMemoryWin32HandleInfoKHR -> IO b
f = Int -> (Ptr ImportMemoryWin32HandleInfoKHR -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
40 ((Ptr ImportMemoryWin32HandleInfoKHR -> IO b) -> IO b)
-> (Ptr ImportMemoryWin32HandleInfoKHR -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr ImportMemoryWin32HandleInfoKHR
p -> Ptr ImportMemoryWin32HandleInfoKHR
-> ImportMemoryWin32HandleInfoKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ImportMemoryWin32HandleInfoKHR
p ImportMemoryWin32HandleInfoKHR
x (Ptr ImportMemoryWin32HandleInfoKHR -> IO b
f Ptr ImportMemoryWin32HandleInfoKHR
p)
  pokeCStruct :: Ptr ImportMemoryWin32HandleInfoKHR
-> ImportMemoryWin32HandleInfoKHR -> IO b -> IO b
pokeCStruct Ptr ImportMemoryWin32HandleInfoKHR
p ImportMemoryWin32HandleInfoKHR{HANDLE
LPCWSTR
ExternalMemoryHandleTypeFlagBits
name :: LPCWSTR
handle :: HANDLE
handleType :: ExternalMemoryHandleTypeFlagBits
$sel:name:ImportMemoryWin32HandleInfoKHR :: ImportMemoryWin32HandleInfoKHR -> LPCWSTR
$sel:handle:ImportMemoryWin32HandleInfoKHR :: ImportMemoryWin32HandleInfoKHR -> HANDLE
$sel:handleType:ImportMemoryWin32HandleInfoKHR :: ImportMemoryWin32HandleInfoKHR -> ExternalMemoryHandleTypeFlagBits
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryWin32HandleInfoKHR
p Ptr ImportMemoryWin32HandleInfoKHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMPORT_MEMORY_WIN32_HANDLE_INFO_KHR)
    ("pHandle" ::: Ptr HANDLE) -> HANDLE -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryWin32HandleInfoKHR
p Ptr ImportMemoryWin32HandleInfoKHR
-> Int -> "pHandle" ::: Ptr HANDLE
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (HANDLE
forall a. Ptr a
nullPtr)
    Ptr ExternalMemoryHandleTypeFlagBits
-> ExternalMemoryHandleTypeFlagBits -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryWin32HandleInfoKHR
p Ptr ImportMemoryWin32HandleInfoKHR
-> Int -> Ptr ExternalMemoryHandleTypeFlagBits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ExternalMemoryHandleTypeFlagBits)) (ExternalMemoryHandleTypeFlagBits
handleType)
    ("pHandle" ::: Ptr HANDLE) -> HANDLE -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryWin32HandleInfoKHR
p Ptr ImportMemoryWin32HandleInfoKHR
-> Int -> "pHandle" ::: Ptr HANDLE
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr HANDLE)) (HANDLE
handle)
    Ptr LPCWSTR -> LPCWSTR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryWin32HandleInfoKHR
p Ptr ImportMemoryWin32HandleInfoKHR -> Int -> Ptr LPCWSTR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr LPCWSTR)) (LPCWSTR
name)
    IO b
f
  cStructSize :: Int
cStructSize = Int
40
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr ImportMemoryWin32HandleInfoKHR -> IO b -> IO b
pokeZeroCStruct Ptr ImportMemoryWin32HandleInfoKHR
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryWin32HandleInfoKHR
p Ptr ImportMemoryWin32HandleInfoKHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMPORT_MEMORY_WIN32_HANDLE_INFO_KHR)
    ("pHandle" ::: Ptr HANDLE) -> HANDLE -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryWin32HandleInfoKHR
p Ptr ImportMemoryWin32HandleInfoKHR
-> Int -> "pHandle" ::: Ptr HANDLE
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (HANDLE
forall a. Ptr a
nullPtr)
    IO b
f

instance FromCStruct ImportMemoryWin32HandleInfoKHR where
  peekCStruct :: Ptr ImportMemoryWin32HandleInfoKHR
-> IO ImportMemoryWin32HandleInfoKHR
peekCStruct Ptr ImportMemoryWin32HandleInfoKHR
p = do
    ExternalMemoryHandleTypeFlagBits
handleType <- Ptr ExternalMemoryHandleTypeFlagBits
-> IO ExternalMemoryHandleTypeFlagBits
forall a. Storable a => Ptr a -> IO a
peek @ExternalMemoryHandleTypeFlagBits ((Ptr ImportMemoryWin32HandleInfoKHR
p Ptr ImportMemoryWin32HandleInfoKHR
-> Int -> Ptr ExternalMemoryHandleTypeFlagBits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ExternalMemoryHandleTypeFlagBits))
    HANDLE
handle <- ("pHandle" ::: Ptr HANDLE) -> IO HANDLE
forall a. Storable a => Ptr a -> IO a
peek @HANDLE ((Ptr ImportMemoryWin32HandleInfoKHR
p Ptr ImportMemoryWin32HandleInfoKHR
-> Int -> "pHandle" ::: Ptr HANDLE
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr HANDLE))
    LPCWSTR
name <- Ptr LPCWSTR -> IO LPCWSTR
forall a. Storable a => Ptr a -> IO a
peek @LPCWSTR ((Ptr ImportMemoryWin32HandleInfoKHR
p Ptr ImportMemoryWin32HandleInfoKHR -> Int -> Ptr LPCWSTR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr LPCWSTR))
    ImportMemoryWin32HandleInfoKHR -> IO ImportMemoryWin32HandleInfoKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ImportMemoryWin32HandleInfoKHR
 -> IO ImportMemoryWin32HandleInfoKHR)
-> ImportMemoryWin32HandleInfoKHR
-> IO ImportMemoryWin32HandleInfoKHR
forall a b. (a -> b) -> a -> b
$ ExternalMemoryHandleTypeFlagBits
-> HANDLE -> LPCWSTR -> ImportMemoryWin32HandleInfoKHR
ImportMemoryWin32HandleInfoKHR
             ExternalMemoryHandleTypeFlagBits
handleType HANDLE
handle LPCWSTR
name

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

instance Zero ImportMemoryWin32HandleInfoKHR where
  zero :: ImportMemoryWin32HandleInfoKHR
zero = ExternalMemoryHandleTypeFlagBits
-> HANDLE -> LPCWSTR -> ImportMemoryWin32HandleInfoKHR
ImportMemoryWin32HandleInfoKHR
           ExternalMemoryHandleTypeFlagBits
forall a. Zero a => a
zero
           HANDLE
forall a. Zero a => a
zero
           LPCWSTR
forall a. Zero a => a
zero


-- | VkExportMemoryWin32HandleInfoKHR - Structure specifying additional
-- attributes of Windows handles exported from a memory
--
-- = Description
--
-- If
-- 'Vulkan.Core11.Promoted_From_VK_KHR_external_memory.ExportMemoryAllocateInfo'
-- is not included in the same @pNext@ chain, this structure is ignored.
--
-- If
-- 'Vulkan.Core11.Promoted_From_VK_KHR_external_memory.ExportMemoryAllocateInfo'
-- is included in the @pNext@ chain of
-- 'Vulkan.Core10.Memory.MemoryAllocateInfo' with a Windows @handleType@,
-- but either 'ExportMemoryWin32HandleInfoKHR' is not included in the
-- @pNext@ chain, or if it is but @pAttributes@ is set to @NULL@, default
-- security descriptor values will be used, and child processes created by
-- the application will not inherit the handle, as described in the MSDN
-- documentation for “Synchronization Object Security and Access Rights”1.
-- Further, if the structure is not present, the access rights used depend
-- on the handle type.
--
-- For handles of the following types:
--
-- -   'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_OPAQUE_WIN32_BIT'
--
-- -   'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_D3D11_TEXTURE_BIT'
--
-- The implementation /must/ ensure the access rights allow read and write
-- access to the memory.
--
-- For handles of the following types:
--
-- -   'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_D3D12_HEAP_BIT'
--
-- -   'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_D3D12_RESOURCE_BIT'
--
-- The access rights /must/ be:
--
-- -   @GENERIC_ALL@
--
--     [1]
--         <https://docs.microsoft.com/en-us/windows/win32/sync/synchronization-object-security-and-access-rights>
--
-- == Valid Usage
--
-- -   #VUID-VkExportMemoryWin32HandleInfoKHR-handleTypes-00657# If
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory.ExportMemoryAllocateInfo'::@handleTypes@
--     does not include
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_OPAQUE_WIN32_BIT',
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_D3D11_TEXTURE_BIT',
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_D3D12_HEAP_BIT',
--     or
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_D3D12_RESOURCE_BIT',
--     a 'ExportMemoryWin32HandleInfoKHR' structure /must/ not be included
--     in the @pNext@ chain of 'Vulkan.Core10.Memory.MemoryAllocateInfo'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkExportMemoryWin32HandleInfoKHR-sType-sType# @sType@ /must/
--     be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_EXPORT_MEMORY_WIN32_HANDLE_INFO_KHR'
--
-- -   #VUID-VkExportMemoryWin32HandleInfoKHR-pAttributes-parameter# If
--     @pAttributes@ is not @NULL@, @pAttributes@ /must/ be a valid pointer
--     to a valid
--     'Vulkan.Extensions.VK_NV_external_memory_win32.SECURITY_ATTRIBUTES'
--     value
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_external_memory_win32 VK_KHR_external_memory_win32>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data ExportMemoryWin32HandleInfoKHR = ExportMemoryWin32HandleInfoKHR
  { -- | @pAttributes@ is a pointer to a Windows
    -- 'Vulkan.Extensions.VK_NV_external_memory_win32.SECURITY_ATTRIBUTES'
    -- structure specifying security attributes of the handle.
    ExportMemoryWin32HandleInfoKHR -> Ptr SECURITY_ATTRIBUTES
attributes :: Ptr SECURITY_ATTRIBUTES
  , -- | @dwAccess@ is a 'Vulkan.Extensions.VK_NV_external_memory_win32.DWORD'
    -- specifying access rights of the handle.
    ExportMemoryWin32HandleInfoKHR -> DWORD
dwAccess :: DWORD
  , -- | @name@ is a null-terminated UTF-16 string to associate with the payload
    -- referenced by NT handles exported from the created memory.
    ExportMemoryWin32HandleInfoKHR -> LPCWSTR
name :: LPCWSTR
  }
  deriving (Typeable, ExportMemoryWin32HandleInfoKHR
-> ExportMemoryWin32HandleInfoKHR -> Bool
(ExportMemoryWin32HandleInfoKHR
 -> ExportMemoryWin32HandleInfoKHR -> Bool)
-> (ExportMemoryWin32HandleInfoKHR
    -> ExportMemoryWin32HandleInfoKHR -> Bool)
-> Eq ExportMemoryWin32HandleInfoKHR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportMemoryWin32HandleInfoKHR
-> ExportMemoryWin32HandleInfoKHR -> Bool
$c/= :: ExportMemoryWin32HandleInfoKHR
-> ExportMemoryWin32HandleInfoKHR -> Bool
== :: ExportMemoryWin32HandleInfoKHR
-> ExportMemoryWin32HandleInfoKHR -> Bool
$c== :: ExportMemoryWin32HandleInfoKHR
-> ExportMemoryWin32HandleInfoKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ExportMemoryWin32HandleInfoKHR)
#endif
deriving instance Show ExportMemoryWin32HandleInfoKHR

instance ToCStruct ExportMemoryWin32HandleInfoKHR where
  withCStruct :: ExportMemoryWin32HandleInfoKHR
-> (Ptr ExportMemoryWin32HandleInfoKHR -> IO b) -> IO b
withCStruct ExportMemoryWin32HandleInfoKHR
x Ptr ExportMemoryWin32HandleInfoKHR -> IO b
f = Int -> (Ptr ExportMemoryWin32HandleInfoKHR -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
40 ((Ptr ExportMemoryWin32HandleInfoKHR -> IO b) -> IO b)
-> (Ptr ExportMemoryWin32HandleInfoKHR -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr ExportMemoryWin32HandleInfoKHR
p -> Ptr ExportMemoryWin32HandleInfoKHR
-> ExportMemoryWin32HandleInfoKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ExportMemoryWin32HandleInfoKHR
p ExportMemoryWin32HandleInfoKHR
x (Ptr ExportMemoryWin32HandleInfoKHR -> IO b
f Ptr ExportMemoryWin32HandleInfoKHR
p)
  pokeCStruct :: Ptr ExportMemoryWin32HandleInfoKHR
-> ExportMemoryWin32HandleInfoKHR -> IO b -> IO b
pokeCStruct Ptr ExportMemoryWin32HandleInfoKHR
p ExportMemoryWin32HandleInfoKHR{DWORD
LPCWSTR
Ptr SECURITY_ATTRIBUTES
name :: LPCWSTR
dwAccess :: DWORD
attributes :: Ptr SECURITY_ATTRIBUTES
$sel:name:ExportMemoryWin32HandleInfoKHR :: ExportMemoryWin32HandleInfoKHR -> LPCWSTR
$sel:dwAccess:ExportMemoryWin32HandleInfoKHR :: ExportMemoryWin32HandleInfoKHR -> DWORD
$sel:attributes:ExportMemoryWin32HandleInfoKHR :: ExportMemoryWin32HandleInfoKHR -> Ptr SECURITY_ATTRIBUTES
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExportMemoryWin32HandleInfoKHR
p Ptr ExportMemoryWin32HandleInfoKHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_EXPORT_MEMORY_WIN32_HANDLE_INFO_KHR)
    ("pHandle" ::: Ptr HANDLE) -> HANDLE -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExportMemoryWin32HandleInfoKHR
p Ptr ExportMemoryWin32HandleInfoKHR
-> Int -> "pHandle" ::: Ptr HANDLE
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (HANDLE
forall a. Ptr a
nullPtr)
    Ptr (Ptr SECURITY_ATTRIBUTES) -> Ptr SECURITY_ATTRIBUTES -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExportMemoryWin32HandleInfoKHR
p Ptr ExportMemoryWin32HandleInfoKHR
-> Int -> Ptr (Ptr SECURITY_ATTRIBUTES)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (Ptr SECURITY_ATTRIBUTES))) (Ptr SECURITY_ATTRIBUTES
attributes)
    Ptr DWORD -> DWORD -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExportMemoryWin32HandleInfoKHR
p Ptr ExportMemoryWin32HandleInfoKHR -> Int -> Ptr DWORD
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DWORD)) (DWORD
dwAccess)
    Ptr LPCWSTR -> LPCWSTR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExportMemoryWin32HandleInfoKHR
p Ptr ExportMemoryWin32HandleInfoKHR -> Int -> Ptr LPCWSTR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr LPCWSTR)) (LPCWSTR
name)
    IO b
f
  cStructSize :: Int
cStructSize = Int
40
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr ExportMemoryWin32HandleInfoKHR -> IO b -> IO b
pokeZeroCStruct Ptr ExportMemoryWin32HandleInfoKHR
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExportMemoryWin32HandleInfoKHR
p Ptr ExportMemoryWin32HandleInfoKHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_EXPORT_MEMORY_WIN32_HANDLE_INFO_KHR)
    ("pHandle" ::: Ptr HANDLE) -> HANDLE -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExportMemoryWin32HandleInfoKHR
p Ptr ExportMemoryWin32HandleInfoKHR
-> Int -> "pHandle" ::: Ptr HANDLE
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (HANDLE
forall a. Ptr a
nullPtr)
    Ptr DWORD -> DWORD -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExportMemoryWin32HandleInfoKHR
p Ptr ExportMemoryWin32HandleInfoKHR -> Int -> Ptr DWORD
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DWORD)) (DWORD
forall a. Zero a => a
zero)
    Ptr LPCWSTR -> LPCWSTR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExportMemoryWin32HandleInfoKHR
p Ptr ExportMemoryWin32HandleInfoKHR -> Int -> Ptr LPCWSTR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr LPCWSTR)) (LPCWSTR
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct ExportMemoryWin32HandleInfoKHR where
  peekCStruct :: Ptr ExportMemoryWin32HandleInfoKHR
-> IO ExportMemoryWin32HandleInfoKHR
peekCStruct Ptr ExportMemoryWin32HandleInfoKHR
p = do
    Ptr SECURITY_ATTRIBUTES
pAttributes <- Ptr (Ptr SECURITY_ATTRIBUTES) -> IO (Ptr SECURITY_ATTRIBUTES)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr SECURITY_ATTRIBUTES) ((Ptr ExportMemoryWin32HandleInfoKHR
p Ptr ExportMemoryWin32HandleInfoKHR
-> Int -> Ptr (Ptr SECURITY_ATTRIBUTES)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (Ptr SECURITY_ATTRIBUTES)))
    DWORD
dwAccess <- Ptr DWORD -> IO DWORD
forall a. Storable a => Ptr a -> IO a
peek @DWORD ((Ptr ExportMemoryWin32HandleInfoKHR
p Ptr ExportMemoryWin32HandleInfoKHR -> Int -> Ptr DWORD
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DWORD))
    LPCWSTR
name <- Ptr LPCWSTR -> IO LPCWSTR
forall a. Storable a => Ptr a -> IO a
peek @LPCWSTR ((Ptr ExportMemoryWin32HandleInfoKHR
p Ptr ExportMemoryWin32HandleInfoKHR -> Int -> Ptr LPCWSTR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr LPCWSTR))
    ExportMemoryWin32HandleInfoKHR -> IO ExportMemoryWin32HandleInfoKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExportMemoryWin32HandleInfoKHR
 -> IO ExportMemoryWin32HandleInfoKHR)
-> ExportMemoryWin32HandleInfoKHR
-> IO ExportMemoryWin32HandleInfoKHR
forall a b. (a -> b) -> a -> b
$ Ptr SECURITY_ATTRIBUTES
-> DWORD -> LPCWSTR -> ExportMemoryWin32HandleInfoKHR
ExportMemoryWin32HandleInfoKHR
             Ptr SECURITY_ATTRIBUTES
pAttributes DWORD
dwAccess LPCWSTR
name

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

instance Zero ExportMemoryWin32HandleInfoKHR where
  zero :: ExportMemoryWin32HandleInfoKHR
zero = Ptr SECURITY_ATTRIBUTES
-> DWORD -> LPCWSTR -> ExportMemoryWin32HandleInfoKHR
ExportMemoryWin32HandleInfoKHR
           Ptr SECURITY_ATTRIBUTES
forall a. Zero a => a
zero
           DWORD
forall a. Zero a => a
zero
           LPCWSTR
forall a. Zero a => a
zero


-- | VkMemoryWin32HandlePropertiesKHR - Properties of External Memory Windows
-- Handles
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_external_memory_win32 VK_KHR_external_memory_win32>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'getMemoryWin32HandlePropertiesKHR'
data MemoryWin32HandlePropertiesKHR = MemoryWin32HandlePropertiesKHR
  { -- | @memoryTypeBits@ is a bitmask containing one bit set for every memory
    -- type which the specified windows handle /can/ be imported as.
    MemoryWin32HandlePropertiesKHR -> DWORD
memoryTypeBits :: Word32 }
  deriving (Typeable, MemoryWin32HandlePropertiesKHR
-> MemoryWin32HandlePropertiesKHR -> Bool
(MemoryWin32HandlePropertiesKHR
 -> MemoryWin32HandlePropertiesKHR -> Bool)
-> (MemoryWin32HandlePropertiesKHR
    -> MemoryWin32HandlePropertiesKHR -> Bool)
-> Eq MemoryWin32HandlePropertiesKHR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemoryWin32HandlePropertiesKHR
-> MemoryWin32HandlePropertiesKHR -> Bool
$c/= :: MemoryWin32HandlePropertiesKHR
-> MemoryWin32HandlePropertiesKHR -> Bool
== :: MemoryWin32HandlePropertiesKHR
-> MemoryWin32HandlePropertiesKHR -> Bool
$c== :: MemoryWin32HandlePropertiesKHR
-> MemoryWin32HandlePropertiesKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (MemoryWin32HandlePropertiesKHR)
#endif
deriving instance Show MemoryWin32HandlePropertiesKHR

instance ToCStruct MemoryWin32HandlePropertiesKHR where
  withCStruct :: MemoryWin32HandlePropertiesKHR
-> (("pMemoryWin32HandleProperties"
     ::: Ptr MemoryWin32HandlePropertiesKHR)
    -> IO b)
-> IO b
withCStruct MemoryWin32HandlePropertiesKHR
x ("pMemoryWin32HandleProperties"
 ::: Ptr MemoryWin32HandlePropertiesKHR)
-> IO b
f = Int
-> (("pMemoryWin32HandleProperties"
     ::: Ptr MemoryWin32HandlePropertiesKHR)
    -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((("pMemoryWin32HandleProperties"
   ::: Ptr MemoryWin32HandlePropertiesKHR)
  -> IO b)
 -> IO b)
-> (("pMemoryWin32HandleProperties"
     ::: Ptr MemoryWin32HandlePropertiesKHR)
    -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \"pMemoryWin32HandleProperties"
::: Ptr MemoryWin32HandlePropertiesKHR
p -> ("pMemoryWin32HandleProperties"
 ::: Ptr MemoryWin32HandlePropertiesKHR)
-> MemoryWin32HandlePropertiesKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pMemoryWin32HandleProperties"
::: Ptr MemoryWin32HandlePropertiesKHR
p MemoryWin32HandlePropertiesKHR
x (("pMemoryWin32HandleProperties"
 ::: Ptr MemoryWin32HandlePropertiesKHR)
-> IO b
f "pMemoryWin32HandleProperties"
::: Ptr MemoryWin32HandlePropertiesKHR
p)
  pokeCStruct :: ("pMemoryWin32HandleProperties"
 ::: Ptr MemoryWin32HandlePropertiesKHR)
-> MemoryWin32HandlePropertiesKHR -> IO b -> IO b
pokeCStruct "pMemoryWin32HandleProperties"
::: Ptr MemoryWin32HandlePropertiesKHR
p MemoryWin32HandlePropertiesKHR{DWORD
memoryTypeBits :: DWORD
$sel:memoryTypeBits:MemoryWin32HandlePropertiesKHR :: MemoryWin32HandlePropertiesKHR -> DWORD
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryWin32HandleProperties"
::: Ptr MemoryWin32HandlePropertiesKHR
p ("pMemoryWin32HandleProperties"
 ::: Ptr MemoryWin32HandlePropertiesKHR)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_WIN32_HANDLE_PROPERTIES_KHR)
    ("pHandle" ::: Ptr HANDLE) -> HANDLE -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryWin32HandleProperties"
::: Ptr MemoryWin32HandlePropertiesKHR
p ("pMemoryWin32HandleProperties"
 ::: Ptr MemoryWin32HandlePropertiesKHR)
-> Int -> "pHandle" ::: Ptr HANDLE
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (HANDLE
forall a. Ptr a
nullPtr)
    Ptr DWORD -> DWORD -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryWin32HandleProperties"
::: Ptr MemoryWin32HandlePropertiesKHR
p ("pMemoryWin32HandleProperties"
 ::: Ptr MemoryWin32HandlePropertiesKHR)
-> Int -> Ptr DWORD
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (DWORD
memoryTypeBits)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: ("pMemoryWin32HandleProperties"
 ::: Ptr MemoryWin32HandlePropertiesKHR)
-> IO b -> IO b
pokeZeroCStruct "pMemoryWin32HandleProperties"
::: Ptr MemoryWin32HandlePropertiesKHR
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryWin32HandleProperties"
::: Ptr MemoryWin32HandlePropertiesKHR
p ("pMemoryWin32HandleProperties"
 ::: Ptr MemoryWin32HandlePropertiesKHR)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_WIN32_HANDLE_PROPERTIES_KHR)
    ("pHandle" ::: Ptr HANDLE) -> HANDLE -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryWin32HandleProperties"
::: Ptr MemoryWin32HandlePropertiesKHR
p ("pMemoryWin32HandleProperties"
 ::: Ptr MemoryWin32HandlePropertiesKHR)
-> Int -> "pHandle" ::: Ptr HANDLE
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (HANDLE
forall a. Ptr a
nullPtr)
    Ptr DWORD -> DWORD -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryWin32HandleProperties"
::: Ptr MemoryWin32HandlePropertiesKHR
p ("pMemoryWin32HandleProperties"
 ::: Ptr MemoryWin32HandlePropertiesKHR)
-> Int -> Ptr DWORD
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (DWORD
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct MemoryWin32HandlePropertiesKHR where
  peekCStruct :: ("pMemoryWin32HandleProperties"
 ::: Ptr MemoryWin32HandlePropertiesKHR)
-> IO MemoryWin32HandlePropertiesKHR
peekCStruct "pMemoryWin32HandleProperties"
::: Ptr MemoryWin32HandlePropertiesKHR
p = do
    DWORD
memoryTypeBits <- Ptr DWORD -> IO DWORD
forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pMemoryWin32HandleProperties"
::: Ptr MemoryWin32HandlePropertiesKHR
p ("pMemoryWin32HandleProperties"
 ::: Ptr MemoryWin32HandlePropertiesKHR)
-> Int -> Ptr DWORD
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    MemoryWin32HandlePropertiesKHR -> IO MemoryWin32HandlePropertiesKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MemoryWin32HandlePropertiesKHR
 -> IO MemoryWin32HandlePropertiesKHR)
-> MemoryWin32HandlePropertiesKHR
-> IO MemoryWin32HandlePropertiesKHR
forall a b. (a -> b) -> a -> b
$ DWORD -> MemoryWin32HandlePropertiesKHR
MemoryWin32HandlePropertiesKHR
             DWORD
memoryTypeBits

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

instance Zero MemoryWin32HandlePropertiesKHR where
  zero :: MemoryWin32HandlePropertiesKHR
zero = DWORD -> MemoryWin32HandlePropertiesKHR
MemoryWin32HandlePropertiesKHR
           DWORD
forall a. Zero a => a
zero


-- | VkMemoryGetWin32HandleInfoKHR - Structure describing a Win32 handle
-- semaphore export operation
--
-- = Description
--
-- The properties of the handle returned depend on the value of
-- @handleType@. See
-- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
-- for a description of the properties of the defined external memory
-- handle types.
--
-- == Valid Usage
--
-- -   #VUID-VkMemoryGetWin32HandleInfoKHR-handleType-00662# @handleType@
--     /must/ have been included in
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory.ExportMemoryAllocateInfo'::@handleTypes@
--     when @memory@ was created
--
-- -   #VUID-VkMemoryGetWin32HandleInfoKHR-handleType-00663# If
--     @handleType@ is defined as an NT handle, 'getMemoryWin32HandleKHR'
--     /must/ be called no more than once for each valid unique combination
--     of @memory@ and @handleType@
--
-- -   #VUID-VkMemoryGetWin32HandleInfoKHR-handleType-00664# @handleType@
--     /must/ be defined as an NT handle or a global share handle
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkMemoryGetWin32HandleInfoKHR-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_MEMORY_GET_WIN32_HANDLE_INFO_KHR'
--
-- -   #VUID-VkMemoryGetWin32HandleInfoKHR-pNext-pNext# @pNext@ /must/ be
--     @NULL@
--
-- -   #VUID-VkMemoryGetWin32HandleInfoKHR-memory-parameter# @memory@
--     /must/ be a valid 'Vulkan.Core10.Handles.DeviceMemory' handle
--
-- -   #VUID-VkMemoryGetWin32HandleInfoKHR-handleType-parameter#
--     @handleType@ /must/ be a valid
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
--     value
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_external_memory_win32 VK_KHR_external_memory_win32>,
-- 'Vulkan.Core10.Handles.DeviceMemory',
-- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'getMemoryWin32HandleKHR'
data MemoryGetWin32HandleInfoKHR = MemoryGetWin32HandleInfoKHR
  { -- | @memory@ is the memory object from which the handle will be exported.
    MemoryGetWin32HandleInfoKHR -> DeviceMemory
memory :: DeviceMemory
  , -- | @handleType@ is a
    -- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
    -- value specifying the type of handle requested.
    MemoryGetWin32HandleInfoKHR -> ExternalMemoryHandleTypeFlagBits
handleType :: ExternalMemoryHandleTypeFlagBits
  }
  deriving (Typeable, MemoryGetWin32HandleInfoKHR -> MemoryGetWin32HandleInfoKHR -> Bool
(MemoryGetWin32HandleInfoKHR
 -> MemoryGetWin32HandleInfoKHR -> Bool)
-> (MemoryGetWin32HandleInfoKHR
    -> MemoryGetWin32HandleInfoKHR -> Bool)
-> Eq MemoryGetWin32HandleInfoKHR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemoryGetWin32HandleInfoKHR -> MemoryGetWin32HandleInfoKHR -> Bool
$c/= :: MemoryGetWin32HandleInfoKHR -> MemoryGetWin32HandleInfoKHR -> Bool
== :: MemoryGetWin32HandleInfoKHR -> MemoryGetWin32HandleInfoKHR -> Bool
$c== :: MemoryGetWin32HandleInfoKHR -> MemoryGetWin32HandleInfoKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (MemoryGetWin32HandleInfoKHR)
#endif
deriving instance Show MemoryGetWin32HandleInfoKHR

instance ToCStruct MemoryGetWin32HandleInfoKHR where
  withCStruct :: MemoryGetWin32HandleInfoKHR
-> (("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
    -> IO b)
-> IO b
withCStruct MemoryGetWin32HandleInfoKHR
x ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR) -> IO b
f = Int
-> (("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
    -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
  -> IO b)
 -> IO b)
-> (("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
    -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \"pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR
p -> ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
-> MemoryGetWin32HandleInfoKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR
p MemoryGetWin32HandleInfoKHR
x (("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR) -> IO b
f "pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR
p)
  pokeCStruct :: ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
-> MemoryGetWin32HandleInfoKHR -> IO b -> IO b
pokeCStruct "pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR
p MemoryGetWin32HandleInfoKHR{DeviceMemory
ExternalMemoryHandleTypeFlagBits
handleType :: ExternalMemoryHandleTypeFlagBits
memory :: DeviceMemory
$sel:handleType:MemoryGetWin32HandleInfoKHR :: MemoryGetWin32HandleInfoKHR -> ExternalMemoryHandleTypeFlagBits
$sel:memory:MemoryGetWin32HandleInfoKHR :: MemoryGetWin32HandleInfoKHR -> DeviceMemory
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR
p ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_GET_WIN32_HANDLE_INFO_KHR)
    ("pHandle" ::: Ptr HANDLE) -> HANDLE -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR
p ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
-> Int -> "pHandle" ::: Ptr HANDLE
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (HANDLE
forall a. Ptr a
nullPtr)
    Ptr DeviceMemory -> DeviceMemory -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR
p ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
-> Int -> Ptr DeviceMemory
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceMemory)) (DeviceMemory
memory)
    Ptr ExternalMemoryHandleTypeFlagBits
-> ExternalMemoryHandleTypeFlagBits -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR
p ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
-> Int -> Ptr ExternalMemoryHandleTypeFlagBits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ExternalMemoryHandleTypeFlagBits)) (ExternalMemoryHandleTypeFlagBits
handleType)
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
-> IO b -> IO b
pokeZeroCStruct "pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR
p ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_GET_WIN32_HANDLE_INFO_KHR)
    ("pHandle" ::: Ptr HANDLE) -> HANDLE -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR
p ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
-> Int -> "pHandle" ::: Ptr HANDLE
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (HANDLE
forall a. Ptr a
nullPtr)
    Ptr DeviceMemory -> DeviceMemory -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR
p ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
-> Int -> Ptr DeviceMemory
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceMemory)) (DeviceMemory
forall a. Zero a => a
zero)
    Ptr ExternalMemoryHandleTypeFlagBits
-> ExternalMemoryHandleTypeFlagBits -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR
p ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
-> Int -> Ptr ExternalMemoryHandleTypeFlagBits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ExternalMemoryHandleTypeFlagBits)) (ExternalMemoryHandleTypeFlagBits
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct MemoryGetWin32HandleInfoKHR where
  peekCStruct :: ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
-> IO MemoryGetWin32HandleInfoKHR
peekCStruct "pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR
p = do
    DeviceMemory
memory <- Ptr DeviceMemory -> IO DeviceMemory
forall a. Storable a => Ptr a -> IO a
peek @DeviceMemory (("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR
p ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
-> Int -> Ptr DeviceMemory
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceMemory))
    ExternalMemoryHandleTypeFlagBits
handleType <- Ptr ExternalMemoryHandleTypeFlagBits
-> IO ExternalMemoryHandleTypeFlagBits
forall a. Storable a => Ptr a -> IO a
peek @ExternalMemoryHandleTypeFlagBits (("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR
p ("pGetWin32HandleInfo" ::: Ptr MemoryGetWin32HandleInfoKHR)
-> Int -> Ptr ExternalMemoryHandleTypeFlagBits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ExternalMemoryHandleTypeFlagBits))
    MemoryGetWin32HandleInfoKHR -> IO MemoryGetWin32HandleInfoKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MemoryGetWin32HandleInfoKHR -> IO MemoryGetWin32HandleInfoKHR)
-> MemoryGetWin32HandleInfoKHR -> IO MemoryGetWin32HandleInfoKHR
forall a b. (a -> b) -> a -> b
$ DeviceMemory
-> ExternalMemoryHandleTypeFlagBits -> MemoryGetWin32HandleInfoKHR
MemoryGetWin32HandleInfoKHR
             DeviceMemory
memory ExternalMemoryHandleTypeFlagBits
handleType

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

instance Zero MemoryGetWin32HandleInfoKHR where
  zero :: MemoryGetWin32HandleInfoKHR
zero = DeviceMemory
-> ExternalMemoryHandleTypeFlagBits -> MemoryGetWin32HandleInfoKHR
MemoryGetWin32HandleInfoKHR
           DeviceMemory
forall a. Zero a => a
zero
           ExternalMemoryHandleTypeFlagBits
forall a. Zero a => a
zero


type KHR_EXTERNAL_MEMORY_WIN32_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_KHR_EXTERNAL_MEMORY_WIN32_SPEC_VERSION"
pattern KHR_EXTERNAL_MEMORY_WIN32_SPEC_VERSION :: forall a . Integral a => a
pattern $bKHR_EXTERNAL_MEMORY_WIN32_SPEC_VERSION :: a
$mKHR_EXTERNAL_MEMORY_WIN32_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
KHR_EXTERNAL_MEMORY_WIN32_SPEC_VERSION = 1


type KHR_EXTERNAL_MEMORY_WIN32_EXTENSION_NAME = "VK_KHR_external_memory_win32"

-- No documentation found for TopLevel "VK_KHR_EXTERNAL_MEMORY_WIN32_EXTENSION_NAME"
pattern KHR_EXTERNAL_MEMORY_WIN32_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bKHR_EXTERNAL_MEMORY_WIN32_EXTENSION_NAME :: a
$mKHR_EXTERNAL_MEMORY_WIN32_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
KHR_EXTERNAL_MEMORY_WIN32_EXTENSION_NAME = "VK_KHR_external_memory_win32"


type LPCWSTR = Ptr CWchar