{-# language CPP #-}
module Vulkan.Core10.ImageView  ( createImageView
                                , withImageView
                                , destroyImageView
                                , ComponentMapping(..)
                                , ImageViewCreateInfo(..)
                                ) where

import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (castPtr)
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 Control.Monad.IO.Class (MonadIO)
import Data.Type.Equality ((:~:)(Refl))
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.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Vulkan.CStruct.Extends (forgetExtensions)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks)
import Vulkan.CStruct.Extends (Chain)
import Vulkan.Core10.Enums.ComponentSwizzle (ComponentSwizzle)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Dynamic (DeviceCmds(pVkCreateImageView))
import Vulkan.Dynamic (DeviceCmds(pVkDestroyImageView))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.CStruct.Extends (Extends)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.CStruct.Extends (Extensible(..))
import Vulkan.Core10.Enums.Format (Format)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.Core10.Handles (Image)
import Vulkan.Core10.SharedTypes (ImageSubresourceRange)
import Vulkan.Core10.Handles (ImageView)
import Vulkan.Core10.Handles (ImageView(..))
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_astc_decode_mode (ImageViewASTCDecodeModeEXT)
import Vulkan.Core10.Enums.ImageViewCreateFlagBits (ImageViewCreateFlags)
import Vulkan.Core10.Enums.ImageViewType (ImageViewType)
import {-# SOURCE #-} Vulkan.Core11.Promoted_From_VK_KHR_maintenance2 (ImageViewUsageCreateInfo)
import Vulkan.CStruct.Extends (PeekChain)
import Vulkan.CStruct.Extends (PeekChain(..))
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (PokeChain(..))
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import {-# SOURCE #-} Vulkan.Core11.Promoted_From_VK_KHR_sampler_ycbcr_conversion (SamplerYcbcrConversionInfo)
import Vulkan.CStruct.Extends (SomeStruct)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Exception (VulkanException(..))
import Vulkan.Zero (Zero(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_IMAGE_VIEW_CREATE_INFO))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCreateImageView
  :: FunPtr (Ptr Device_T -> Ptr (SomeStruct ImageViewCreateInfo) -> Ptr AllocationCallbacks -> Ptr ImageView -> IO Result) -> Ptr Device_T -> Ptr (SomeStruct ImageViewCreateInfo) -> Ptr AllocationCallbacks -> Ptr ImageView -> IO Result

-- | vkCreateImageView - Create an image view from an existing image
--
-- == Valid Usage (Implicit)
--
-- -   @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   @pCreateInfo@ /must/ be a valid pointer to a valid
--     'ImageViewCreateInfo' structure
--
-- -   If @pAllocator@ is not @NULL@, @pAllocator@ /must/ be a valid
--     pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   @pView@ /must/ be a valid pointer to a
--     'Vulkan.Core10.Handles.ImageView' handle
--
-- == 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_OUT_OF_DEVICE_MEMORY'
--
-- = See Also
--
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Core10.Handles.Device', 'Vulkan.Core10.Handles.ImageView',
-- 'ImageViewCreateInfo'
createImageView :: forall a io
                 . (Extendss ImageViewCreateInfo a, PokeChain a, MonadIO io)
                => -- | @device@ is the logical device that creates the image view.
                   Device
                -> -- | @pCreateInfo@ is a pointer to a 'ImageViewCreateInfo' structure
                   -- containing parameters to be used to create the image view.
                   (ImageViewCreateInfo a)
                -> -- | @pAllocator@ controls host memory allocation as described in the
                   -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                   -- chapter.
                   ("allocator" ::: Maybe AllocationCallbacks)
                -> io (ImageView)
createImageView :: Device
-> ImageViewCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ImageView
createImageView device :: Device
device createInfo :: ImageViewCreateInfo a
createInfo allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO ImageView -> io ImageView
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ImageView -> io ImageView)
-> (ContT ImageView IO ImageView -> IO ImageView)
-> ContT ImageView IO ImageView
-> io ImageView
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT ImageView IO ImageView -> IO ImageView
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT ImageView IO ImageView -> io ImageView)
-> ContT ImageView IO ImageView -> io ImageView
forall a b. (a -> b) -> a -> b
$ do
  let vkCreateImageViewPtr :: FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct ImageViewCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pView" ::: Ptr ImageView)
   -> IO Result)
vkCreateImageViewPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pCreateInfo" ::: Ptr (SomeStruct ImageViewCreateInfo))
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pView" ::: Ptr ImageView)
      -> IO Result)
pVkCreateImageView (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  IO () -> ContT ImageView IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ImageView IO ()) -> IO () -> ContT ImageView IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct ImageViewCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pView" ::: Ptr ImageView)
   -> IO Result)
vkCreateImageViewPtr FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct ImageViewCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pView" ::: Ptr ImageView)
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> ("pCreateInfo" ::: Ptr (SomeStruct ImageViewCreateInfo))
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pView" ::: Ptr ImageView)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct ImageViewCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pView" ::: Ptr ImageView)
   -> 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 "" "The function pointer for vkCreateImageView is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCreateImageView' :: Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ImageViewCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pView" ::: Ptr ImageView)
-> IO Result
vkCreateImageView' = FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct ImageViewCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pView" ::: Ptr ImageView)
   -> IO Result)
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ImageViewCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pView" ::: Ptr ImageView)
-> IO Result
mkVkCreateImageView FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct ImageViewCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pView" ::: Ptr ImageView)
   -> IO Result)
vkCreateImageViewPtr
  Ptr (ImageViewCreateInfo a)
pCreateInfo <- ((Ptr (ImageViewCreateInfo a) -> IO ImageView) -> IO ImageView)
-> ContT ImageView IO (Ptr (ImageViewCreateInfo a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (ImageViewCreateInfo a) -> IO ImageView) -> IO ImageView)
 -> ContT ImageView IO (Ptr (ImageViewCreateInfo a)))
-> ((Ptr (ImageViewCreateInfo a) -> IO ImageView) -> IO ImageView)
-> ContT ImageView IO (Ptr (ImageViewCreateInfo a))
forall a b. (a -> b) -> a -> b
$ ImageViewCreateInfo a
-> (Ptr (ImageViewCreateInfo a) -> IO ImageView) -> IO ImageView
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (ImageViewCreateInfo a
createInfo)
  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT ImageView IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
    Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ImageView)
 -> IO ImageView)
-> ContT ImageView IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ImageView)
  -> IO ImageView)
 -> ContT ImageView IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ImageView)
    -> IO ImageView)
-> ContT ImageView IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO ImageView)
-> IO ImageView
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  "pView" ::: Ptr ImageView
pPView <- ((("pView" ::: Ptr ImageView) -> IO ImageView) -> IO ImageView)
-> ContT ImageView IO ("pView" ::: Ptr ImageView)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pView" ::: Ptr ImageView) -> IO ImageView) -> IO ImageView)
 -> ContT ImageView IO ("pView" ::: Ptr ImageView))
-> ((("pView" ::: Ptr ImageView) -> IO ImageView) -> IO ImageView)
-> ContT ImageView IO ("pView" ::: Ptr ImageView)
forall a b. (a -> b) -> a -> b
$ IO ("pView" ::: Ptr ImageView)
-> (("pView" ::: Ptr ImageView) -> IO ())
-> (("pView" ::: Ptr ImageView) -> IO ImageView)
-> IO ImageView
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pView" ::: Ptr ImageView)
forall a. Int -> IO (Ptr a)
callocBytes @ImageView 8) ("pView" ::: Ptr ImageView) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT ImageView IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT ImageView IO Result)
-> IO Result -> ContT ImageView IO Result
forall a b. (a -> b) -> a -> b
$ Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ImageViewCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pView" ::: Ptr ImageView)
-> IO Result
vkCreateImageView' (Device -> Ptr Device_T
deviceHandle (Device
device)) (Ptr (ImageViewCreateInfo a)
-> "pCreateInfo" ::: Ptr (SomeStruct ImageViewCreateInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (ImageViewCreateInfo a)
pCreateInfo) "pAllocator" ::: Ptr AllocationCallbacks
pAllocator ("pView" ::: Ptr ImageView
pPView)
  IO () -> ContT ImageView IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ImageView IO ()) -> IO () -> ContT ImageView 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))
  ImageView
