{-# language CPP #-}
-- | = Name
--
-- VK_NVX_image_view_handle - device extension
--
-- == VK_NVX_image_view_handle
--
-- [__Name String__]
--     @VK_NVX_image_view_handle@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     31
--
-- [__Revision__]
--     2
--
-- [__Ratification Status__]
--     Not ratified
--
-- [__Extension and Version Dependencies__; __Contact__]
--
--     -   Eric Werness
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_NVX_image_view_handle] @ewerness-nv%0A*Here describe the issue or question you have about the VK_NVX_image_view_handle extension* >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2020-04-03
--
-- [__Contributors__]
--
--     -   Eric Werness, NVIDIA
--
--     -   Jeff Bolz, NVIDIA
--
--     -   Daniel Koch, NVIDIA
--
-- == Description
--
-- This extension allows applications to query an opaque handle from an
-- image view for use as a sampled image or storage image. This provides no
-- direct functionality itself.
--
-- == New Commands
--
-- -   'getImageViewAddressNVX'
--
-- -   'getImageViewHandleNVX'
--
-- == New Structures
--
-- -   'ImageViewAddressPropertiesNVX'
--
-- -   'ImageViewHandleInfoNVX'
--
-- == New Enum Constants
--
-- -   'NVX_IMAGE_VIEW_HANDLE_EXTENSION_NAME'
--
-- -   'NVX_IMAGE_VIEW_HANDLE_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_IMAGE_VIEW_ADDRESS_PROPERTIES_NVX'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_IMAGE_VIEW_HANDLE_INFO_NVX'
--
-- == Version History
--
-- -   Revision 2, 2020-04-03 (Piers Daniell)
--
--     -   Add 'getImageViewAddressNVX'
--
-- -   Revision 1, 2018-12-07 (Eric Werness)
--
--     -   Internal revisions
--
-- == See Also
--
-- 'ImageViewAddressPropertiesNVX', 'ImageViewHandleInfoNVX',
-- 'getImageViewAddressNVX', 'getImageViewHandleNVX'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_NVX_image_view_handle Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_NVX_image_view_handle  ( getImageViewHandleNVX
                                                   , getImageViewAddressNVX
                                                   , ImageViewHandleInfoNVX(..)
                                                   , ImageViewAddressPropertiesNVX(..)
                                                   , NVX_IMAGE_VIEW_HANDLE_SPEC_VERSION
                                                   , pattern NVX_IMAGE_VIEW_HANDLE_SPEC_VERSION
                                                   , NVX_IMAGE_VIEW_HANDLE_EXTENSION_NAME
                                                   , pattern NVX_IMAGE_VIEW_HANDLE_EXTENSION_NAME
                                                   ) where

import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytes)
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.Core10.Enums.DescriptorType (DescriptorType)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Core10.FundamentalTypes (DeviceAddress)
import Vulkan.Dynamic (DeviceCmds(pVkGetImageViewAddressNVX))
import Vulkan.Dynamic (DeviceCmds(pVkGetImageViewHandleNVX))
import Vulkan.Core10.FundamentalTypes (DeviceSize)
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Core10.Handles (ImageView)
import Vulkan.Core10.Handles (ImageView(..))
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Handles (Sampler)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_IMAGE_VIEW_ADDRESS_PROPERTIES_NVX))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_IMAGE_VIEW_HANDLE_INFO_NVX))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetImageViewHandleNVX
  :: FunPtr (Ptr Device_T -> Ptr ImageViewHandleInfoNVX -> IO Word32) -> Ptr Device_T -> Ptr ImageViewHandleInfoNVX -> IO Word32

