{-# language CPP #-}
-- | = Name
--
-- VK_FUCHSIA_external_memory - device extension
--
-- == VK_FUCHSIA_external_memory
--
-- [__Name String__]
--     @VK_FUCHSIA_external_memory@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     365
--
-- [__Revision__]
--     1
--
-- [__Extension and Version Dependencies__]
--
--     -   Requires Vulkan 1.0
--
--     -   Requires @VK_KHR_external_memory_capabilities@
--
--     -   Requires @VK_KHR_external_memory@
--
-- [__Contact__]
--
--     -   John Rosasco
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_FUCHSIA_external_memory] @rosasco%0A<<Here describe the issue or question you have about the VK_FUCHSIA_external_memory extension>> >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2021-03-01
--
-- [__IP Status__]
--     No known IP claims.
--
-- [__Contributors__]
--
--     -   Craig Stout, Google
--
--     -   John Bauman, Google
--
--     -   John Rosasco, Google
--
-- == Description
--
-- Vulkan apps may wish to export or import device memory handles to or
-- from other logical devices, instances or APIs.
--
-- This memory sharing can eliminate copies of memory buffers when
-- different subsystems need to interoperate on them. Sharing memory
-- buffers may also facilitate a better distribution of processing workload
-- for more complex memory manipulation pipelines.
--
-- == New Commands
--
-- -   'getMemoryZirconHandleFUCHSIA'
--
-- -   'getMemoryZirconHandlePropertiesFUCHSIA'
--
-- == New Structures
--
-- -   'MemoryGetZirconHandleInfoFUCHSIA'
--
-- -   'MemoryZirconHandlePropertiesFUCHSIA'
--
-- -   Extending 'Vulkan.Core10.Memory.MemoryAllocateInfo':
--
--     -   'ImportMemoryZirconHandleInfoFUCHSIA'
--
-- == New Enum Constants
--
-- -   'FUCHSIA_EXTERNAL_MEMORY_EXTENSION_NAME'
--
-- -   'FUCHSIA_EXTERNAL_MEMORY_SPEC_VERSION'
--
-- -   Extending
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits':
--
--     -   'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_ZIRCON_VMO_BIT_FUCHSIA'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_IMPORT_MEMORY_ZIRCON_HANDLE_INFO_FUCHSIA'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_MEMORY_GET_ZIRCON_HANDLE_INFO_FUCHSIA'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_MEMORY_ZIRCON_HANDLE_PROPERTIES_FUCHSIA'
--
-- == Issues
--
-- See @VK_KHR_external_memory@ issues list for further information.
--
-- == Version History
--
-- -   Revision 1, 2021-03-01 (John Rosasco)
--
--     -   Initial draft
--
-- == See Also
--
-- 'ImportMemoryZirconHandleInfoFUCHSIA',
-- 'MemoryGetZirconHandleInfoFUCHSIA',
-- 'MemoryZirconHandlePropertiesFUCHSIA', 'getMemoryZirconHandleFUCHSIA',
-- 'getMemoryZirconHandlePropertiesFUCHSIA'
--
-- == Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_FUCHSIA_external_memory Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_FUCHSIA_external_memory  ( getMemoryZirconHandleFUCHSIA
                                                     , getMemoryZirconHandlePropertiesFUCHSIA
                                                     , ImportMemoryZirconHandleInfoFUCHSIA(..)
                                                     , MemoryZirconHandlePropertiesFUCHSIA(..)
                                                     , MemoryGetZirconHandleInfoFUCHSIA(..)
                                                     , FUCHSIA_EXTERNAL_MEMORY_SPEC_VERSION
                                                     , pattern FUCHSIA_EXTERNAL_MEMORY_SPEC_VERSION
                                                     , FUCHSIA_EXTERNAL_MEMORY_EXTENSION_NAME
                                                     , pattern FUCHSIA_EXTERNAL_MEMORY_EXTENSION_NAME
                                                     , Zx_handle_t
                                                     ) 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.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Vulkan.NamedType ((:::))
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkGetMemoryZirconHandleFUCHSIA))
import Vulkan.Dynamic (DeviceCmds(pVkGetMemoryZirconHandlePropertiesFUCHSIA))
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.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Extensions.VK_FUCHSIA_imagepipe_surface (Zx_handle_t)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_IMPORT_MEMORY_ZIRCON_HANDLE_INFO_FUCHSIA))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_MEMORY_GET_ZIRCON_HANDLE_INFO_FUCHSIA))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_MEMORY_ZIRCON_HANDLE_PROPERTIES_FUCHSIA))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Extensions.VK_FUCHSIA_imagepipe_surface (Zx_handle_t)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetMemoryZirconHandleFUCHSIA
  :: FunPtr (Ptr Device_T -> Ptr MemoryGetZirconHandleInfoFUCHSIA -> Ptr Zx_handle_t -> IO Result) -> Ptr Device_T -> Ptr MemoryGetZirconHandleInfoFUCHSIA -> Ptr Zx_handle_t -> IO Result

-- | vkGetMemoryZirconHandleFUCHSIA - Get a Zircon handle for an external
-- memory object
--
-- == 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_FUCHSIA_external_memory VK_FUCHSIA_external_memory>,
-- 'Vulkan.Core10.Handles.Device', 'MemoryGetZirconHandleInfoFUCHSIA'
getMemoryZirconHandleFUCHSIA :: forall io
                              . (MonadIO io)
                             => -- | @device@ is the 'Vulkan.Core10.Handles.Device'.
                                --
                                -- #VUID-vkGetMemoryZirconHandleFUCHSIA-device-parameter# @device@ /must/
                                -- be a valid 'Vulkan.Core10.Handles.Device' handle
                                Device
                             -> -- | @pGetZirconHandleInfo@ is a pointer to a
                                -- 'MemoryGetZirconHandleInfoFUCHSIA' structure.
                                --
                                -- #VUID-vkGetMemoryZirconHandleFUCHSIA-pGetZirconHandleInfo-parameter#
                                -- @pGetZirconHandleInfo@ /must/ be a valid pointer to a valid
                                -- 'MemoryGetZirconHandleInfoFUCHSIA' structure
                                MemoryGetZirconHandleInfoFUCHSIA
                             -> io (("zirconHandle" ::: Zx_handle_t))