pView <- IO ImageView -> ContT ImageView IO ImageView
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ImageView -> ContT ImageView IO ImageView)
-> IO ImageView -> ContT ImageView IO ImageView
forall a b. (a -> b) -> a -> b
$ ("pView" ::: Ptr ImageView) -> IO ImageView
forall a. Storable a => Ptr a -> IO a
peek @ImageView "pView" ::: Ptr ImageView
pPView
  ImageView -> ContT ImageView IO ImageView
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ImageView -> ContT ImageView IO ImageView)
-> ImageView -> ContT ImageView IO ImageView
forall a b. (a -> b) -> a -> b
$ (ImageView
pView)

-- | A convenience wrapper to make a compatible pair of calls to
-- 'createImageView' and 'destroyImageView'
--
-- To ensure that 'destroyImageView' is always called: pass
-- 'Control.Exception.bracket' (or the allocate function from your
-- favourite resource management library) as the first argument.
-- To just extract the pair pass '(,)' as the first argument.
--
withImageView :: forall a io r . (Extendss ImageViewCreateInfo a, PokeChain a, MonadIO io) => Device -> ImageViewCreateInfo a -> Maybe AllocationCallbacks -> (io (ImageView) -> ((ImageView) -> io ()) -> r) -> r
withImageView :: Device
-> ImageViewCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io ImageView -> (ImageView -> io ()) -> r)
-> r
withImageView device :: Device
device pCreateInfo :: ImageViewCreateInfo a
pCreateInfo pAllocator :: "allocator" ::: Maybe AllocationCallbacks
pAllocator b :: io ImageView -> (ImageView -> io ()) -> r
b =
  io ImageView -> (ImageView -> io ()) -> r
b (Device
-> ImageViewCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ImageView
forall (a :: [*]) (io :: * -> *).
(Extendss ImageViewCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> ImageViewCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ImageView
createImageView Device
device ImageViewCreateInfo a
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
    (\(ImageView
o0) -> Device
-> ImageView
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
forall (io :: * -> *).
MonadIO io =>
Device
-> ImageView
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyImageView Device
device ImageView
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)


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

-- | vkDestroyImageView - Destroy an image view object
--
-- == Valid Usage
--
-- -   All submitted commands that refer to @imageView@ /must/ have
--     completed execution
--
-- -   If 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' were
--     provided when @imageView@ was created, a compatible set of callbacks
--     /must/ be provided here
--
-- -   If no 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' were
--     provided when @imageView@ was created, @pAllocator@ /must/ be @NULL@
--
-- == Valid Usage (Implicit)
--
-- -   @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   If @imageView@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @imageView@ /must/ be a valid 'Vulkan.Core10.Handles.ImageView'
--     handle
--
-- -   If @pAllocator@ is not @NULL@, @pAllocator@ /must/ be a valid
--     pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   If @imageView@ is a valid handle, it /must/ have been created,
--     allocated, or retrieved from @device@
--
-- == Host Synchronization
--
-- -   Host access to @imageView@ /must/ be externally synchronized
--
-- = See Also
--
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Core10.Handles.Device', 'Vulkan.Core10.Handles.ImageView'
destroyImageView :: forall io
                  . (MonadIO io)
                 => -- | @device@ is the logical device that destroys the image view.
                    Device
                 -> -- | @imageView@ is the image view to destroy.
                    ImageView
                 -> -- | @pAllocator@ controls host memory allocation as described in the
                    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                    -- chapter.
                    ("allocator" ::: Maybe AllocationCallbacks)
                 -> io ()
destroyImageView :: Device
-> ImageView
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyImageView device :: Device
device imageView :: ImageView
imageView allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> io ()) -> ContT () IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  let vkDestroyImageViewPtr :: FunPtr
  (Ptr Device_T
   -> ImageView
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyImageViewPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ImageView
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> IO ())
pVkDestroyImageView (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ImageView
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyImageViewPtr FunPtr
  (Ptr Device_T
   -> ImageView
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
-> FunPtr
     (Ptr Device_T
      -> ImageView
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ImageView
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
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 "" "The function pointer for vkDestroyImageView is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkDestroyImageView' :: Ptr Device_T
-> ImageView -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroyImageView' = FunPtr
  (Ptr Device_T
   -> ImageView
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
-> Ptr Device_T
-> ImageView
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroyImageView FunPtr
  (Ptr Device_T
   -> ImageView
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyImageViewPtr
  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
    Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
 -> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Device_T
-> ImageView -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroyImageView' (Device -> Ptr Device_T
deviceHandle (Device
device)) (ImageView
imageView) "pAllocator" ::: Ptr AllocationCallbacks
pAllocator
  () -> ContT () IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()


-- | VkComponentMapping - Structure specifying a color component mapping
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'Vulkan.Extensions.VK_ANDROID_external_memory_android_hardware_buffer.AndroidHardwareBufferFormatPropertiesANDROID',
-- 'Vulkan.Core10.Enums.ComponentSwizzle.ComponentSwizzle',
-- 'ImageViewCreateInfo',
-- 'Vulkan.Core11.Promoted_From_VK_KHR_sampler_ycbcr_conversion.SamplerYcbcrConversionCreateInfo'
data ComponentMapping = ComponentMapping
  { -- | @r@ is a 'Vulkan.Core10.Enums.ComponentSwizzle.ComponentSwizzle'
    -- specifying the component value placed in the R component of the output
    -- vector.
    --
    -- @r@ /must/ be a valid
    -- 'Vulkan.Core10.Enums.ComponentSwizzle.ComponentSwizzle' value
    ComponentMapping -> ComponentSwizzle
r :: ComponentSwizzle
  , -- | @g@ is a 'Vulkan.Core10.Enums.ComponentSwizzle.ComponentSwizzle'
    -- specifying the component value placed in the G component of the output
    -- vector.
    --
    -- @g@ /must/ be a valid
    -- 'Vulkan.Core10.Enums.ComponentSwizzle.ComponentSwizzle' value
    ComponentMapping -> ComponentSwizzle
g :: ComponentSwizzle
  , -- | @b@ is a 'Vulkan.Core10.Enums.ComponentSwizzle.ComponentSwizzle'
    -- specifying the component value placed in the B component of the output
    -- vector.
    --
    -- @b@ /must/ be a valid
    -- 'Vulkan.Core10.Enums.ComponentSwizzle.ComponentSwizzle' value
    ComponentMapping -> ComponentSwizzle
b :: ComponentSwizzle
  , -- | @a@ is a 'Vulkan.Core10.Enums.ComponentSwizzle.ComponentSwizzle'
    -- specifying the component value placed in the A component of the output
    -- vector.
    --
    -- @a@ /must/ be a valid
    -- 'Vulkan.Core10.Enums.ComponentSwizzle.ComponentSwizzle' value
    ComponentMapping -> ComponentSwizzle
a :: ComponentSwizzle
  }
  deriving (Typeable, ComponentMapping -> ComponentMapping -> Bool
(ComponentMapping -> ComponentMapping -> Bool)
-> (ComponentMapping -> ComponentMapping -> Bool)
-> Eq ComponentMapping
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentMapping -> ComponentMapping -> Bool
$c/= :: ComponentMapping -> ComponentMapping -> Bool
== :: ComponentMapping -> ComponentMapping -> Bool
$c== :: ComponentMapping -> ComponentMapping -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ComponentMapping)
#endif
deriving instance Show ComponentMapping

instance ToCStruct ComponentMapping where
  withCStruct :: ComponentMapping -> (Ptr ComponentMapping -> IO b) -> IO b
withCStruct x :: ComponentMapping
x f :: Ptr ComponentMapping -> IO b
f = Int -> Int -> (Ptr ComponentMapping -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 16 4 ((Ptr ComponentMapping -> IO b) -> IO b)
-> (Ptr ComponentMapping -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr ComponentMapping
p -> Ptr ComponentMapping -> ComponentMapping -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ComponentMapping
p ComponentMapping
x (Ptr ComponentMapping -> IO b
f Ptr ComponentMapping
p)
  pokeCStruct :: Ptr ComponentMapping -> ComponentMapping -> IO b -> IO b
pokeCStruct p :: Ptr ComponentMapping
p ComponentMapping{..} f :: IO b
f = do
    Ptr ComponentSwizzle -> ComponentSwizzle -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ComponentMapping
p Ptr ComponentMapping -> Int -> Ptr ComponentSwizzle
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr ComponentSwizzle)) (ComponentSwizzle
r)
    Ptr ComponentSwizzle -> ComponentSwizzle -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ComponentMapping
p Ptr ComponentMapping -> Int -> Ptr ComponentSwizzle
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr ComponentSwizzle)) (ComponentSwizzle
g)
    Ptr ComponentSwizzle -> ComponentSwizzle -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ComponentMapping
p Ptr ComponentMapping -> Int -> Ptr ComponentSwizzle
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr ComponentSwizzle)) (ComponentSwizzle
b)
    Ptr ComponentSwizzle -> ComponentSwizzle -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ComponentMapping
p Ptr ComponentMapping -> Int -> Ptr ComponentSwizzle
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr ComponentSwizzle)) (ComponentSwizzle
a)
    IO b