-- | vkGetImageViewHandleNVX - Get the handle for an image view for a
-- specific descriptor type
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NVX_image_view_handle VK_NVX_image_view_handle>,
-- 'Vulkan.Core10.Handles.Device', 'ImageViewHandleInfoNVX'
getImageViewHandleNVX :: forall io
                       . (MonadIO io)
                      => -- | @device@ is the logical device that owns the image view.
                         --
                         -- #VUID-vkGetImageViewHandleNVX-device-parameter# @device@ /must/ be a
                         -- valid 'Vulkan.Core10.Handles.Device' handle
                         Device
                      -> -- | @pInfo@ describes the image view to query and type of handle.
                         --
                         -- #VUID-vkGetImageViewHandleNVX-pInfo-parameter# @pInfo@ /must/ be a valid
                         -- pointer to a valid 'ImageViewHandleInfoNVX' structure
                         ImageViewHandleInfoNVX
                      -> io (Word32)
getImageViewHandleNVX :: forall (io :: * -> *).
MonadIO io =>
Device -> ImageViewHandleInfoNVX -> io Word32
getImageViewHandleNVX Device
device ImageViewHandleInfoNVX
info = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
  let vkGetImageViewHandleNVXPtr :: FunPtr
  (Ptr Device_T
   -> ("pInfo" ::: Ptr ImageViewHandleInfoNVX) -> IO Word32)
vkGetImageViewHandleNVXPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pInfo" ::: Ptr ImageViewHandleInfoNVX) -> IO Word32)
pVkGetImageViewHandleNVX (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ("pInfo" ::: Ptr ImageViewHandleInfoNVX) -> IO Word32)
vkGetImageViewHandleNVXPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetImageViewHandleNVX is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkGetImageViewHandleNVX' :: Ptr Device_T
-> ("pInfo" ::: Ptr ImageViewHandleInfoNVX) -> IO Word32
vkGetImageViewHandleNVX' = FunPtr
  (Ptr Device_T
   -> ("pInfo" ::: Ptr ImageViewHandleInfoNVX) -> IO Word32)
-> Ptr Device_T
-> ("pInfo" ::: Ptr ImageViewHandleInfoNVX)
-> IO Word32
mkVkGetImageViewHandleNVX FunPtr
  (Ptr Device_T
   -> ("pInfo" ::: Ptr ImageViewHandleInfoNVX) -> IO Word32)
vkGetImageViewHandleNVXPtr
  "pInfo" ::: Ptr ImageViewHandleInfoNVX
pInfo <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (ImageViewHandleInfoNVX
info)
  Word32
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetImageViewHandleNVX" (Ptr Device_T
-> ("pInfo" ::: Ptr ImageViewHandleInfoNVX) -> IO Word32
vkGetImageViewHandleNVX'
                                                            (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                            "pInfo" ::: Ptr ImageViewHandleInfoNVX
pInfo)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Word32
r)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetImageViewAddressNVX
  :: FunPtr (Ptr Device_T -> ImageView -> Ptr ImageViewAddressPropertiesNVX -> IO Result) -> Ptr Device_T -> ImageView -> Ptr ImageViewAddressPropertiesNVX -> IO Result

-- | vkGetImageViewAddressNVX - Get the device address of an image view
--
-- == 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_UNKNOWN'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NVX_image_view_handle VK_NVX_image_view_handle>,
-- 'Vulkan.Core10.Handles.Device', 'Vulkan.Core10.Handles.ImageView',
-- 'ImageViewAddressPropertiesNVX'
getImageViewAddressNVX :: forall io
                        . (MonadIO io)
                       => -- | @device@ is the logical device that owns the image view.
                          --
                          -- #VUID-vkGetImageViewAddressNVX-device-parameter# @device@ /must/ be a
                          -- valid 'Vulkan.Core10.Handles.Device' handle
                          Device
                       -> -- | @imageView@ is a handle to the image view.
                          --
                          -- #VUID-vkGetImageViewAddressNVX-imageView-parameter# @imageView@ /must/
                          -- be a valid 'Vulkan.Core10.Handles.ImageView' handle
                          --
                          -- #VUID-vkGetImageViewAddressNVX-imageView-parent# @imageView@ /must/ have
                          -- been created, allocated, or retrieved from @device@
                          ImageView
                       -> io (ImageViewAddressPropertiesNVX)