getMemoryZirconHandleFUCHSIA :: Device
-> MemoryGetZirconHandleInfoFUCHSIA
-> io ("zirconHandle" ::: Zx_handle_t)
getMemoryZirconHandleFUCHSIA Device
device MemoryGetZirconHandleInfoFUCHSIA
getZirconHandleInfo = IO ("zirconHandle" ::: Zx_handle_t)
-> io ("zirconHandle" ::: Zx_handle_t)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ("zirconHandle" ::: Zx_handle_t)
 -> io ("zirconHandle" ::: Zx_handle_t))
-> (ContT
      ("zirconHandle" ::: Zx_handle_t)
      IO
      ("zirconHandle" ::: Zx_handle_t)
    -> IO ("zirconHandle" ::: Zx_handle_t))
-> ContT
     ("zirconHandle" ::: Zx_handle_t)
     IO
     ("zirconHandle" ::: Zx_handle_t)
-> io ("zirconHandle" ::: Zx_handle_t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  ("zirconHandle" ::: Zx_handle_t)
  IO
  ("zirconHandle" ::: Zx_handle_t)
-> IO ("zirconHandle" ::: Zx_handle_t)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   ("zirconHandle" ::: Zx_handle_t)
   IO
   ("zirconHandle" ::: Zx_handle_t)
 -> io ("zirconHandle" ::: Zx_handle_t))
-> ContT
     ("zirconHandle" ::: Zx_handle_t)
     IO
     ("zirconHandle" ::: Zx_handle_t)
-> io ("zirconHandle" ::: Zx_handle_t)
forall a b. (a -> b) -> a -> b
$ do
  let vkGetMemoryZirconHandleFUCHSIAPtr :: FunPtr
  (Ptr Device_T
   -> ("pGetZirconHandleInfo"
       ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
   -> ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
   -> IO Result)
vkGetMemoryZirconHandleFUCHSIAPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pGetZirconHandleInfo"
          ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
      -> ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
      -> IO Result)
pVkGetMemoryZirconHandleFUCHSIA (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT ("zirconHandle" ::: Zx_handle_t) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ("zirconHandle" ::: Zx_handle_t) IO ())
-> IO () -> ContT ("zirconHandle" ::: Zx_handle_t) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ("pGetZirconHandleInfo"
       ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
   -> ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
   -> IO Result)
vkGetMemoryZirconHandleFUCHSIAPtr FunPtr
  (Ptr Device_T
   -> ("pGetZirconHandleInfo"
       ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
   -> ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> ("pGetZirconHandleInfo"
          ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
      -> ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ("pGetZirconHandleInfo"
       ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
   -> ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
   -> 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 vkGetMemoryZirconHandleFUCHSIA is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetMemoryZirconHandleFUCHSIA' :: Ptr Device_T
-> ("pGetZirconHandleInfo"
    ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
-> IO Result
vkGetMemoryZirconHandleFUCHSIA' = FunPtr
  (Ptr Device_T
   -> ("pGetZirconHandleInfo"
       ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
   -> ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
   -> IO Result)
-> Ptr Device_T
-> ("pGetZirconHandleInfo"
    ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
-> IO Result
mkVkGetMemoryZirconHandleFUCHSIA FunPtr
  (Ptr Device_T
   -> ("pGetZirconHandleInfo"
       ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
   -> ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
   -> IO Result)
vkGetMemoryZirconHandleFUCHSIAPtr
  "pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
pGetZirconHandleInfo <- ((("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
  -> IO ("zirconHandle" ::: Zx_handle_t))
 -> IO ("zirconHandle" ::: Zx_handle_t))
-> ContT
     ("zirconHandle" ::: Zx_handle_t)
     IO
     ("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pGetZirconHandleInfo"
    ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
   -> IO ("zirconHandle" ::: Zx_handle_t))
  -> IO ("zirconHandle" ::: Zx_handle_t))
 -> ContT
      ("zirconHandle" ::: Zx_handle_t)
      IO
      ("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA))
-> ((("pGetZirconHandleInfo"
      ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
     -> IO ("zirconHandle" ::: Zx_handle_t))
    -> IO ("zirconHandle" ::: Zx_handle_t))
-> ContT
     ("zirconHandle" ::: Zx_handle_t)
     IO
     ("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
forall a b. (a -> b) -> a -> b
$ MemoryGetZirconHandleInfoFUCHSIA
-> (("pGetZirconHandleInfo"
     ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
    -> IO ("zirconHandle" ::: Zx_handle_t))
-> IO ("zirconHandle" ::: Zx_handle_t)
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (MemoryGetZirconHandleInfoFUCHSIA
getZirconHandleInfo)
  "pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t)
pPZirconHandle <- ((("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
  -> IO ("zirconHandle" ::: Zx_handle_t))
 -> IO ("zirconHandle" ::: Zx_handle_t))
-> ContT
     ("zirconHandle" ::: Zx_handle_t)
     IO
     ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
   -> IO ("zirconHandle" ::: Zx_handle_t))
  -> IO ("zirconHandle" ::: Zx_handle_t))
 -> ContT
      ("zirconHandle" ::: Zx_handle_t)
      IO
      ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t)))
-> ((("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
     -> IO ("zirconHandle" ::: Zx_handle_t))
    -> IO ("zirconHandle" ::: Zx_handle_t))
-> ContT
     ("zirconHandle" ::: Zx_handle_t)
     IO
     ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
forall a b. (a -> b) -> a -> b
$ IO ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
-> (("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
    -> IO ())
-> (("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
    -> IO ("zirconHandle" ::: Zx_handle_t))
-> IO ("zirconHandle" ::: Zx_handle_t)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int
-> IO ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
forall a. Int -> IO (Ptr a)
callocBytes @Zx_handle_t Int
4) ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t)) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT ("zirconHandle" ::: Zx_handle_t) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT ("zirconHandle" ::: Zx_handle_t) IO Result)
-> IO Result -> ContT ("zirconHandle" ::: Zx_handle_t) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetMemoryZirconHandleFUCHSIA" (Ptr Device_T
-> ("pGetZirconHandleInfo"
    ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
-> IO Result
vkGetMemoryZirconHandleFUCHSIA' (Device -> Ptr Device_T
deviceHandle (Device
device)) "pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
pGetZirconHandleInfo ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t)
pPZirconHandle))
  IO () -> ContT ("zirconHandle" ::: Zx_handle_t) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ("zirconHandle" ::: Zx_handle_t) IO ())
-> IO () -> ContT ("zirconHandle" ::: Zx_handle_t) 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))
  "zirconHandle" ::: Zx_handle_t
pZirconHandle <- IO ("zirconHandle" ::: Zx_handle_t)
-> ContT
     ("zirconHandle" ::: Zx_handle_t)
     IO
     ("zirconHandle" ::: Zx_handle_t)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("zirconHandle" ::: Zx_handle_t)
 -> ContT
      ("zirconHandle" ::: Zx_handle_t)
      IO
      ("zirconHandle" ::: Zx_handle_t))