f
  cStructSize :: Int
cStructSize = 16
  cStructAlignment :: Int
cStructAlignment = 4
  pokeZeroCStruct :: Ptr ComponentMapping -> IO b -> IO b
pokeZeroCStruct p :: Ptr ComponentMapping
p f :: IO b
f = do
    Ptr ComponentSwizzle -> ComponentSwizzle -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ComponentMapping
p Ptr ComponentMapping -> Int -> Ptr ComponentSwizzle
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr ComponentSwizzle)) (ComponentSwizzle
forall a. Zero a => a
zero)
    Ptr ComponentSwizzle -> ComponentSwizzle -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ComponentMapping
p Ptr ComponentMapping -> Int -> Ptr ComponentSwizzle
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr ComponentSwizzle)) (ComponentSwizzle
forall a. Zero a => a
zero)
    Ptr ComponentSwizzle -> ComponentSwizzle -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ComponentMapping
p Ptr ComponentMapping -> Int -> Ptr ComponentSwizzle
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr ComponentSwizzle)) (ComponentSwizzle
forall a. Zero a => a
zero)
    Ptr ComponentSwizzle -> ComponentSwizzle -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ComponentMapping
p Ptr ComponentMapping -> Int -> Ptr ComponentSwizzle
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr ComponentSwizzle)) (ComponentSwizzle
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct ComponentMapping where
  peekCStruct :: Ptr ComponentMapping -> IO ComponentMapping
peekCStruct p :: Ptr ComponentMapping
p = do
    ComponentSwizzle
r <- Ptr ComponentSwizzle -> IO ComponentSwizzle
forall a. Storable a => Ptr a -> IO a
peek @ComponentSwizzle ((Ptr ComponentMapping
p Ptr ComponentMapping -> Int -> Ptr ComponentSwizzle
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr ComponentSwizzle))
    ComponentSwizzle
g <- Ptr ComponentSwizzle -> IO ComponentSwizzle
forall a. Storable a => Ptr a -> IO a
peek @ComponentSwizzle ((Ptr ComponentMapping
p Ptr ComponentMapping -> Int -> Ptr ComponentSwizzle
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr ComponentSwizzle))
    ComponentSwizzle
b <- Ptr ComponentSwizzle -> IO ComponentSwizzle
forall a. Storable a => Ptr a -> IO a
peek @ComponentSwizzle ((Ptr ComponentMapping
p Ptr ComponentMapping -> Int -> Ptr ComponentSwizzle
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr ComponentSwizzle))
    ComponentSwizzle
a <- Ptr ComponentSwizzle -> IO ComponentSwizzle
forall a. Storable a => Ptr a -> IO a
peek @ComponentSwizzle ((Ptr ComponentMapping
p Ptr ComponentMapping -> Int -> Ptr ComponentSwizzle
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr ComponentSwizzle))
    ComponentMapping -> IO ComponentMapping
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ComponentMapping -> IO ComponentMapping)
-> ComponentMapping -> IO ComponentMapping
forall a b. (a -> b) -> a -> b
$ ComponentSwizzle
-> ComponentSwizzle
-> ComponentSwizzle
-> ComponentSwizzle
-> ComponentMapping
ComponentMapping
             ComponentSwizzle
r ComponentSwizzle
g ComponentSwizzle
b ComponentSwizzle
a

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

instance Zero ComponentMapping where
  zero :: ComponentMapping
zero = ComponentSwizzle
-> ComponentSwizzle
-> ComponentSwizzle
-> ComponentSwizzle
-> ComponentMapping
ComponentMapping
           ComponentSwizzle
forall a. Zero a => a
zero
           ComponentSwizzle
forall a. Zero a => a
zero
           ComponentSwizzle
forall a. Zero a => a
zero
           ComponentSwizzle
forall a. Zero a => a
zero