getImageViewAddressNVX :: forall (io :: * -> *).
MonadIO io =>
Device -> ImageView -> io ImageViewAddressPropertiesNVX
getImageViewAddressNVX Device
device ImageView
imageView = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
  let vkGetImageViewAddressNVXPtr :: FunPtr
  (Ptr Device_T
   -> ImageView
   -> ("pProperties" ::: Ptr ImageViewAddressPropertiesNVX)
   -> IO Result)
vkGetImageViewAddressNVXPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ImageView
      -> ("pProperties" ::: Ptr ImageViewAddressPropertiesNVX)
      -> IO Result)
pVkGetImageViewAddressNVX (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ImageView
   -> ("pProperties" ::: Ptr ImageViewAddressPropertiesNVX)
   -> IO Result)
vkGetImageViewAddressNVXPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetImageViewAddressNVX is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkGetImageViewAddressNVX' :: Ptr Device_T
-> ImageView
-> ("pProperties" ::: Ptr ImageViewAddressPropertiesNVX)
-> IO Result
vkGetImageViewAddressNVX' = FunPtr
  (Ptr Device_T
   -> ImageView
   -> ("pProperties" ::: Ptr ImageViewAddressPropertiesNVX)
   -> IO Result)
-> Ptr Device_T
-> ImageView
-> ("pProperties" ::: Ptr ImageViewAddressPropertiesNVX)
-> IO Result
mkVkGetImageViewAddressNVX FunPtr
  (Ptr Device_T
   -> ImageView
   -> ("pProperties" ::: Ptr ImageViewAddressPropertiesNVX)
   -> IO Result)
vkGetImageViewAddressNVXPtr
  "pProperties" ::: Ptr ImageViewAddressPropertiesNVX
pPProperties <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @ImageViewAddressPropertiesNVX)
  Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetImageViewAddressNVX" (Ptr Device_T
-> ImageView
-> ("pProperties" ::: Ptr ImageViewAddressPropertiesNVX)
-> IO Result
vkGetImageViewAddressNVX'
                                                             (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                             (ImageView
imageView)
                                                             ("pProperties" ::: Ptr ImageViewAddressPropertiesNVX
pPProperties))
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  ImageViewAddressPropertiesNVX
pProperties <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ImageViewAddressPropertiesNVX "pProperties" ::: Ptr ImageViewAddressPropertiesNVX
pPProperties
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (ImageViewAddressPropertiesNVX
pProperties)