-> IO ("zirconHandle" ::: Zx_handle_t)
-> ContT
     ("zirconHandle" ::: Zx_handle_t)
     IO
     ("zirconHandle" ::: Zx_handle_t)
forall a b. (a -> b) -> a -> b
$ ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
-> IO ("zirconHandle" ::: Zx_handle_t)
forall a. Storable a => Ptr a -> IO a
peek @Zx_handle_t "pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t)
pPZirconHandle
  ("zirconHandle" ::: Zx_handle_t)
-> ContT
     ("zirconHandle" ::: Zx_handle_t)
     IO
     ("zirconHandle" ::: Zx_handle_t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("zirconHandle" ::: Zx_handle_t)
 -> ContT
      ("zirconHandle" ::: Zx_handle_t)
      IO
      ("zirconHandle" ::: Zx_handle_t))
-> ("zirconHandle" ::: Zx_handle_t)
-> ContT
     ("zirconHandle" ::: Zx_handle_t)
     IO
     ("zirconHandle" ::: Zx_handle_t)
forall a b. (a -> b) -> a -> b
$ ("zirconHandle" ::: Zx_handle_t
pZirconHandle)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetMemoryZirconHandlePropertiesFUCHSIA
  :: FunPtr (Ptr Device_T -> ExternalMemoryHandleTypeFlagBits -> Zx_handle_t -> Ptr MemoryZirconHandlePropertiesFUCHSIA -> IO Result) -> Ptr Device_T -> ExternalMemoryHandleTypeFlagBits -> Zx_handle_t -> Ptr MemoryZirconHandlePropertiesFUCHSIA -> IO Result

-- | vkGetMemoryZirconHandlePropertiesFUCHSIA - Get a Zircon handle
-- properties for an external memory object
--
-- == 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_INVALID_EXTERNAL_HANDLE'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_FUCHSIA_external_memory VK_FUCHSIA_external_memory>,
-- 'Vulkan.Core10.Handles.Device',
-- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits',
-- 'MemoryZirconHandlePropertiesFUCHSIA'
getMemoryZirconHandlePropertiesFUCHSIA :: forall io
                                        . (MonadIO io)
                                       => -- | @device@ is the 'Vulkan.Core10.Handles.Device'.
                                          --
                                          -- #VUID-vkGetMemoryZirconHandlePropertiesFUCHSIA-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 @zirconHandle@
                                          --
                                          -- #VUID-vkGetMemoryZirconHandlePropertiesFUCHSIA-handleType-04773#
                                          -- @handleType@ /must/ be
                                          -- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_ZIRCON_VMO_BIT_FUCHSIA'
                                          --
                                          -- #VUID-vkGetMemoryZirconHandlePropertiesFUCHSIA-handleType-parameter#
                                          -- @handleType@ /must/ be a valid
                                          -- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
                                          -- value
                                          ExternalMemoryHandleTypeFlagBits
                                       -> -- | @zirconHandle@ is a @zx_handle_t@ (Zircon) handle to the external
                                          -- resource.
                                          --
                                          -- #VUID-vkGetMemoryZirconHandlePropertiesFUCHSIA-zirconHandle-04774#
                                          -- @zirconHandle@ must reference a valid VMO
                                          ("zirconHandle" ::: Zx_handle_t)
                                       -> io (MemoryZirconHandlePropertiesFUCHSIA)
getMemoryZirconHandlePropertiesFUCHSIA :: Device
-> ExternalMemoryHandleTypeFlagBits
-> ("zirconHandle" ::: Zx_handle_t)
-> io MemoryZirconHandlePropertiesFUCHSIA
getMemoryZirconHandlePropertiesFUCHSIA Device
device ExternalMemoryHandleTypeFlagBits
handleType "zirconHandle" ::: Zx_handle_t
zirconHandle = IO MemoryZirconHandlePropertiesFUCHSIA
-> io MemoryZirconHandlePropertiesFUCHSIA
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MemoryZirconHandlePropertiesFUCHSIA
 -> io MemoryZirconHandlePropertiesFUCHSIA)