-- | VkImageViewCreateInfo - Structure specifying parameters of a newly
-- created image view
--
-- = Description
--
-- Some of the @image@ creation parameters are inherited by the view. In
-- particular, image view creation inherits the implicit parameter @usage@
-- specifying the allowed usages of the image view that, by default, takes
-- the value of the corresponding @usage@ parameter specified in
-- 'Vulkan.Core10.Image.ImageCreateInfo' at image creation time. If the
-- image was has a depth-stencil format and was created with a
-- 'Vulkan.Core12.Promoted_From_VK_EXT_separate_stencil_usage.ImageStencilUsageCreateInfo'
-- structure included in the @pNext@ chain of
-- 'Vulkan.Core10.Image.ImageCreateInfo', the usage is calculated based on
-- the @subresource.aspectMask@ provided:
--
-- -   If @aspectMask@ includes only
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_STENCIL_BIT',
--     the implicit @usage@ is equal to
--     'Vulkan.Core12.Promoted_From_VK_EXT_separate_stencil_usage.ImageStencilUsageCreateInfo'::@stencilUsage@.
--
-- -   If @aspectMask@ includes only
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_DEPTH_BIT',
--     the implicit @usage@ is equal to
--     'Vulkan.Core10.Image.ImageCreateInfo'::@usage@.
--
-- -   If both aspects are included in @aspectMask@, the implicit @usage@
--     is equal to the intersection of
--     'Vulkan.Core10.Image.ImageCreateInfo'::@usage@ and
--     'Vulkan.Core12.Promoted_From_VK_EXT_separate_stencil_usage.ImageStencilUsageCreateInfo'::@stencilUsage@.
--     The implicit @usage@ /can/ be overriden by adding a
--     'Vulkan.Core11.Promoted_From_VK_KHR_maintenance2.ImageViewUsageCreateInfo'
--     structure to the @pNext@ chain.
--
-- If @image@ was created with the
-- 'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_MUTABLE_FORMAT_BIT'
-- flag, and if the @format@ of the image is not
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion multi-planar>,
-- @format@ /can/ be different from the image’s format, but if @image@ was
-- created without the
-- 'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_BLOCK_TEXEL_VIEW_COMPATIBLE_BIT'
-- flag and they are not equal they /must/ be /compatible/. Image format
-- compatibility is defined in the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes Format Compatibility Classes>
-- section. Views of compatible formats will have the same mapping between
-- texel coordinates and memory locations irrespective of the @format@,
-- with only the interpretation of the bit pattern changing.
--
-- Note
--
-- Values intended to be used with one view format /may/ not be exactly
-- preserved when written or read through a different format. For example,
-- an integer value that happens to have the bit pattern of a floating
-- point denorm or NaN /may/ be flushed or canonicalized when written or
-- read through a view with a floating point format. Similarly, a value
-- written through a signed normalized format that has a bit pattern
-- exactly equal to -2b /may/ be changed to -2b + 1 as described in
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-fixedfpconv Conversion from Normalized Fixed-Point to Floating-Point>.
--
-- If @image@ was created with the
-- 'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_BLOCK_TEXEL_VIEW_COMPATIBLE_BIT'
-- flag, @format@ /must/ be /compatible/ with the image’s format as
-- described above, or /must/ be an uncompressed format in which case it
-- /must/ be /size-compatible/ with the image’s format, as defined for
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#copies-images-format-size-compatibility copying data between images>
-- In this case the resulting image view’s texel dimensions equal the
-- dimensions of the selected mip level divided by the compressed texel
-- block size and rounded up.
--
-- If the image view is to be used with a sampler which supports
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#samplers-YCbCr-conversion sampler Y′CBCR conversion>,
-- an /identically defined object/ of type
-- 'Vulkan.Core11.Handles.SamplerYcbcrConversion' to that used to create
-- the sampler /must/ be passed to 'createImageView' in a
-- 'Vulkan.Core11.Promoted_From_VK_KHR_sampler_ycbcr_conversion.SamplerYcbcrConversionInfo'
-- included in the @pNext@ chain of 'ImageViewCreateInfo'. Conversely, if a
-- 'Vulkan.Core11.Handles.SamplerYcbcrConversion' object is passed to
-- 'createImageView', an identically defined
-- 'Vulkan.Core11.Handles.SamplerYcbcrConversion' object /must/ be used
-- when sampling the image.
--
-- If the image has a
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion multi-planar>
-- @format@ and @subresourceRange.aspectMask@ is
-- 'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_COLOR_BIT',
-- @format@ /must/ be identical to the image @format@, and the sampler to
-- be used with the image view /must/ enable
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#samplers-YCbCr-conversion sampler Y′CBCR conversion>.
--
-- If @image@ was created with the
-- 'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_MUTABLE_FORMAT_BIT'
-- and the image has a
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion multi-planar>
-- @format@, and if @subresourceRange.aspectMask@ is
-- 'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_PLANE_0_BIT',
-- 'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_PLANE_1_BIT', or
-- 'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_PLANE_2_BIT',
-- @format@ /must/ be
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatible-planes compatible>
-- with the corresponding plane of the image, and the sampler to be used
-- with the image view /must/ not enable
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#samplers-YCbCr-conversion sampler Y′CBCR conversion>.
-- The @width@ and @height@ of the single-plane image view /must/ be
-- derived from the multi-planar image’s dimensions in the manner listed
-- for
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatible-planes plane compatibility>
-- for the plane.
--
-- Any view of an image plane will have the same mapping between texel
-- coordinates and memory locations as used by the channels of the color
-- aspect, subject to the formulae relating texel coordinates to
-- lower-resolution planes as described in
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#textures-chroma-reconstruction Chroma Reconstruction>.
-- That is, if an R or B plane has a reduced resolution relative to the G
-- plane of the multi-planar image, the image view operates using the
-- (/uplane/, /vplane/) unnormalized coordinates of the reduced-resolution
-- plane, and these coordinates access the same memory locations as the
-- (/ucolor/, /vcolor/) unnormalized coordinates of the color aspect for
-- which chroma reconstruction operations operate on the same (/uplane/,
-- /vplane/) or (/iplane/, /jplane/) coordinates.
--
-- +----------+--------------------------------------------------------------------------------+----------------------------------------------------------------+
-- | Dim,     | Image parameters                                                               | View parameters                                                |
-- | Arrayed, |                                                                                |                                                                |
-- | MS       |                                                                                |                                                                |
-- +==========+================================================================================+================================================================+
-- |          | @imageType@ = ci.@imageType@                                                   | @baseArrayLayer@, @layerCount@, and @levelCount@ are members   |
-- |          | @width@ = ci.@extent.width@                                                    | of the @subresourceRange@ member.                              |
-- |          | @height@ = ci.@extent.height@                                                  |                                                                |
-- |          | @depth@ = ci.@extent.depth@                                                    |                                                                |
-- |          | @arrayLayers@ = ci.@arrayLayers@                                               |                                                                |
-- |          | @samples@ = ci.@samples@                                                       |                                                                |
-- |          | @flags@ = ci.@flags@                                                           |                                                                |
-- |          | where ci is the 'Vulkan.Core10.Image.ImageCreateInfo' used to create @image@.  |                                                                |
-- +----------+--------------------------------------------------------------------------------+----------------------------------------------------------------+
-- | __1D, 0, | @imageType@ = 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_1D'                    | @viewType@ =                                                   |
-- | 0__      | @width@ ≥ 1                                                                    | 'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_1D'         |
-- |          | @height@ = 1                                                                   | @baseArrayLayer@ ≥ 0                                           |
-- |          | @depth@ = 1                                                                    | @layerCount@ = 1                                               |
-- |          | @arrayLayers@ ≥ 1                                                              |                                                                |
-- |          | @samples@ = 1                                                                  |                                                                |
-- +----------+--------------------------------------------------------------------------------+----------------------------------------------------------------+
-- | __1D, 1, | @imageType@ = 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_1D'                    | @viewType@ =                                                   |
-- | 0__      | @width@ ≥ 1                                                                    | 'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_1D_ARRAY'   |
-- |          | @height@ = 1                                                                   | @baseArrayLayer@ ≥ 0                                           |
-- |          | @depth@ = 1                                                                    | @layerCount@ ≥ 1                                               |
-- |          | @arrayLayers@ ≥ 1                                                              |                                                                |
-- |          | @samples@ = 1                                                                  |                                                                |
-- +----------+--------------------------------------------------------------------------------+----------------------------------------------------------------+
-- | __2D, 0, | @imageType@ = 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_2D'                    | @viewType@ =                                                   |
-- | 0__      | @width@ ≥ 1                                                                    | 'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_2D'         |
-- |          | @height@ ≥ 1                                                                   | @baseArrayLayer@ ≥ 0                                           |
-- |          | @depth@ = 1                                                                    | @layerCount@ = 1                                               |
-- |          | @arrayLayers@ ≥ 1                                                              |                                                                |
-- |          | @samples@ = 1                                                                  |                                                                |
-- +----------+--------------------------------------------------------------------------------+----------------------------------------------------------------+
-- | __2D, 1, | @imageType@ = 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_2D'                    | @viewType@ =                                                   |
-- | 0__      | @width@ ≥ 1                                                                    | 'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_2D_ARRAY'   |
-- |          | @height@ ≥ 1                                                                   | @baseArrayLayer@ ≥ 0                                           |
-- |          | @depth@ = 1                                                                    | @layerCount@ ≥ 1                                               |
-- |          | @arrayLayers@ ≥ 1                                                              |                                                                |
-- |          | @samples@ = 1                                                                  |                                                                |
-- +----------+--------------------------------------------------------------------------------+----------------------------------------------------------------+
-- | __2D, 0, | @imageType@ = 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_2D'                    | @viewType@ =                                                   |
-- | 1__      | @width@ ≥ 1                                                                    | 'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_2D'         |
-- |          | @height@ ≥ 1                                                                   | @baseArrayLayer@ ≥ 0                                           |
-- |          | @depth@ = 1                                                                    | @layerCount@ = 1                                               |
-- |          | @arrayLayers@ ≥ 1                                                              |                                                                |
-- |          | @samples@ > 1                                                                  |                                                                |
-- +----------+--------------------------------------------------------------------------------+----------------------------------------------------------------+
-- | __2D, 1, | @imageType@ = 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_2D'                    | @viewType@ =                                                   |
-- | 1__      | @width@ ≥ 1                                                                    | 'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_2D_ARRAY'   |
-- |          | @height@ ≥ 1                                                                   | @baseArrayLayer@ ≥ 0                                           |
-- |          | @depth@ = 1                                                                    | @layerCount@ ≥ 1                                               |
-- |          | @arrayLayers@ ≥ 1                                                              |                                                                |
-- |          | @samples@ > 1                                                                  |                                                                |
-- +----------+--------------------------------------------------------------------------------+----------------------------------------------------------------+
-- | __CUBE,  | @imageType@ = 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_2D'                    | @viewType@ =                                                   |
-- | 0, 0__   | @width@ ≥ 1                                                                    | 'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE'       |
-- |          | @height@ = @width@                                                             | @baseArrayLayer@ ≥ 0                                           |
-- |          | @depth@ = 1                                                                    | @layerCount@ = 6                                               |
-- |          | @arrayLayers@ ≥ 6                                                              |                                                                |
-- |          | @samples@ = 1                                                                  |                                                                |
-- |          | @flags@ includes                                                               |                                                                |
-- |          | 'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_CUBE_COMPATIBLE_BIT'     |                                                                |
-- +----------+--------------------------------------------------------------------------------+----------------------------------------------------------------+
-- | __CUBE,  | @imageType@ = 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_2D'                    | @viewType@ =                                                   |
-- | 1, 0__   | @width@ ≥ 1                                                                    | 'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE_ARRAY' |
-- |          | @height@ = width                                                               | @baseArrayLayer@ ≥ 0                                           |
-- |          | @depth@ = 1                                                                    | @layerCount@ = 6 × /N/, /N/ ≥ 1                                |
-- |          | /N/ ≥ 1                                                                        |                                                                |
-- |          | @arrayLayers@ ≥ 6 × /N/                                                        |                                                                |
-- |          | @samples@ = 1                                                                  |                                                                |
-- |          | @flags@ includes                                                               |                                                                |
-- |          | 'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_CUBE_COMPATIBLE_BIT'     |                                                                |
-- +----------+--------------------------------------------------------------------------------+----------------------------------------------------------------+
-- | __3D, 0, | @imageType@ = 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_3D'                    | @viewType@ =                                                   |
-- | 0__      | @width@ ≥ 1                                                                    | 'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_3D'         |
-- |          | @height@ ≥ 1                                                                   | @baseArrayLayer@ = 0                                           |
-- |          | @depth@ ≥ 1                                                                    | @layerCount@ = 1                                               |
-- |          | @arrayLayers@ = 1                                                              |                                                                |
-- |          | @samples@ = 1                                                                  |                                                                |
-- +----------+--------------------------------------------------------------------------------+----------------------------------------------------------------+
-- | __3D, 0, | @imageType@ = 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_3D'                    | @viewType@ =                                                   |
-- | 0__      | @width@ ≥ 1                                                                    | 'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_2D'         |
-- |          | @height@ ≥ 1                                                                   | @levelCount@ = 1                                               |
-- |          | @depth@ ≥ 1                                                                    | @baseArrayLayer@ ≥ 0                                           |
-- |          | @arrayLayers@ = 1                                                              | @layerCount@ = 1                                               |
-- |          | @samples@ = 1                                                                  |                                                                |
-- |          | @flags@ includes                                                               |                                                                |
-- |          | 'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_2D_ARRAY_COMPATIBLE_BIT' |                                                                |
-- |          | @flags@ does not include                                                       |                                                                |
-- |          | 'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SPARSE_BINDING_BIT',     |                                                                |
-- |          | 'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SPARSE_RESIDENCY_BIT',   |                                                                |
-- |          | and 'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SPARSE_ALIASED_BIT'  |                                                                |
-- +----------+--------------------------------------------------------------------------------+----------------------------------------------------------------+
-- | __3D, 0, | @imageType@ = 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_3D'                    | @viewType@ =                                                   |
-- | 0__      | @width@ ≥ 1                                                                    | 'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_2D_ARRAY'   |
-- |          | @height@ ≥ 1                                                                   | @levelCount@ = 1                                               |
-- |          | @depth@ ≥ 1                                                                    | @baseArrayLayer@ ≥ 0                                           |
-- |          | @arrayLayers@ = 1                                                              | @layerCount@ ≥ 1                                               |
-- |          | @samples@ = 1                                                                  |                                                                |
-- |          | @flags@ includes                                                               |                                                                |
-- |          | 'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_2D_ARRAY_COMPATIBLE_BIT' |                                                                |
-- |          | @flags@ does not include                                                       |                                                                |
-- |          | 'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SPARSE_BINDING_BIT',     |                                                                |
-- |          | 'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SPARSE_RESIDENCY_BIT',   |                                                                |
-- |          | and 'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SPARSE_ALIASED_BIT'  |                                                                |
-- +----------+--------------------------------------------------------------------------------+----------------------------------------------------------------+
--
-- Image and image view parameter compatibility requirements
--
-- == Valid Usage
--
-- -   If @image@ was not created with
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_CUBE_COMPATIBLE_BIT'
--     then @viewType@ /must/ not be
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE' or
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE_ARRAY'
--
-- -   If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-imageCubeArray image cubemap arrays>
--     feature is not enabled, @viewType@ /must/ not be
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE_ARRAY'
--
-- -   If @image@ was created with
--     'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_3D' but without
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_2D_ARRAY_COMPATIBLE_BIT'
--     set then @viewType@ /must/ not be
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_2D' or
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_2D_ARRAY'
--
-- -   @image@ /must/ have been created with a @usage@ value containing at
--     least one of
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_SAMPLED_BIT',
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_STORAGE_BIT',
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_COLOR_ATTACHMENT_BIT',
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT',
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_INPUT_ATTACHMENT_BIT',
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_SHADING_RATE_IMAGE_BIT_NV',
--     or
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_FRAGMENT_DENSITY_MAP_BIT_EXT'
--
-- -   The
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     of the resultant image view /must/ contain at least one bit
--
-- -   If @usage@ contains
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_SAMPLED_BIT',
--     then the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     of the resultant image view /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_SAMPLED_IMAGE_BIT'
--
-- -   If @usage@ contains
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_STORAGE_BIT',
--     then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_STORAGE_IMAGE_BIT'
--
-- -   If @usage@ contains
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_COLOR_ATTACHMENT_BIT',
--     then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_COLOR_ATTACHMENT_BIT'
--
-- -   If @usage@ contains
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT',
--     then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_DEPTH_STENCIL_ATTACHMENT_BIT'
--
-- -   If @usage@ contains
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_INPUT_ATTACHMENT_BIT',
--     then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain at least one of
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_COLOR_ATTACHMENT_BIT'
--     or
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_DEPTH_STENCIL_ATTACHMENT_BIT'
--
-- -   @subresourceRange.baseMipLevel@ /must/ be less than the @mipLevels@
--     specified in 'Vulkan.Core10.Image.ImageCreateInfo' when @image@ was
--     created
--
-- -   If @subresourceRange.levelCount@ is not
--     'Vulkan.Core10.APIConstants.REMAINING_MIP_LEVELS',
--     @subresourceRange.baseMipLevel@ + @subresourceRange.levelCount@
--     /must/ be less than or equal to the @mipLevels@ specified in
--     'Vulkan.Core10.Image.ImageCreateInfo' when @image@ was created
--
-- -   If @image@ was created with @usage@ containing
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_FRAGMENT_DENSITY_MAP_BIT_EXT',
--     @subresourceRange.levelCount@ /must/ be @1@
--
-- -   If @image@ is not a 3D image created with
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_2D_ARRAY_COMPATIBLE_BIT'
--     set, or @viewType@ is not
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_2D' or
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_2D_ARRAY',
--     @subresourceRange.baseArrayLayer@ /must/ be less than the
--     @arrayLayers@ specified in 'Vulkan.Core10.Image.ImageCreateInfo'
--     when @image@ was created
--
-- -   If @subresourceRange.layerCount@ is not
--     'Vulkan.Core10.APIConstants.REMAINING_ARRAY_LAYERS', @image@ is not
--     a 3D image created with
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_2D_ARRAY_COMPATIBLE_BIT'
--     set, or @viewType@ is not
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_2D' or
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_2D_ARRAY',
--     @subresourceRange.layerCount@ /must/ be non-zero and
--     @subresourceRange.baseArrayLayer@ + @subresourceRange.layerCount@
--     /must/ be less than or equal to the @arrayLayers@ specified in
--     'Vulkan.Core10.Image.ImageCreateInfo' when @image@ was created
--
-- -   If @image@ is a 3D image created with
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_2D_ARRAY_COMPATIBLE_BIT'
--     set, and @viewType@ is
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_2D' or
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_2D_ARRAY',
--     @subresourceRange.baseArrayLayer@ /must/ be less than the depth
--     computed from @baseMipLevel@ and @extent.depth@ specified in
--     'Vulkan.Core10.Image.ImageCreateInfo' when @image@ was created,
--     according to the formula defined in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-miplevel-sizing Image Miplevel Sizing>
--
-- -   If @subresourceRange.layerCount@ is not
--     'Vulkan.Core10.APIConstants.REMAINING_ARRAY_LAYERS', @image@ is a 3D
--     image created with
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_2D_ARRAY_COMPATIBLE_BIT'
--     set, and @viewType@ is
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_2D' or
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_2D_ARRAY',
--     @subresourceRange.layerCount@ /must/ be non-zero and
--     @subresourceRange.baseArrayLayer@ + @subresourceRange.layerCount@
--     /must/ be less than or equal to the depth computed from
--     @baseMipLevel@ and @extent.depth@ specified in
--     'Vulkan.Core10.Image.ImageCreateInfo' when @image@ was created,
--     according to the formula defined in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-miplevel-sizing Image Miplevel Sizing>
--
-- -   If @image@ was created with the
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_MUTABLE_FORMAT_BIT'
--     flag, but without the
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_BLOCK_TEXEL_VIEW_COMPATIBLE_BIT'
--     flag, and if the @format@ of the @image@ is not a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion multi-planar>
--     format, @format@ /must/ be compatible with the @format@ used to
--     create @image@, as defined in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes Format Compatibility Classes>
--
-- -   If @image@ was created with the
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_BLOCK_TEXEL_VIEW_COMPATIBLE_BIT'
--     flag, @format@ /must/ be compatible with, or /must/ be an
--     uncompressed format that is size-compatible with, the @format@ used
--     to create @image@
--
-- -   If @image@ was created with the
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_BLOCK_TEXEL_VIEW_COMPATIBLE_BIT'
--     flag, the @levelCount@ and @layerCount@ members of
--     @subresourceRange@ /must/ both be @1@
--
-- -   If a
--     'Vulkan.Core12.Promoted_From_VK_KHR_image_format_list.ImageFormatListCreateInfo'
--     structure was included in the @pNext@ chain of the
--     'Vulkan.Core10.Image.ImageCreateInfo' structure used when creating
--     @image@ and the @viewFormatCount@ field of
--     'Vulkan.Core12.Promoted_From_VK_KHR_image_format_list.ImageFormatListCreateInfo'
--     is not zero then @format@ /must/ be one of the formats in
--     'Vulkan.Core12.Promoted_From_VK_KHR_image_format_list.ImageFormatListCreateInfo'::@pViewFormats@
--
-- -   If @image@ was created with the
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_MUTABLE_FORMAT_BIT'
--     flag, if the @format@ of the @image@ is a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion multi-planar>
--     format, and if @subresourceRange.aspectMask@ is one of
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_PLANE_0_BIT',
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_PLANE_1_BIT',
--     or
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_PLANE_2_BIT',
--     then @format@ /must/ be compatible with the
--     'Vulkan.Core10.Enums.Format.Format' for the plane of the @image@
--     @format@ indicated by @subresourceRange.aspectMask@, as defined in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatible-planes>
--
-- -   If @image@ was not created with the
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_MUTABLE_FORMAT_BIT'
--     flag, or if the @format@ of the @image@ is a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion multi-planar>
--     format and if @subresourceRange.aspectMask@ is
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_COLOR_BIT',
--     @format@ /must/ be identical to the @format@ used to create @image@
--
-- -   If the @pNext@ chain includes a
--     'Vulkan.Core11.Promoted_From_VK_KHR_sampler_ycbcr_conversion.SamplerYcbcrConversionInfo'
--     structure with a @conversion@ value other than
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', all members of
--     @components@ /must/ have the value
--     'Vulkan.Core10.Enums.ComponentSwizzle.COMPONENT_SWIZZLE_IDENTITY'
--
-- -   If @image@ is non-sparse then it /must/ be bound completely and
--     contiguously to a single 'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   @subresourceRange@ and @viewType@ /must/ be compatible with the
--     image, as described in the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-views-compatibility compatibility table>
--
-- -   If @image@ has an
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-external-android-hardware-buffer-external-formats external format>,
--     @format@ /must/ be 'Vulkan.Core10.Enums.Format.FORMAT_UNDEFINED'
--
-- -   If @image@ has an
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-external-android-hardware-buffer-external-formats external format>,
--     the @pNext@ chain /must/ include a
--     'Vulkan.Core11.Promoted_From_VK_KHR_sampler_ycbcr_conversion.SamplerYcbcrConversionInfo'
--     structure with a @conversion@ object created with the same external
--     format as @image@
--
-- -   If @image@ has an
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-external-android-hardware-buffer-external-formats external format>,
--     all members of @components@ /must/ be
--     'Vulkan.Core10.Enums.ComponentSwizzle.COMPONENT_SWIZZLE_IDENTITY'
--
-- -   If @image@ was created with @usage@ containing
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_SHADING_RATE_IMAGE_BIT_NV',
--     @viewType@ /must/ be
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_2D' or
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_2D_ARRAY'
--
-- -   If @image@ was created with @usage@ containing
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_SHADING_RATE_IMAGE_BIT_NV',
--     @format@ /must/ be 'Vulkan.Core10.Enums.Format.FORMAT_R8_UINT'
--
-- -   If
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-fragmentdensitymapdynamic dynamic fragment density map>
--     feature is not enabled, @flags@ /must/ not contain
--     'Vulkan.Core10.Enums.ImageViewCreateFlagBits.IMAGE_VIEW_CREATE_FRAGMENT_DENSITY_MAP_DYNAMIC_BIT_EXT'
--
-- -   If
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-fragmentdensitymapdynamic dynamic fragment density map>
--     feature is not enabled and @image@ was created with @usage@
--     containing
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_FRAGMENT_DENSITY_MAP_BIT_EXT',
--     @flags@ /must/ not contain any of
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_PROTECTED_BIT',
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SPARSE_BINDING_BIT',
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SPARSE_RESIDENCY_BIT',
--     or
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SPARSE_ALIASED_BIT'
--
-- -   If the @pNext@ chain includes a
--     'Vulkan.Core11.Promoted_From_VK_KHR_maintenance2.ImageViewUsageCreateInfo'
--     structure, and @image@ was not created with a
--     'Vulkan.Core12.Promoted_From_VK_EXT_separate_stencil_usage.ImageStencilUsageCreateInfo'
--     structure included in the @pNext@ chain of
--     'Vulkan.Core10.Image.ImageCreateInfo', its @usage@ member /must/ not
--     include any bits that were not set in the @usage@ member of the
--     'Vulkan.Core10.Image.ImageCreateInfo' structure used to create
--     @image@
--
-- -   If the @pNext@ chain includes a
--     'Vulkan.Core11.Promoted_From_VK_KHR_maintenance2.ImageViewUsageCreateInfo'
--     structure, @image@ was created with a
--     'Vulkan.Core12.Promoted_From_VK_EXT_separate_stencil_usage.ImageStencilUsageCreateInfo'
--     structure included in the @pNext@ chain of
--     'Vulkan.Core10.Image.ImageCreateInfo', and
--     @subResourceRange.aspectMask@ includes
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_STENCIL_BIT',
--     the @usage@ member of the
--     'Vulkan.Core11.Promoted_From_VK_KHR_maintenance2.ImageViewUsageCreateInfo'
--     instance /must/ not include any bits that were not set in the
--     @usage@ member of the
--     'Vulkan.Core12.Promoted_From_VK_EXT_separate_stencil_usage.ImageStencilUsageCreateInfo'
--     structure used to create @image@
--
-- -   If the @pNext@ chain includes a
--     'Vulkan.Core11.Promoted_From_VK_KHR_maintenance2.ImageViewUsageCreateInfo'
--     structure, @image@ was created with a
--     'Vulkan.Core12.Promoted_From_VK_EXT_separate_stencil_usage.ImageStencilUsageCreateInfo'
--     structure included in the @pNext@ chain of
--     'Vulkan.Core10.Image.ImageCreateInfo', and
--     @subResourceRange.aspectMask@ includes bits other than
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_STENCIL_BIT',
--     the @usage@ member of the
--     'Vulkan.Core11.Promoted_From_VK_KHR_maintenance2.ImageViewUsageCreateInfo'
--     structure /must/ not include any bits that were not set in the
--     @usage@ member of the 'Vulkan.Core10.Image.ImageCreateInfo'
--     structure used to create @image@
--
-- -   If @viewType@ is
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE' and
--     @subresourceRange.layerCount@ is not
--     'Vulkan.Core10.APIConstants.REMAINING_ARRAY_LAYERS',
--     @subresourceRange.layerCount@ /must/ be @6@
--
-- -   If @viewType@ is
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE_ARRAY' and
--     @subresourceRange.layerCount@ is not
--     'Vulkan.Core10.APIConstants.REMAINING_ARRAY_LAYERS',
--     @subresourceRange.layerCount@ /must/ be a multiple of @6@
--
-- -   If @viewType@ is
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE' and
--     @subresourceRange.layerCount@ is
--     'Vulkan.Core10.APIConstants.REMAINING_ARRAY_LAYERS', the remaining
--     number of layers /must/ be @6@
--
-- -   If @viewType@ is
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE_ARRAY' and
--     @subresourceRange.layerCount@ is
--     'Vulkan.Core10.APIConstants.REMAINING_ARRAY_LAYERS', the remaining
--     number of layers /must/ be a multiple of @6@
--
-- == Valid Usage (Implicit)
--
-- -   @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_IMAGE_VIEW_CREATE_INFO'
--
-- -   Each @pNext@ member of any structure (including this one) in the
--     @pNext@ chain /must/ be either @NULL@ or a pointer to a valid
--     instance of
--     'Vulkan.Extensions.VK_EXT_astc_decode_mode.ImageViewASTCDecodeModeEXT',
--     'Vulkan.Core11.Promoted_From_VK_KHR_maintenance2.ImageViewUsageCreateInfo',
--     or
--     'Vulkan.Core11.Promoted_From_VK_KHR_sampler_ycbcr_conversion.SamplerYcbcrConversionInfo'
--
-- -   The @sType@ value of each struct in the @pNext@ chain /must/ be
--     unique
--
-- -   @flags@ /must/ be a valid combination of
--     'Vulkan.Core10.Enums.ImageViewCreateFlagBits.ImageViewCreateFlagBits'
--     values
--
-- -   @image@ /must/ be a valid 'Vulkan.Core10.Handles.Image' handle
--
-- -   @viewType@ /must/ be a valid
--     'Vulkan.Core10.Enums.ImageViewType.ImageViewType' value
--
-- -   @format@ /must/ be a valid 'Vulkan.Core10.Enums.Format.Format' value
--
-- -   @components@ /must/ be a valid 'ComponentMapping' structure
--
-- -   @subresourceRange@ /must/ be a valid
--     'Vulkan.Core10.SharedTypes.ImageSubresourceRange' structure
--
-- = See Also
--
-- 'ComponentMapping', 'Vulkan.Core10.Enums.Format.Format',
-- 'Vulkan.Core10.Handles.Image',
-- 'Vulkan.Core10.SharedTypes.ImageSubresourceRange',
-- 'Vulkan.Core10.Enums.ImageViewCreateFlagBits.ImageViewCreateFlags',
-- 'Vulkan.Core10.Enums.ImageViewType.ImageViewType',
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'createImageView'
data ImageViewCreateInfo (es :: [Type]) = ImageViewCreateInfo
  { -- | @pNext@ is @NULL@ or a pointer to an extension-specific structure.
    ImageViewCreateInfo es -> Chain es
next :: Chain es
  , -- | @flags@ is a bitmask of
    -- 'Vulkan.Core10.Enums.ImageViewCreateFlagBits.ImageViewCreateFlagBits'
    -- describing additional parameters of the image view.
    ImageViewCreateInfo es -> ImageViewCreateFlags
flags :: ImageViewCreateFlags
  , -- | @image@ is a 'Vulkan.Core10.Handles.Image' on which the view will be
    -- created.
    ImageViewCreateInfo es -> Image
image :: Image
  , -- | @viewType@ is a 'Vulkan.Core10.Enums.ImageViewType.ImageViewType' value
    -- specifying the type of the image view.
    ImageViewCreateInfo es -> ImageViewType
viewType :: ImageViewType
  , -- | @format@ is a 'Vulkan.Core10.Enums.Format.Format' describing the format
    -- and type used to interpret texel blocks in the image.
    ImageViewCreateInfo es -> Format
format :: Format
  , -- | @components@ is a 'ComponentMapping' specifies a remapping of color
    -- components (or of depth or stencil components after they have been
    -- converted into color components).
    ImageViewCreateInfo es -> ComponentMapping
components :: ComponentMapping
  , -- | @subresourceRange@ is a
    -- 'Vulkan.Core10.SharedTypes.ImageSubresourceRange' selecting the set of
    -- mipmap levels and array layers to be accessible to the view.
    ImageViewCreateInfo es -> ImageSubresourceRange
subresourceRange :: ImageSubresourceRange
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ImageViewCreateInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (ImageViewCreateInfo es)

instance Extensible ImageViewCreateInfo where
  extensibleType :: StructureType
extensibleType = StructureType
STRUCTURE_TYPE_IMAGE_VIEW_CREATE_INFO
  setNext :: ImageViewCreateInfo ds -> Chain es -> ImageViewCreateInfo es
setNext x :: ImageViewCreateInfo ds
x next :: Chain es
next = ImageViewCreateInfo ds
x{$sel:next:ImageViewCreateInfo :: Chain es
next = Chain es
next}
  getNext :: ImageViewCreateInfo es -> Chain es
getNext ImageViewCreateInfo{..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends ImageViewCreateInfo e => b) -> Maybe b
  extends :: proxy e -> (Extends ImageViewCreateInfo e => b) -> Maybe b
extends _ f :: Extends ImageViewCreateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable ImageViewASTCDecodeModeEXT) =>
Maybe (e :~: ImageViewASTCDecodeModeEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ImageViewASTCDecodeModeEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends ImageViewCreateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable SamplerYcbcrConversionInfo) =>
Maybe (e :~: SamplerYcbcrConversionInfo)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @SamplerYcbcrConversionInfo = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends ImageViewCreateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable ImageViewUsageCreateInfo) =>
Maybe (e :~: ImageViewUsageCreateInfo)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ImageViewUsageCreateInfo = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends ImageViewCreateInfo e => b
f
    | Bool