-- | VkImageViewHandleInfoNVX - Structure specifying the image view for
-- handle queries
--
-- == Valid Usage
--
-- -   #VUID-VkImageViewHandleInfoNVX-descriptorType-02654#
--     @descriptorType@ /must/ be
--     'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_SAMPLED_IMAGE',
--     'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_STORAGE_IMAGE',
--     or
--     'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_COMBINED_IMAGE_SAMPLER'
--
-- -   #VUID-VkImageViewHandleInfoNVX-sampler-02655# @sampler@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Sampler' if @descriptorType@ is
--     'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_COMBINED_IMAGE_SAMPLER'
--
-- -   #VUID-VkImageViewHandleInfoNVX-imageView-02656# If descriptorType is
--     'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_SAMPLED_IMAGE'
--     or
--     'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_COMBINED_IMAGE_SAMPLER',
--     the image that @imageView@ was created from /must/ have been created
--     with the
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_SAMPLED_BIT'
--     usage bit set
--
-- -   #VUID-VkImageViewHandleInfoNVX-imageView-02657# If descriptorType is
--     'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_STORAGE_IMAGE',
--     the image that @imageView@ was created from /must/ have been created
--     with the
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_STORAGE_BIT'
--     usage bit set
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkImageViewHandleInfoNVX-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_IMAGE_VIEW_HANDLE_INFO_NVX'
--
-- -   #VUID-VkImageViewHandleInfoNVX-pNext-pNext# @pNext@ /must/ be @NULL@
--
-- -   #VUID-VkImageViewHandleInfoNVX-imageView-parameter# @imageView@
--     /must/ be a valid 'Vulkan.Core10.Handles.ImageView' handle
--
-- -   #VUID-VkImageViewHandleInfoNVX-descriptorType-parameter#
--     @descriptorType@ /must/ be a valid
--     'Vulkan.Core10.Enums.DescriptorType.DescriptorType' value
--
-- -   #VUID-VkImageViewHandleInfoNVX-sampler-parameter# If @sampler@ is
--     not 'Vulkan.Core10.APIConstants.NULL_HANDLE', @sampler@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Sampler' handle
--
-- -   #VUID-VkImageViewHandleInfoNVX-commonparent# Both of @imageView@,
--     and @sampler@ that are valid handles of non-ignored parameters
--     /must/ have been created, allocated, or retrieved from the same
--     'Vulkan.Core10.Handles.Device'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NVX_image_view_handle VK_NVX_image_view_handle>,
-- 'Vulkan.Core10.Enums.DescriptorType.DescriptorType',
-- 'Vulkan.Core10.Handles.ImageView', 'Vulkan.Core10.Handles.Sampler',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'getImageViewHandleNVX'
data ImageViewHandleInfoNVX = ImageViewHandleInfoNVX
  { -- | @imageView@ is the image view to query.
    ImageViewHandleInfoNVX -> ImageView
imageView :: ImageView
  , -- | @descriptorType@ is the type of descriptor for which to query a handle.
    ImageViewHandleInfoNVX -> DescriptorType
descriptorType :: DescriptorType
  , -- | @sampler@ is the sampler to combine with the image view when generating
    -- the handle.
    ImageViewHandleInfoNVX -> Sampler
sampler :: Sampler
  }
  deriving (Typeable, ImageViewHandleInfoNVX -> ImageViewHandleInfoNVX -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageViewHandleInfoNVX -> ImageViewHandleInfoNVX -> Bool
$c/= :: ImageViewHandleInfoNVX -> ImageViewHandleInfoNVX -> Bool
== :: ImageViewHandleInfoNVX -> ImageViewHandleInfoNVX -> Bool
$c== :: ImageViewHandleInfoNVX -> ImageViewHandleInfoNVX -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ImageViewHandleInfoNVX)
#endif
deriving instance Show ImageViewHandleInfoNVX

instance ToCStruct ImageViewHandleInfoNVX where
  withCStruct :: forall b.
ImageViewHandleInfoNVX
-> (("pInfo" ::: Ptr ImageViewHandleInfoNVX) -> IO b) -> IO b
withCStruct ImageViewHandleInfoNVX
x ("pInfo" ::: Ptr ImageViewHandleInfoNVX) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
40 forall a b. (a -> b) -> a -> b
$ \"pInfo" ::: Ptr ImageViewHandleInfoNVX
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pInfo" ::: Ptr ImageViewHandleInfoNVX
p ImageViewHandleInfoNVX
x (("pInfo" ::: Ptr ImageViewHandleInfoNVX) -> IO b
f "pInfo" ::: Ptr ImageViewHandleInfoNVX
p)
  pokeCStruct :: forall b.
("pInfo" ::: Ptr ImageViewHandleInfoNVX)
-> ImageViewHandleInfoNVX -> IO b -> IO b
pokeCStruct "pInfo" ::: Ptr ImageViewHandleInfoNVX
p ImageViewHandleInfoNVX{Sampler
ImageView
DescriptorType
sampler :: Sampler
descriptorType :: DescriptorType
imageView :: ImageView
$sel:sampler:ImageViewHandleInfoNVX :: ImageViewHandleInfoNVX -> Sampler
$sel:descriptorType:ImageViewHandleInfoNVX :: ImageViewHandleInfoNVX -> DescriptorType
$sel:imageView:ImageViewHandleInfoNVX :: ImageViewHandleInfoNVX -> ImageView
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr ImageViewHandleInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_VIEW_HANDLE_INFO_NVX)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr ImageViewHandleInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr ImageViewHandleInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ImageView)) (ImageView
imageView)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr ImageViewHandleInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DescriptorType)) (DescriptorType
descriptorType)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr ImageViewHandleInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Sampler)) (Sampler
sampler)
    IO b