-> (ContT
      MemoryZirconHandlePropertiesFUCHSIA
      IO
      MemoryZirconHandlePropertiesFUCHSIA
    -> IO MemoryZirconHandlePropertiesFUCHSIA)
-> ContT
     MemoryZirconHandlePropertiesFUCHSIA
     IO
     MemoryZirconHandlePropertiesFUCHSIA
-> io MemoryZirconHandlePropertiesFUCHSIA
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  MemoryZirconHandlePropertiesFUCHSIA
  IO
  MemoryZirconHandlePropertiesFUCHSIA
-> IO MemoryZirconHandlePropertiesFUCHSIA
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   MemoryZirconHandlePropertiesFUCHSIA
   IO
   MemoryZirconHandlePropertiesFUCHSIA
 -> io MemoryZirconHandlePropertiesFUCHSIA)
-> ContT
     MemoryZirconHandlePropertiesFUCHSIA
     IO
     MemoryZirconHandlePropertiesFUCHSIA
-> io MemoryZirconHandlePropertiesFUCHSIA
forall a b. (a -> b) -> a -> b
$ do
  let vkGetMemoryZirconHandlePropertiesFUCHSIAPtr :: FunPtr
  (Ptr Device_T
   -> ExternalMemoryHandleTypeFlagBits
   -> ("zirconHandle" ::: Zx_handle_t)
   -> ("pMemoryZirconHandleProperties"
       ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
   -> IO Result)
vkGetMemoryZirconHandlePropertiesFUCHSIAPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ExternalMemoryHandleTypeFlagBits
      -> ("zirconHandle" ::: Zx_handle_t)
      -> ("pMemoryZirconHandleProperties"
          ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
      -> IO Result)
pVkGetMemoryZirconHandlePropertiesFUCHSIA (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT MemoryZirconHandlePropertiesFUCHSIA IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT MemoryZirconHandlePropertiesFUCHSIA IO ())
-> IO () -> ContT MemoryZirconHandlePropertiesFUCHSIA IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ExternalMemoryHandleTypeFlagBits
   -> ("zirconHandle" ::: Zx_handle_t)
   -> ("pMemoryZirconHandleProperties"
       ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
   -> IO Result)
vkGetMemoryZirconHandlePropertiesFUCHSIAPtr FunPtr
  (Ptr Device_T
   -> ExternalMemoryHandleTypeFlagBits
   -> ("zirconHandle" ::: Zx_handle_t)
   -> ("pMemoryZirconHandleProperties"
       ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> ExternalMemoryHandleTypeFlagBits
      -> ("zirconHandle" ::: Zx_handle_t)
      -> ("pMemoryZirconHandleProperties"
          ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ExternalMemoryHandleTypeFlagBits
   -> ("zirconHandle" ::: Zx_handle_t)
   -> ("pMemoryZirconHandleProperties"
       ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
   -> 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 vkGetMemoryZirconHandlePropertiesFUCHSIA is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetMemoryZirconHandlePropertiesFUCHSIA' :: Ptr Device_T
-> ExternalMemoryHandleTypeFlagBits
-> ("zirconHandle" ::: Zx_handle_t)
-> ("pMemoryZirconHandleProperties"
    ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> IO Result
vkGetMemoryZirconHandlePropertiesFUCHSIA' = FunPtr
  (Ptr Device_T
   -> ExternalMemoryHandleTypeFlagBits
   -> ("zirconHandle" ::: Zx_handle_t)
   -> ("pMemoryZirconHandleProperties"
       ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
   -> IO Result)
-> Ptr Device_T
-> ExternalMemoryHandleTypeFlagBits
-> ("zirconHandle" ::: Zx_handle_t)
-> ("pMemoryZirconHandleProperties"
    ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> IO Result
mkVkGetMemoryZirconHandlePropertiesFUCHSIA FunPtr
  (Ptr Device_T
   -> ExternalMemoryHandleTypeFlagBits
   -> ("zirconHandle" ::: Zx_handle_t)
   -> ("pMemoryZirconHandleProperties"
       ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
   -> IO Result)
vkGetMemoryZirconHandlePropertiesFUCHSIAPtr
  "pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
pPMemoryZirconHandleProperties <- ((("pMemoryZirconHandleProperties"
   ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
  -> IO MemoryZirconHandlePropertiesFUCHSIA)
 -> IO MemoryZirconHandlePropertiesFUCHSIA)
-> ContT
     MemoryZirconHandlePropertiesFUCHSIA
     IO
     ("pMemoryZirconHandleProperties"
      ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct MemoryZirconHandlePropertiesFUCHSIA =>
(("pMemoryZirconHandleProperties"
  ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
 -> IO b)
-> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @MemoryZirconHandlePropertiesFUCHSIA)
  Result
r <- IO Result -> ContT MemoryZirconHandlePropertiesFUCHSIA IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT MemoryZirconHandlePropertiesFUCHSIA IO Result)
-> IO Result -> ContT MemoryZirconHandlePropertiesFUCHSIA IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetMemoryZirconHandlePropertiesFUCHSIA" (Ptr Device_T
-> ExternalMemoryHandleTypeFlagBits
-> ("zirconHandle" ::: Zx_handle_t)
-> ("pMemoryZirconHandleProperties"
    ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> IO Result
vkGetMemoryZirconHandlePropertiesFUCHSIA' (Device -> Ptr Device_T
deviceHandle (Device
device)) (ExternalMemoryHandleTypeFlagBits
handleType) ("zirconHandle" ::: Zx_handle_t
zirconHandle) ("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
pPMemoryZirconHandleProperties))
  IO () -> ContT MemoryZirconHandlePropertiesFUCHSIA IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT MemoryZirconHandlePropertiesFUCHSIA IO ())
-> IO () -> ContT MemoryZirconHandlePropertiesFUCHSIA 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))
  MemoryZirconHandlePropertiesFUCHSIA
pMemoryZirconHandleProperties <- IO MemoryZirconHandlePropertiesFUCHSIA
-> ContT
     MemoryZirconHandlePropertiesFUCHSIA
     IO
     MemoryZirconHandlePropertiesFUCHSIA
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO MemoryZirconHandlePropertiesFUCHSIA
 -> ContT
      MemoryZirconHandlePropertiesFUCHSIA
      IO
      MemoryZirconHandlePropertiesFUCHSIA)
-> IO MemoryZirconHandlePropertiesFUCHSIA
-> ContT
     MemoryZirconHandlePropertiesFUCHSIA
     IO
     MemoryZirconHandlePropertiesFUCHSIA
forall a b. (a -> b) -> a -> b
$ ("pMemoryZirconHandleProperties"
 ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> IO MemoryZirconHandlePropertiesFUCHSIA
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @MemoryZirconHandlePropertiesFUCHSIA "pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
pPMemoryZirconHandleProperties
  MemoryZirconHandlePropertiesFUCHSIA
-> ContT
     MemoryZirconHandlePropertiesFUCHSIA
     IO
     MemoryZirconHandlePropertiesFUCHSIA
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MemoryZirconHandlePropertiesFUCHSIA
 -> ContT
      MemoryZirconHandlePropertiesFUCHSIA
      IO
      MemoryZirconHandlePropertiesFUCHSIA)
-> MemoryZirconHandlePropertiesFUCHSIA
-> ContT
     MemoryZirconHandlePropertiesFUCHSIA
     IO
     MemoryZirconHandlePropertiesFUCHSIA
forall a b. (a -> b) -> a -> b
$ (MemoryZirconHandlePropertiesFUCHSIA
pMemoryZirconHandleProperties)


-- | VkImportMemoryZirconHandleInfoFUCHSIA - Structure specifying import
-- parameters for Zircon handle to external memory
--
-- == Valid Usage
--
-- -   #VUID-VkImportMemoryZirconHandleInfoFUCHSIA-handleType-04771#
--     @handleType@ /must/ be
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_ZIRCON_VMO_BIT_FUCHSIA'
--
-- -   #VUID-VkImportMemoryZirconHandleInfoFUCHSIA-handle-04772# @handle@
--     must be a valid VMO handle
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkImportMemoryZirconHandleInfoFUCHSIA-sType-sType# @sType@
--     /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_IMPORT_MEMORY_ZIRCON_HANDLE_INFO_FUCHSIA'
--
-- -   #VUID-VkImportMemoryZirconHandleInfoFUCHSIA-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_FUCHSIA_external_memory VK_FUCHSIA_external_memory>,
-- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data ImportMemoryZirconHandleInfoFUCHSIA = ImportMemoryZirconHandleInfoFUCHSIA
  { -- | @handleType@ is a
    -- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
    -- value specifying the type of @handle@.
    ImportMemoryZirconHandleInfoFUCHSIA
-> ExternalMemoryHandleTypeFlagBits
handleType :: ExternalMemoryHandleTypeFlagBits
  , -- | @handle@ is a @zx_handle_t@ (Zircon) handle to the external memory.
    ImportMemoryZirconHandleInfoFUCHSIA
-> "zirconHandle" ::: Zx_handle_t
handle :: Zx_handle_t
  }
  deriving (Typeable, ImportMemoryZirconHandleInfoFUCHSIA
-> ImportMemoryZirconHandleInfoFUCHSIA -> Bool
(ImportMemoryZirconHandleInfoFUCHSIA
 -> ImportMemoryZirconHandleInfoFUCHSIA -> Bool)
-> (ImportMemoryZirconHandleInfoFUCHSIA
    -> ImportMemoryZirconHandleInfoFUCHSIA -> Bool)
-> Eq ImportMemoryZirconHandleInfoFUCHSIA
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportMemoryZirconHandleInfoFUCHSIA
-> ImportMemoryZirconHandleInfoFUCHSIA -> Bool
$c/= :: ImportMemoryZirconHandleInfoFUCHSIA
-> ImportMemoryZirconHandleInfoFUCHSIA -> Bool
== :: ImportMemoryZirconHandleInfoFUCHSIA
-> ImportMemoryZirconHandleInfoFUCHSIA -> Bool
$c== :: ImportMemoryZirconHandleInfoFUCHSIA
-> ImportMemoryZirconHandleInfoFUCHSIA -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ImportMemoryZirconHandleInfoFUCHSIA)
#endif
deriving instance Show ImportMemoryZirconHandleInfoFUCHSIA

instance ToCStruct ImportMemoryZirconHandleInfoFUCHSIA where
  withCStruct :: ImportMemoryZirconHandleInfoFUCHSIA
-> (Ptr ImportMemoryZirconHandleInfoFUCHSIA -> IO b) -> IO b
withCStruct ImportMemoryZirconHandleInfoFUCHSIA
x Ptr ImportMemoryZirconHandleInfoFUCHSIA -> IO b
f = Int -> (Ptr ImportMemoryZirconHandleInfoFUCHSIA -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr ImportMemoryZirconHandleInfoFUCHSIA -> IO b) -> IO b)
-> (Ptr ImportMemoryZirconHandleInfoFUCHSIA -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr ImportMemoryZirconHandleInfoFUCHSIA
p -> Ptr ImportMemoryZirconHandleInfoFUCHSIA
-> ImportMemoryZirconHandleInfoFUCHSIA -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ImportMemoryZirconHandleInfoFUCHSIA
p ImportMemoryZirconHandleInfoFUCHSIA
x (Ptr ImportMemoryZirconHandleInfoFUCHSIA -> IO b
f Ptr ImportMemoryZirconHandleInfoFUCHSIA
p)
  pokeCStruct :: Ptr ImportMemoryZirconHandleInfoFUCHSIA
-> ImportMemoryZirconHandleInfoFUCHSIA -> IO b -> IO b
pokeCStruct Ptr ImportMemoryZirconHandleInfoFUCHSIA
p ImportMemoryZirconHandleInfoFUCHSIA{"zirconHandle" ::: Zx_handle_t
ExternalMemoryHandleTypeFlagBits
handle :: "zirconHandle" ::: Zx_handle_t
handleType :: ExternalMemoryHandleTypeFlagBits
$sel:handle:ImportMemoryZirconHandleInfoFUCHSIA :: ImportMemoryZirconHandleInfoFUCHSIA
-> "zirconHandle" ::: Zx_handle_t
$sel:handleType:ImportMemoryZirconHandleInfoFUCHSIA :: ImportMemoryZirconHandleInfoFUCHSIA
-> ExternalMemoryHandleTypeFlagBits
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryZirconHandleInfoFUCHSIA
p Ptr ImportMemoryZirconHandleInfoFUCHSIA -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMPORT_MEMORY_ZIRCON_HANDLE_INFO_FUCHSIA)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryZirconHandleInfoFUCHSIA
p Ptr ImportMemoryZirconHandleInfoFUCHSIA -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ExternalMemoryHandleTypeFlagBits
-> ExternalMemoryHandleTypeFlagBits -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryZirconHandleInfoFUCHSIA
p Ptr ImportMemoryZirconHandleInfoFUCHSIA
-> Int -> Ptr ExternalMemoryHandleTypeFlagBits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ExternalMemoryHandleTypeFlagBits)) (ExternalMemoryHandleTypeFlagBits
handleType)
    ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
-> ("zirconHandle" ::: Zx_handle_t) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryZirconHandleInfoFUCHSIA
p Ptr ImportMemoryZirconHandleInfoFUCHSIA
-> Int -> "pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Zx_handle_t)) ("zirconHandle" ::: Zx_handle_t
handle)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr ImportMemoryZirconHandleInfoFUCHSIA -> IO b -> IO b
pokeZeroCStruct Ptr ImportMemoryZirconHandleInfoFUCHSIA
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryZirconHandleInfoFUCHSIA
p Ptr ImportMemoryZirconHandleInfoFUCHSIA -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMPORT_MEMORY_ZIRCON_HANDLE_INFO_FUCHSIA)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryZirconHandleInfoFUCHSIA
p Ptr ImportMemoryZirconHandleInfoFUCHSIA -> 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 ImportMemoryZirconHandleInfoFUCHSIA where
  peekCStruct :: Ptr ImportMemoryZirconHandleInfoFUCHSIA
-> IO ImportMemoryZirconHandleInfoFUCHSIA
peekCStruct Ptr ImportMemoryZirconHandleInfoFUCHSIA
p = do
    ExternalMemoryHandleTypeFlagBits
handleType <- Ptr ExternalMemoryHandleTypeFlagBits
-> IO ExternalMemoryHandleTypeFlagBits
forall a. Storable a => Ptr a -> IO a
peek @ExternalMemoryHandleTypeFlagBits ((Ptr ImportMemoryZirconHandleInfoFUCHSIA
p Ptr ImportMemoryZirconHandleInfoFUCHSIA
-> Int -> Ptr ExternalMemoryHandleTypeFlagBits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ExternalMemoryHandleTypeFlagBits))
    "zirconHandle" ::: Zx_handle_t
handle <- ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
-> IO ("zirconHandle" ::: Zx_handle_t)
forall a. Storable a => Ptr a -> IO a
peek @Zx_handle_t ((Ptr ImportMemoryZirconHandleInfoFUCHSIA
p Ptr ImportMemoryZirconHandleInfoFUCHSIA
-> Int -> "pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Zx_handle_t))
    ImportMemoryZirconHandleInfoFUCHSIA
-> IO ImportMemoryZirconHandleInfoFUCHSIA
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ImportMemoryZirconHandleInfoFUCHSIA
 -> IO ImportMemoryZirconHandleInfoFUCHSIA)
-> ImportMemoryZirconHandleInfoFUCHSIA
-> IO ImportMemoryZirconHandleInfoFUCHSIA
forall a b. (a -> b) -> a -> b
$ ExternalMemoryHandleTypeFlagBits
-> ("zirconHandle" ::: Zx_handle_t)
-> ImportMemoryZirconHandleInfoFUCHSIA
ImportMemoryZirconHandleInfoFUCHSIA
             ExternalMemoryHandleTypeFlagBits
handleType "zirconHandle" ::: Zx_handle_t
handle

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

instance Zero ImportMemoryZirconHandleInfoFUCHSIA where
  zero :: ImportMemoryZirconHandleInfoFUCHSIA
zero = ExternalMemoryHandleTypeFlagBits
-> ("zirconHandle" ::: Zx_handle_t)
-> ImportMemoryZirconHandleInfoFUCHSIA
ImportMemoryZirconHandleInfoFUCHSIA
           ExternalMemoryHandleTypeFlagBits
forall a. Zero a => a
zero
           "zirconHandle" ::: Zx_handle_t
forall a. Zero a => a
zero


-- | VkMemoryZirconHandlePropertiesFUCHSIA - Structure specifying Zircon
-- handle compatible external memory
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_FUCHSIA_external_memory VK_FUCHSIA_external_memory>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'getMemoryZirconHandlePropertiesFUCHSIA'
data MemoryZirconHandlePropertiesFUCHSIA = MemoryZirconHandlePropertiesFUCHSIA
  { -- | @memoryTypeBits@ a bitmask containing one bit set for every memory type
    -- which the specified handle can be imported as.
    MemoryZirconHandlePropertiesFUCHSIA
-> "zirconHandle" ::: Zx_handle_t
memoryTypeBits :: Word32 }
  deriving (Typeable, MemoryZirconHandlePropertiesFUCHSIA
-> MemoryZirconHandlePropertiesFUCHSIA -> Bool
(MemoryZirconHandlePropertiesFUCHSIA
 -> MemoryZirconHandlePropertiesFUCHSIA -> Bool)
-> (MemoryZirconHandlePropertiesFUCHSIA
    -> MemoryZirconHandlePropertiesFUCHSIA -> Bool)
-> Eq MemoryZirconHandlePropertiesFUCHSIA
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemoryZirconHandlePropertiesFUCHSIA
-> MemoryZirconHandlePropertiesFUCHSIA -> Bool
$c/= :: MemoryZirconHandlePropertiesFUCHSIA
-> MemoryZirconHandlePropertiesFUCHSIA -> Bool
== :: MemoryZirconHandlePropertiesFUCHSIA
-> MemoryZirconHandlePropertiesFUCHSIA -> Bool
$c== :: MemoryZirconHandlePropertiesFUCHSIA
-> MemoryZirconHandlePropertiesFUCHSIA -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (MemoryZirconHandlePropertiesFUCHSIA)
#endif
deriving instance Show MemoryZirconHandlePropertiesFUCHSIA

instance ToCStruct MemoryZirconHandlePropertiesFUCHSIA where
  withCStruct :: MemoryZirconHandlePropertiesFUCHSIA
-> (("pMemoryZirconHandleProperties"
     ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
    -> IO b)
-> IO b
withCStruct MemoryZirconHandlePropertiesFUCHSIA
x ("pMemoryZirconHandleProperties"
 ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> IO b
f = Int
-> (("pMemoryZirconHandleProperties"
     ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
    -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((("pMemoryZirconHandleProperties"
   ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
  -> IO b)
 -> IO b)
-> (("pMemoryZirconHandleProperties"
     ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
    -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \"pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
p -> ("pMemoryZirconHandleProperties"
 ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> MemoryZirconHandlePropertiesFUCHSIA -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
p MemoryZirconHandlePropertiesFUCHSIA
x (("pMemoryZirconHandleProperties"
 ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> IO b
f "pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
p)
  pokeCStruct :: ("pMemoryZirconHandleProperties"
 ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> MemoryZirconHandlePropertiesFUCHSIA -> IO b -> IO b
pokeCStruct "pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
p MemoryZirconHandlePropertiesFUCHSIA{"zirconHandle" ::: Zx_handle_t
memoryTypeBits :: "zirconHandle" ::: Zx_handle_t
$sel:memoryTypeBits:MemoryZirconHandlePropertiesFUCHSIA :: MemoryZirconHandlePropertiesFUCHSIA
-> "zirconHandle" ::: Zx_handle_t
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
p ("pMemoryZirconHandleProperties"
 ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_ZIRCON_HANDLE_PROPERTIES_FUCHSIA)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
p ("pMemoryZirconHandleProperties"
 ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
-> ("zirconHandle" ::: Zx_handle_t) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
p ("pMemoryZirconHandleProperties"
 ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> Int -> "pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) ("zirconHandle" ::: Zx_handle_t
memoryTypeBits)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: ("pMemoryZirconHandleProperties"
 ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> IO b -> IO b
pokeZeroCStruct "pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
p ("pMemoryZirconHandleProperties"
 ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_ZIRCON_HANDLE_PROPERTIES_FUCHSIA)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
p ("pMemoryZirconHandleProperties"
 ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
-> ("zirconHandle" ::: Zx_handle_t) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
p ("pMemoryZirconHandleProperties"
 ::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> Int -> "pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) ("zirconHandle" ::: Zx_handle_t
forall a. Zero a => a
zero)
    IO b
f

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

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

instance Zero MemoryZirconHandlePropertiesFUCHSIA where
  zero :: MemoryZirconHandlePropertiesFUCHSIA
zero = ("zirconHandle" ::: Zx_handle_t)
-> MemoryZirconHandlePropertiesFUCHSIA
MemoryZirconHandlePropertiesFUCHSIA
           "zirconHandle" ::: Zx_handle_t
forall a. Zero a => a
zero


-- | VkMemoryGetZirconHandleInfoFUCHSIA - Structure specifying export
-- parameters for Zircon handle to device memory
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_FUCHSIA_external_memory VK_FUCHSIA_external_memory>,
-- 'Vulkan.Core10.Handles.DeviceMemory',
-- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'getMemoryZirconHandleFUCHSIA'
data MemoryGetZirconHandleInfoFUCHSIA = MemoryGetZirconHandleInfoFUCHSIA
  { -- | @memory@ the 'Vulkan.Core10.Handles.DeviceMemory' being exported.
    --
    -- #VUID-VkMemoryGetZirconHandleInfoFUCHSIA-memory-parameter# @memory@
    -- /must/ be a valid 'Vulkan.Core10.Handles.DeviceMemory' handle
    MemoryGetZirconHandleInfoFUCHSIA -> DeviceMemory
memory :: DeviceMemory
  , -- | @handleType@ is a
    -- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
    -- value specifying the type of the handle pointed to by
    -- 'getMemoryZirconHandleFUCHSIA'::@pZirconHandle@.
    --
    -- #VUID-VkMemoryGetZirconHandleInfoFUCHSIA-handleType-04775# @handleType@
    -- /must/ be
    -- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_ZIRCON_VMO_BIT_FUCHSIA'
    --
    -- #VUID-VkMemoryGetZirconHandleInfoFUCHSIA-handleType-04776# @handleType@
    -- /must/ have been included in the @handleTypes@ field of the
    -- 'Vulkan.Core11.Promoted_From_VK_KHR_external_memory.ExportMemoryAllocateInfo'
    -- structure when the external memory was allocated
    --
    -- #VUID-VkMemoryGetZirconHandleInfoFUCHSIA-handleType-parameter#
    -- @handleType@ /must/ be a valid
    -- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
    -- value
    MemoryGetZirconHandleInfoFUCHSIA
-> ExternalMemoryHandleTypeFlagBits
handleType :: ExternalMemoryHandleTypeFlagBits
  }
  deriving (Typeable, MemoryGetZirconHandleInfoFUCHSIA
-> MemoryGetZirconHandleInfoFUCHSIA -> Bool
(MemoryGetZirconHandleInfoFUCHSIA
 -> MemoryGetZirconHandleInfoFUCHSIA -> Bool)
-> (MemoryGetZirconHandleInfoFUCHSIA
    -> MemoryGetZirconHandleInfoFUCHSIA -> Bool)
-> Eq MemoryGetZirconHandleInfoFUCHSIA
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemoryGetZirconHandleInfoFUCHSIA
-> MemoryGetZirconHandleInfoFUCHSIA -> Bool
$c/= :: MemoryGetZirconHandleInfoFUCHSIA
-> MemoryGetZirconHandleInfoFUCHSIA -> Bool
== :: MemoryGetZirconHandleInfoFUCHSIA
-> MemoryGetZirconHandleInfoFUCHSIA -> Bool
$c== :: MemoryGetZirconHandleInfoFUCHSIA
-> MemoryGetZirconHandleInfoFUCHSIA -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (MemoryGetZirconHandleInfoFUCHSIA)
#endif
deriving instance Show MemoryGetZirconHandleInfoFUCHSIA

instance ToCStruct MemoryGetZirconHandleInfoFUCHSIA where
  withCStruct :: MemoryGetZirconHandleInfoFUCHSIA
-> (("pGetZirconHandleInfo"
     ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
    -> IO b)
-> IO b
withCStruct MemoryGetZirconHandleInfoFUCHSIA
x ("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> IO b
f = Int
-> (("pGetZirconHandleInfo"
     ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
    -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
  -> IO b)
 -> IO b)
-> (("pGetZirconHandleInfo"
     ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
    -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \"pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
p -> ("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> MemoryGetZirconHandleInfoFUCHSIA -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
p MemoryGetZirconHandleInfoFUCHSIA
x (("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> IO b
f "pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
p)
  pokeCStruct :: ("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> MemoryGetZirconHandleInfoFUCHSIA -> IO b -> IO b
pokeCStruct "pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
p MemoryGetZirconHandleInfoFUCHSIA{DeviceMemory
ExternalMemoryHandleTypeFlagBits
handleType :: ExternalMemoryHandleTypeFlagBits
memory :: DeviceMemory
$sel:handleType:MemoryGetZirconHandleInfoFUCHSIA :: MemoryGetZirconHandleInfoFUCHSIA
-> ExternalMemoryHandleTypeFlagBits
$sel:memory:MemoryGetZirconHandleInfoFUCHSIA :: MemoryGetZirconHandleInfoFUCHSIA -> DeviceMemory
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
p ("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_GET_ZIRCON_HANDLE_INFO_FUCHSIA)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
p ("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr DeviceMemory -> DeviceMemory -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
p ("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> 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 (("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
p ("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> 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 :: ("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> IO b -> IO b
pokeZeroCStruct "pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
p ("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_GET_ZIRCON_HANDLE_INFO_FUCHSIA)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
p ("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr DeviceMemory -> DeviceMemory -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
p ("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> 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 (("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
p ("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> 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 MemoryGetZirconHandleInfoFUCHSIA where
  peekCStruct :: ("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> IO MemoryGetZirconHandleInfoFUCHSIA
peekCStruct "pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
p = do
    DeviceMemory
memory <- Ptr DeviceMemory -> IO DeviceMemory
forall a. Storable a => Ptr a -> IO a
peek @DeviceMemory (("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
p ("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> 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 (("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
p ("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> Int -> Ptr ExternalMemoryHandleTypeFlagBits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ExternalMemoryHandleTypeFlagBits))
    MemoryGetZirconHandleInfoFUCHSIA
-> IO MemoryGetZirconHandleInfoFUCHSIA
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MemoryGetZirconHandleInfoFUCHSIA
 -> IO MemoryGetZirconHandleInfoFUCHSIA)
-> MemoryGetZirconHandleInfoFUCHSIA
-> IO MemoryGetZirconHandleInfoFUCHSIA
forall a b. (a -> b) -> a -> b
$ DeviceMemory
-> ExternalMemoryHandleTypeFlagBits
-> MemoryGetZirconHandleInfoFUCHSIA
MemoryGetZirconHandleInfoFUCHSIA
             DeviceMemory
memory ExternalMemoryHandleTypeFlagBits
handleType

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

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


type FUCHSIA_EXTERNAL_MEMORY_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_FUCHSIA_EXTERNAL_MEMORY_SPEC_VERSION"
pattern FUCHSIA_EXTERNAL_MEMORY_SPEC_VERSION :: forall a . Integral a => a
pattern $bFUCHSIA_EXTERNAL_MEMORY_SPEC_VERSION :: a
$mFUCHSIA_EXTERNAL_MEMORY_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
FUCHSIA_EXTERNAL_MEMORY_SPEC_VERSION = 1


type FUCHSIA_EXTERNAL_MEMORY_EXTENSION_NAME = "VK_FUCHSIA_external_memory"

-- No documentation found for TopLevel "VK_FUCHSIA_EXTERNAL_MEMORY_EXTENSION_NAME"
pattern FUCHSIA_EXTERNAL_MEMORY_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bFUCHSIA_EXTERNAL_MEMORY_EXTENSION_NAME :: a
$mFUCHSIA_EXTERNAL_MEMORY_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
FUCHSIA_EXTERNAL_MEMORY_EXTENSION_NAME = "VK_FUCHSIA_external_memory"