otherwise = Maybe b
forall a. Maybe a
Nothing

instance (Extendss ImageViewCreateInfo es, PokeChain es) => ToCStruct (ImageViewCreateInfo es) where
  withCStruct :: ImageViewCreateInfo es
-> (Ptr (ImageViewCreateInfo es) -> IO b) -> IO b
withCStruct x :: ImageViewCreateInfo es
x f :: Ptr (ImageViewCreateInfo es) -> IO b
f = Int -> Int -> (Ptr (ImageViewCreateInfo es) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 80 8 ((Ptr (ImageViewCreateInfo es) -> IO b) -> IO b)
-> (Ptr (ImageViewCreateInfo es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr (ImageViewCreateInfo es)
p -> Ptr (ImageViewCreateInfo es)
-> ImageViewCreateInfo es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (ImageViewCreateInfo es)
p ImageViewCreateInfo es
x (Ptr (ImageViewCreateInfo es) -> IO b
f Ptr (ImageViewCreateInfo es)
p)
  pokeCStruct :: Ptr (ImageViewCreateInfo es)
-> ImageViewCreateInfo es -> IO b -> IO b
pokeCStruct p :: Ptr (ImageViewCreateInfo es)
p ImageViewCreateInfo{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageViewCreateInfo es)
p Ptr (ImageViewCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_VIEW_CREATE_INFO)
    Ptr ()
pNext'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageViewCreateInfo es)
p Ptr (ImageViewCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext''
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ImageViewCreateFlags -> ImageViewCreateFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageViewCreateInfo es)
p Ptr (ImageViewCreateInfo es) -> Int -> Ptr ImageViewCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr ImageViewCreateFlags)) (ImageViewCreateFlags
flags)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Image -> Image -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageViewCreateInfo es)
p Ptr (ImageViewCreateInfo es) -> Int -> Ptr Image
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Image)) (Image
image)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ImageViewType -> ImageViewType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageViewCreateInfo es)
p Ptr (ImageViewCreateInfo es) -> Int -> Ptr ImageViewType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr ImageViewType)) (ImageViewType
viewType)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Format -> Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageViewCreateInfo es)
p Ptr (ImageViewCreateInfo es) -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 36 :: Ptr Format)) (Format
format)
    ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ComponentMapping -> ComponentMapping -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr (ImageViewCreateInfo es)