f
  cStructSize :: Int
cStructSize = Int
40
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. ("pInfo" ::: Ptr ImageViewHandleInfoNVX) -> IO b -> IO b
pokeZeroCStruct "pInfo" ::: Ptr ImageViewHandleInfoNVX
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr ImageViewHandleInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_VIEW_HANDLE_INFO_NVX)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr ImageViewHandleInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr ImageViewHandleInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ImageView)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr ImageViewHandleInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DescriptorType)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct ImageViewHandleInfoNVX where
  peekCStruct :: ("pInfo" ::: Ptr ImageViewHandleInfoNVX)
-> IO ImageViewHandleInfoNVX
peekCStruct "pInfo" ::: Ptr ImageViewHandleInfoNVX
p = do
    ImageView
imageView <- forall a. Storable a => Ptr a -> IO a
peek @ImageView (("pInfo" ::: Ptr ImageViewHandleInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ImageView))
    DescriptorType
descriptorType <- forall a. Storable a => Ptr a -> IO a
peek @DescriptorType (("pInfo" ::: Ptr ImageViewHandleInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DescriptorType))
    Sampler
sampler <- forall a. Storable a => Ptr a -> IO a
peek @Sampler (("pInfo" ::: Ptr ImageViewHandleInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Sampler))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ImageView -> DescriptorType -> Sampler -> ImageViewHandleInfoNVX
ImageViewHandleInfoNVX
             ImageView
imageView DescriptorType
descriptorType Sampler
sampler

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

instance Zero ImageViewHandleInfoNVX where
  zero :: ImageViewHandleInfoNVX
zero = ImageView -> DescriptorType -> Sampler -> ImageViewHandleInfoNVX
ImageViewHandleInfoNVX
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkImageViewAddressPropertiesNVX - Structure specifying the image view
-- for handle queries
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NVX_image_view_handle VK_NVX_image_view_handle>,
-- 'Vulkan.Core10.FundamentalTypes.DeviceAddress',
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'getImageViewAddressNVX'
data ImageViewAddressPropertiesNVX = ImageViewAddressPropertiesNVX
  { -- | @deviceAddress@ is the device address of the image view.
    ImageViewAddressPropertiesNVX -> DeviceAddress
deviceAddress :: DeviceAddress
  , -- | @size@ is the size in bytes of the image view device memory.
    ImageViewAddressPropertiesNVX -> DeviceAddress
size :: DeviceSize
  }
  deriving (Typeable, ImageViewAddressPropertiesNVX
-> ImageViewAddressPropertiesNVX -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageViewAddressPropertiesNVX
-> ImageViewAddressPropertiesNVX -> Bool
$c/= :: ImageViewAddressPropertiesNVX
-> ImageViewAddressPropertiesNVX -> Bool
== :: ImageViewAddressPropertiesNVX
-> ImageViewAddressPropertiesNVX -> Bool
$c== :: ImageViewAddressPropertiesNVX
-> ImageViewAddressPropertiesNVX -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ImageViewAddressPropertiesNVX)
#endif
deriving instance Show ImageViewAddressPropertiesNVX

instance ToCStruct ImageViewAddressPropertiesNVX where
  withCStruct :: forall b.
ImageViewAddressPropertiesNVX
-> (("pProperties" ::: Ptr ImageViewAddressPropertiesNVX) -> IO b)
-> IO b
withCStruct ImageViewAddressPropertiesNVX
x ("pProperties" ::: Ptr ImageViewAddressPropertiesNVX) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \"pProperties" ::: Ptr ImageViewAddressPropertiesNVX
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr ImageViewAddressPropertiesNVX
p ImageViewAddressPropertiesNVX
x (("pProperties" ::: Ptr ImageViewAddressPropertiesNVX) -> IO b
f "pProperties" ::: Ptr ImageViewAddressPropertiesNVX
p)
  pokeCStruct :: forall b.