p Ptr (ImageViewCreateInfo es) -> Int -> Ptr ComponentMapping
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr ComponentMapping)) (ComponentMapping
components) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
    ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ImageSubresourceRange -> ImageSubresourceRange -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr (ImageViewCreateInfo es)
p Ptr (ImageViewCreateInfo es) -> Int -> Ptr ImageSubresourceRange
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 56 :: Ptr ImageSubresourceRange)) (ImageSubresourceRange
subresourceRange) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = 80
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr (ImageViewCreateInfo es) -> IO b -> IO b
pokeZeroCStruct p :: Ptr (ImageViewCreateInfo es)
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageViewCreateInfo es)
p Ptr (ImageViewCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_VIEW_CREATE_INFO)
    Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ forall a. PokeChain es => (Ptr (Chain es) -> IO a) -> IO a
forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageViewCreateInfo es)
p Ptr (ImageViewCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext'
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Image -> Image -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageViewCreateInfo es)
p Ptr (ImageViewCreateInfo es) -> Int -> Ptr Image
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Image)) (Image
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ImageViewType -> ImageViewType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageViewCreateInfo es)
p Ptr (ImageViewCreateInfo es) -> Int -> Ptr ImageViewType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr ImageViewType)) (ImageViewType
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Format -> Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageViewCreateInfo es)
p Ptr (ImageViewCreateInfo es) -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 36 :: Ptr Format)) (Format
forall a. Zero a => a
zero)
    ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ComponentMapping -> ComponentMapping -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr (ImageViewCreateInfo es)
p Ptr (ImageViewCreateInfo es) -> Int -> Ptr ComponentMapping
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr ComponentMapping)) (ComponentMapping
forall a. Zero a => a
zero) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
    ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ImageSubresourceRange -> ImageSubresourceRange -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr (ImageViewCreateInfo es)
p Ptr (ImageViewCreateInfo es) -> Int -> Ptr ImageSubresourceRange
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 56 :: Ptr ImageSubresourceRange)) (ImageSubresourceRange
forall a. Zero a => a
zero) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f

instance (Extendss ImageViewCreateInfo es, PeekChain es) => FromCStruct (ImageViewCreateInfo es) where
  peekCStruct :: Ptr (ImageViewCreateInfo es) -> IO (ImageViewCreateInfo es)
peekCStruct p :: Ptr (ImageViewCreateInfo es)
p = do
    Ptr ()
pNext <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (ImageViewCreateInfo es)
p Ptr (ImageViewCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ())))
    Chain es
next <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
    ImageViewCreateFlags
flags <- Ptr ImageViewCreateFlags -> IO ImageViewCreateFlags
forall a. Storable a => Ptr a -> IO a
peek @ImageViewCreateFlags ((Ptr (ImageViewCreateInfo es)
p Ptr (ImageViewCreateInfo es) -> Int -> Ptr ImageViewCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr ImageViewCreateFlags))
    Image