("pProperties" ::: Ptr ImageViewAddressPropertiesNVX)
-> ImageViewAddressPropertiesNVX -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr ImageViewAddressPropertiesNVX
p ImageViewAddressPropertiesNVX{DeviceAddress
size :: DeviceAddress
deviceAddress :: DeviceAddress
$sel:size:ImageViewAddressPropertiesNVX :: ImageViewAddressPropertiesNVX -> DeviceAddress
$sel:deviceAddress:ImageViewAddressPropertiesNVX :: ImageViewAddressPropertiesNVX -> DeviceAddress
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr ImageViewAddressPropertiesNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_VIEW_ADDRESS_PROPERTIES_NVX)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr ImageViewAddressPropertiesNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr ImageViewAddressPropertiesNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceAddress)) (DeviceAddress
deviceAddress)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr ImageViewAddressPropertiesNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DeviceSize)) (DeviceAddress
size)
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pProperties" ::: Ptr ImageViewAddressPropertiesNVX)
-> IO b -> IO b
pokeZeroCStruct "pProperties" ::: Ptr ImageViewAddressPropertiesNVX
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr ImageViewAddressPropertiesNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_VIEW_ADDRESS_PROPERTIES_NVX)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr ImageViewAddressPropertiesNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr ImageViewAddressPropertiesNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceAddress)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr ImageViewAddressPropertiesNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct ImageViewAddressPropertiesNVX where
  peekCStruct :: ("pProperties" ::: Ptr ImageViewAddressPropertiesNVX)
-> IO ImageViewAddressPropertiesNVX
peekCStruct "pProperties" ::: Ptr ImageViewAddressPropertiesNVX
p = do
    DeviceAddress
deviceAddress <- forall a. Storable a => Ptr a -> IO a
peek @DeviceAddress (("pProperties" ::: Ptr ImageViewAddressPropertiesNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceAddress))
    DeviceAddress
size <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize (("pProperties" ::: Ptr ImageViewAddressPropertiesNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DeviceSize))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DeviceAddress -> DeviceAddress -> ImageViewAddressPropertiesNVX
ImageViewAddressPropertiesNVX
             DeviceAddress
deviceAddress DeviceAddress
size

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

instance Zero ImageViewAddressPropertiesNVX where
  zero :: ImageViewAddressPropertiesNVX
zero = DeviceAddress -> DeviceAddress -> ImageViewAddressPropertiesNVX
ImageViewAddressPropertiesNVX
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


type NVX_IMAGE_VIEW_HANDLE_SPEC_VERSION = 2

-- No documentation found for TopLevel "VK_NVX_IMAGE_VIEW_HANDLE_SPEC_VERSION"
pattern NVX_IMAGE_VIEW_HANDLE_SPEC_VERSION :: forall a . Integral a => a
pattern $bNVX_IMAGE_VIEW_HANDLE_SPEC_VERSION :: forall a. Integral a => a
$mNVX_IMAGE_VIEW_HANDLE_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
NVX_IMAGE_VIEW_HANDLE_SPEC_VERSION = 2


type NVX_IMAGE_VIEW_HANDLE_EXTENSION_NAME = "VK_NVX_image_view_handle"

-- No documentation found for TopLevel "VK_NVX_IMAGE_VIEW_HANDLE_EXTENSION_NAME"
pattern NVX_IMAGE_VIEW_HANDLE_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bNVX_IMAGE_VIEW_HANDLE_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mNVX_IMAGE_VIEW_HANDLE_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
NVX_IMAGE_VIEW_HANDLE_EXTENSION_NAME = "VK_NVX_image_view_handle"