image <- Ptr Image -> IO Image
forall a. Storable a => Ptr a -> IO a
peek @Image ((Ptr (ImageViewCreateInfo es)
p Ptr (ImageViewCreateInfo es) -> Int -> Ptr Image
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Image))
    ImageViewType
viewType <- Ptr ImageViewType -> IO ImageViewType
forall a. Storable a => Ptr a -> IO a
peek @ImageViewType ((Ptr (ImageViewCreateInfo es)
p Ptr (ImageViewCreateInfo es) -> Int -> Ptr ImageViewType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr ImageViewType))
    Format
format <- Ptr Format -> IO Format
forall a. Storable a => Ptr a -> IO a
peek @Format ((Ptr (ImageViewCreateInfo es)
p Ptr (ImageViewCreateInfo es) -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 36 :: Ptr Format))
    ComponentMapping
components <- Ptr ComponentMapping -> IO ComponentMapping
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ComponentMapping ((Ptr (ImageViewCreateInfo es)
p Ptr (ImageViewCreateInfo es) -> Int -> Ptr ComponentMapping
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr ComponentMapping))
    ImageSubresourceRange
subresourceRange <- Ptr ImageSubresourceRange -> IO ImageSubresourceRange
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ImageSubresourceRange ((Ptr (ImageViewCreateInfo es)
p Ptr (ImageViewCreateInfo es) -> Int -> Ptr ImageSubresourceRange
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 56 :: Ptr ImageSubresourceRange))
    ImageViewCreateInfo es -> IO (ImageViewCreateInfo es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ImageViewCreateInfo es -> IO (ImageViewCreateInfo es))
-> ImageViewCreateInfo es -> IO (ImageViewCreateInfo es)
forall a b. (a -> b) -> a -> b
$ Chain es
-> ImageViewCreateFlags
-> Image
-> ImageViewType
-> Format
-> ComponentMapping
-> ImageSubresourceRange
-> ImageViewCreateInfo es
forall (es :: [*]).
Chain es
-> ImageViewCreateFlags
-> Image
-> ImageViewType
-> Format
-> ComponentMapping
-> ImageSubresourceRange
-> ImageViewCreateInfo es
ImageViewCreateInfo
             Chain es
next ImageViewCreateFlags
flags Image
image ImageViewType
viewType Format
format ComponentMapping
components ImageSubresourceRange
subresourceRange

instance es ~ '[] => Zero (ImageViewCreateInfo es) where
  zero :: ImageViewCreateInfo es
zero = Chain es
-> ImageViewCreateFlags
-> Image
-> ImageViewType
-> Format
-> ComponentMapping
-> ImageSubresourceRange
-> ImageViewCreateInfo es
forall (es :: [*]).
Chain es
-> ImageViewCreateFlags
-> Image
-> ImageViewType
-> Format
-> ComponentMapping
-> ImageSubresourceRange
-> ImageViewCreateInfo es
ImageViewCreateInfo
           ()
           ImageViewCreateFlags
forall a. Zero a => a
zero
           Image
forall a. Zero a => a
zero
           ImageViewType
forall a. Zero a => a
zero
           Format
forall a. Zero a => a
zero
           ComponentMapping
forall a. Zero a => a
zero
           ImageSubresourceRange
forall a. Zero a => a
zero