{-# language CPP #-}
-- | = Name
--
-- VK_EXT_swapchain_maintenance1 - device extension
--
-- == VK_EXT_swapchain_maintenance1
--
-- [__Name String__]
--     @VK_EXT_swapchain_maintenance1@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     276
--
-- [__Revision__]
--     1
--
-- [__Ratification Status__]
--     Not ratified
--
-- [__Extension and Version Dependencies__]
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_swapchain VK_KHR_swapchain>
--     and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_surface_maintenance1 VK_EXT_surface_maintenance1>
--     and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_get_physical_device_properties2 VK_KHR_get_physical_device_properties2>
--
-- [__Contact__]
--
--     -   Shahbaz Youssefi
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_EXT_swapchain_maintenance1] @syoussefi%0A*Here describe the issue or question you have about the VK_EXT_swapchain_maintenance1 extension* >
--
-- [__Extension Proposal__]
--     <https://github.com/KhronosGroup/Vulkan-Docs/tree/main/proposals/VK_EXT_swapchain_maintenance1.adoc VK_EXT_swapchain_maintenance1>
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2022-10-28
--
-- [__Contributors__]
--
--     -   Jeff Juliano, NVIDIA
--
--     -   Shahbaz Youssefi, Google
--
--     -   Chris Forbes, Google
--
--     -   Ian Elliott, Google
--
--     -   Yiwei Zhang, Google
--
--     -   Charlie Lao, Google
--
--     -   Lina Versace, Google
--
--     -   Ralph Potter, Samsung
--
--     -   Igor Nazarov, Samsung
--
--     -   Hyunchang Kim, Samsung
--
--     -   Suenghwan Lee, Samsung
--
--     -   Munseong Kang, Samsung
--
--     -   Joonyong Park, Samsung
--
--     -   Hans-Kristian Arntzen, Valve
--
--     -   Lisa Wu, Arm
--
--     -   Daniel Stone, Collabora
--
--     -   Pan Gao, Huawei
--
-- == Description
--
-- @VK_EXT_swapchain_maintenance1@ adds a collection of window system
-- integration features that were intentionally left out or overlooked in
-- the original @VK_KHR_swapchain@ extension.
--
-- The new features are as follows:
--
-- -   Specify a fence that will be signaled when the resources associated
--     with a present operation /can/ be safely destroyed.
--
-- -   Allow changing the present mode a swapchain is using at per-present
--     granularity.
--
-- -   Allow applications to define the behavior when presenting a
--     swapchain image to a surface with different dimensions than the
--     image. Using this feature /may/ allow implementations to avoid
--     returning 'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DATE_KHR' in this
--     situation.
--
-- -   Allow applications to defer swapchain memory allocation for improved
--     startup time and memory footprint.
--
-- -   Allow applications to release previously acquired images without
--     presenting them.
--
-- == New Commands
--
-- -   'releaseSwapchainImagesEXT'
--
-- == New Structures
--
-- -   'ReleaseSwapchainImagesInfoEXT'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDeviceSwapchainMaintenance1FeaturesEXT'
--
-- -   Extending 'Vulkan.Extensions.VK_KHR_swapchain.PresentInfoKHR':
--
--     -   'SwapchainPresentFenceInfoEXT'
--
--     -   'SwapchainPresentModeInfoEXT'
--
-- -   Extending
--     'Vulkan.Extensions.VK_KHR_swapchain.SwapchainCreateInfoKHR':
--
--     -   'SwapchainPresentModesCreateInfoEXT'
--
--     -   'SwapchainPresentScalingCreateInfoEXT'
--
-- == New Enum Constants
--
-- -   'EXT_SWAPCHAIN_MAINTENANCE_1_EXTENSION_NAME'
--
-- -   'EXT_SWAPCHAIN_MAINTENANCE_1_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_SWAPCHAIN_MAINTENANCE_1_FEATURES_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_RELEASE_SWAPCHAIN_IMAGES_INFO_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_SWAPCHAIN_PRESENT_FENCE_INFO_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_SWAPCHAIN_PRESENT_MODES_CREATE_INFO_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_SWAPCHAIN_PRESENT_MODE_INFO_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_SWAPCHAIN_PRESENT_SCALING_CREATE_INFO_EXT'
--
-- -   Extending
--     'Vulkan.Extensions.VK_KHR_swapchain.SwapchainCreateFlagBitsKHR':
--
--     -   'Vulkan.Extensions.VK_KHR_swapchain.SWAPCHAIN_CREATE_DEFERRED_MEMORY_ALLOCATION_BIT_EXT'
--
-- == Version History
--
-- -   Revision 0, 2019-05-28
--
--     -   Initial revisions
--
-- -   Revision 1, 2022-08-21 (Shahbaz Youssefi)
--
--     -   Add functionality and complete spec
--
-- == See Also
--
-- 'PhysicalDeviceSwapchainMaintenance1FeaturesEXT',
-- 'ReleaseSwapchainImagesInfoEXT', 'SwapchainPresentFenceInfoEXT',
-- 'SwapchainPresentModeInfoEXT', 'SwapchainPresentModesCreateInfoEXT',
-- 'SwapchainPresentScalingCreateInfoEXT', 'releaseSwapchainImagesEXT'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_EXT_swapchain_maintenance1 Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_EXT_swapchain_maintenance1  ( releaseSwapchainImagesEXT
                                                        , PhysicalDeviceSwapchainMaintenance1FeaturesEXT(..)
                                                        , SwapchainPresentFenceInfoEXT(..)
                                                        , SwapchainPresentModesCreateInfoEXT(..)
                                                        , SwapchainPresentModeInfoEXT(..)
                                                        , SwapchainPresentScalingCreateInfoEXT(..)
                                                        , ReleaseSwapchainImagesInfoEXT(..)
                                                        , EXT_SWAPCHAIN_MAINTENANCE_1_SPEC_VERSION
                                                        , pattern EXT_SWAPCHAIN_MAINTENANCE_1_SPEC_VERSION
                                                        , EXT_SWAPCHAIN_MAINTENANCE_1_EXTENSION_NAME
                                                        , pattern EXT_SWAPCHAIN_MAINTENANCE_1_EXTENSION_NAME
                                                        , SwapchainKHR(..)
                                                        , PresentModeKHR(..)
                                                        , SwapchainCreateFlagBitsKHR(..)
                                                        , SwapchainCreateFlagsKHR
                                                        , PresentScalingFlagBitsEXT(..)
                                                        , PresentScalingFlagsEXT
                                                        , PresentGravityFlagBitsEXT(..)
                                                        , PresentGravityFlagsEXT
                                                        ) where

import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytes)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import Vulkan.CStruct.Utils (advancePtrBytes)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkReleaseSwapchainImagesEXT))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Core10.Handles (Fence)
import Vulkan.Extensions.VK_EXT_surface_maintenance1 (PresentGravityFlagsEXT)
import Vulkan.Extensions.VK_KHR_surface (PresentModeKHR)
import Vulkan.Extensions.VK_EXT_surface_maintenance1 (PresentScalingFlagsEXT)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Extensions.Handles (SwapchainKHR)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_SWAPCHAIN_MAINTENANCE_1_FEATURES_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_RELEASE_SWAPCHAIN_IMAGES_INFO_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SWAPCHAIN_PRESENT_FENCE_INFO_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SWAPCHAIN_PRESENT_MODES_CREATE_INFO_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SWAPCHAIN_PRESENT_MODE_INFO_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SWAPCHAIN_PRESENT_SCALING_CREATE_INFO_EXT))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Extensions.VK_EXT_surface_maintenance1 (PresentGravityFlagBitsEXT(..))
import Vulkan.Extensions.VK_EXT_surface_maintenance1 (PresentGravityFlagsEXT)
import Vulkan.Extensions.VK_KHR_surface (PresentModeKHR(..))
import Vulkan.Extensions.VK_EXT_surface_maintenance1 (PresentScalingFlagBitsEXT(..))
import Vulkan.Extensions.VK_EXT_surface_maintenance1 (PresentScalingFlagsEXT)
import Vulkan.Extensions.VK_KHR_swapchain (SwapchainCreateFlagBitsKHR(..))
import Vulkan.Extensions.VK_KHR_swapchain (SwapchainCreateFlagsKHR)
import Vulkan.Extensions.Handles (SwapchainKHR(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkReleaseSwapchainImagesEXT
  :: FunPtr (Ptr Device_T -> Ptr ReleaseSwapchainImagesInfoEXT -> IO Result) -> Ptr Device_T -> Ptr ReleaseSwapchainImagesInfoEXT -> IO Result

-- | vkReleaseSwapchainImagesEXT - Release previously acquired but unused
-- images
--
-- = Description
--
-- Only images that are not in use by the device /can/ be released.
--
-- Releasing images is a read-only operation that will not affect the
-- content of the released images. Upon reacquiring the image, the image
-- contents and its layout will be the same as they were prior to releasing
-- it. However, if a mechanism other than Vulkan is used to modify the
-- platform window associated with the swapchain, the content of all
-- presentable images in the swapchain becomes undefined.
--
-- Note
--
-- This functionality is useful during swapchain recreation, where acquired
-- images from the old swapchain can be released instead of presented.
--
-- == 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_SURFACE_LOST_KHR'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_swapchain_maintenance1 VK_EXT_swapchain_maintenance1>,
-- 'Vulkan.Core10.Handles.Device', 'ReleaseSwapchainImagesInfoEXT'
releaseSwapchainImagesEXT :: forall io
                           . (MonadIO io)
                          => -- | @device@ is the device associated with
                             -- 'ReleaseSwapchainImagesInfoEXT'::@swapchain@.
                             --
                             -- #VUID-vkReleaseSwapchainImagesEXT-device-parameter# @device@ /must/ be a
                             -- valid 'Vulkan.Core10.Handles.Device' handle
                             Device
                          -> -- | @pReleaseInfo@ is a pointer to a 'ReleaseSwapchainImagesInfoEXT'
                             -- structure containing parameters of the release.
                             --
                             -- #VUID-vkReleaseSwapchainImagesEXT-pReleaseInfo-parameter# @pReleaseInfo@
                             -- /must/ be a valid pointer to a valid 'ReleaseSwapchainImagesInfoEXT'
                             -- structure
                             ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
                          -> io ()
releaseSwapchainImagesEXT :: forall (io :: * -> *).
MonadIO io =>
Device
-> ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT) -> io ()
releaseSwapchainImagesEXT Device
device "releaseInfo" ::: ReleaseSwapchainImagesInfoEXT
releaseInfo = IO () -> io ()
forall a. IO a -> io a
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 vkReleaseSwapchainImagesEXTPtr :: FunPtr
  (Ptr Device_T
   -> Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
   -> IO Result)
vkReleaseSwapchainImagesEXTPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
      -> IO Result)
pVkReleaseSwapchainImagesEXT (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
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
   -> Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
   -> IO Result)
vkReleaseSwapchainImagesEXTPtr FunPtr
  (Ptr Device_T
   -> Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
   -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkReleaseSwapchainImagesEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkReleaseSwapchainImagesEXT' :: Ptr Device_T
-> Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
-> IO Result
vkReleaseSwapchainImagesEXT' = FunPtr
  (Ptr Device_T
   -> Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
   -> IO Result)
-> Ptr Device_T
-> Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
-> IO Result
mkVkReleaseSwapchainImagesEXT FunPtr
  (Ptr Device_T
   -> Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
   -> IO Result)
vkReleaseSwapchainImagesEXTPtr
  Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
pReleaseInfo <- ((Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT) -> IO ())
 -> IO ())
-> ContT
     () IO (Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT))
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT) -> IO ())
  -> IO ())
 -> ContT
      () IO (Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)))
-> ((Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
     -> IO ())
    -> IO ())
-> ContT
     () IO (Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT))
forall a b. (a -> b) -> a -> b
$ ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
-> (Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT) -> IO ())
-> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
forall b.
("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
-> (Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT) -> IO b)
-> IO b
withCStruct ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT
releaseInfo)
  Result
r <- IO Result -> ContT () IO Result
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT () IO Result)
-> IO Result -> ContT () IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkReleaseSwapchainImagesEXT" (Ptr Device_T
-> Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
-> IO Result
vkReleaseSwapchainImagesEXT'
                                                                (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                                Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
pReleaseInfo)
  IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
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 ()
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))


-- | VkPhysicalDeviceSwapchainMaintenance1FeaturesEXT - Structure describing
-- whether implementation supports swapchain maintenance1 functionality
--
-- = Members
--
-- This structure describes the following feature:
--
-- = Description
--
-- If the 'PhysicalDeviceSwapchainMaintenance1FeaturesEXT' structure is
-- included in the @pNext@ chain of the
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2'
-- structure passed to
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceFeatures2',
-- it is filled in to indicate whether each corresponding feature is
-- supported. 'PhysicalDeviceSwapchainMaintenance1FeaturesEXT' /can/ also
-- be used in the @pNext@ chain of 'Vulkan.Core10.Device.DeviceCreateInfo'
-- to selectively enable these features.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_swapchain_maintenance1 VK_EXT_swapchain_maintenance1>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceSwapchainMaintenance1FeaturesEXT = PhysicalDeviceSwapchainMaintenance1FeaturesEXT
  { -- | #features-swapchainMaintenance1# @swapchainMaintenance1@ indicates that
    -- the implementation supports the following:
    --
    -- -   'SwapchainPresentFenceInfoEXT', specifying a fence that is signaled
    --     when the resources associated with a present operation /can/ be
    --     safely destroyed.
    --
    -- -   'SwapchainPresentModesCreateInfoEXT' and
    --     'SwapchainPresentModeInfoEXT', allowing the swapchain to switch
    --     present modes without a need for recreation.
    --
    -- -   'SwapchainPresentScalingCreateInfoEXT', specifying the scaling
    --     behavior of the swapchain in presence of window resizing.
    --
    -- -   The
    --     'Vulkan.Extensions.VK_KHR_swapchain.SWAPCHAIN_CREATE_DEFERRED_MEMORY_ALLOCATION_BIT_EXT'
    --     flag, allowing the implementation to defer the allocation of
    --     swapchain image memory until first acquisition.
    --
    -- -   'releaseSwapchainImagesEXT', allowing acquired swapchain images to
    --     be released without presenting them.
    PhysicalDeviceSwapchainMaintenance1FeaturesEXT -> Bool
swapchainMaintenance1 :: Bool }
  deriving (Typeable, PhysicalDeviceSwapchainMaintenance1FeaturesEXT
-> PhysicalDeviceSwapchainMaintenance1FeaturesEXT -> Bool
(PhysicalDeviceSwapchainMaintenance1FeaturesEXT
 -> PhysicalDeviceSwapchainMaintenance1FeaturesEXT -> Bool)
-> (PhysicalDeviceSwapchainMaintenance1FeaturesEXT
    -> PhysicalDeviceSwapchainMaintenance1FeaturesEXT -> Bool)
-> Eq PhysicalDeviceSwapchainMaintenance1FeaturesEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PhysicalDeviceSwapchainMaintenance1FeaturesEXT
-> PhysicalDeviceSwapchainMaintenance1FeaturesEXT -> Bool
== :: PhysicalDeviceSwapchainMaintenance1FeaturesEXT
-> PhysicalDeviceSwapchainMaintenance1FeaturesEXT -> Bool
$c/= :: PhysicalDeviceSwapchainMaintenance1FeaturesEXT
-> PhysicalDeviceSwapchainMaintenance1FeaturesEXT -> Bool
/= :: PhysicalDeviceSwapchainMaintenance1FeaturesEXT
-> PhysicalDeviceSwapchainMaintenance1FeaturesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceSwapchainMaintenance1FeaturesEXT)
#endif
deriving instance Show PhysicalDeviceSwapchainMaintenance1FeaturesEXT

instance ToCStruct PhysicalDeviceSwapchainMaintenance1FeaturesEXT where
  withCStruct :: forall b.
PhysicalDeviceSwapchainMaintenance1FeaturesEXT
-> (Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT -> IO b)
-> IO b
withCStruct PhysicalDeviceSwapchainMaintenance1FeaturesEXT
x Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT -> IO b
f = Int
-> (Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT -> IO b)
 -> IO b)
-> (Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT
p -> Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT
-> PhysicalDeviceSwapchainMaintenance1FeaturesEXT -> IO b -> IO b
forall b.
Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT
-> PhysicalDeviceSwapchainMaintenance1FeaturesEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT
p PhysicalDeviceSwapchainMaintenance1FeaturesEXT
x (Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT -> IO b
f Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT
p)
  pokeCStruct :: forall b.
Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT
-> PhysicalDeviceSwapchainMaintenance1FeaturesEXT -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT
p PhysicalDeviceSwapchainMaintenance1FeaturesEXT{Bool
$sel:swapchainMaintenance1:PhysicalDeviceSwapchainMaintenance1FeaturesEXT :: PhysicalDeviceSwapchainMaintenance1FeaturesEXT -> Bool
swapchainMaintenance1 :: Bool
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT
p Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_SWAPCHAIN_MAINTENANCE_1_FEATURES_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT
p Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT
p Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
swapchainMaintenance1))
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT
p Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_SWAPCHAIN_MAINTENANCE_1_FEATURES_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT
p Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT
p Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct PhysicalDeviceSwapchainMaintenance1FeaturesEXT where
  peekCStruct :: Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT
-> IO PhysicalDeviceSwapchainMaintenance1FeaturesEXT
peekCStruct Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT
p = do
    Bool32
swapchainMaintenance1 <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT
p Ptr PhysicalDeviceSwapchainMaintenance1FeaturesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
    PhysicalDeviceSwapchainMaintenance1FeaturesEXT
-> IO PhysicalDeviceSwapchainMaintenance1FeaturesEXT
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceSwapchainMaintenance1FeaturesEXT
 -> IO PhysicalDeviceSwapchainMaintenance1FeaturesEXT)
-> PhysicalDeviceSwapchainMaintenance1FeaturesEXT
-> IO PhysicalDeviceSwapchainMaintenance1FeaturesEXT
forall a b. (a -> b) -> a -> b
$ Bool -> PhysicalDeviceSwapchainMaintenance1FeaturesEXT
PhysicalDeviceSwapchainMaintenance1FeaturesEXT
             (Bool32 -> Bool
bool32ToBool Bool32
swapchainMaintenance1)

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

instance Zero PhysicalDeviceSwapchainMaintenance1FeaturesEXT where
  zero :: PhysicalDeviceSwapchainMaintenance1FeaturesEXT
zero = Bool -> PhysicalDeviceSwapchainMaintenance1FeaturesEXT
PhysicalDeviceSwapchainMaintenance1FeaturesEXT
           Bool
forall a. Zero a => a
zero


-- | VkSwapchainPresentFenceInfoEXT - Fences associated with a
-- vkQueuePresentKHR operation
--
-- = Description
--
-- The set of /queue operations/ defined by queuing an image for
-- presentation, as well as operations performed by the presentation engine
-- access the payloads of objects associated with the presentation
-- operation. The associated objects include:
--
-- -   The swapchain image, its implicitly bound memory, and any other
--     resources bound to that memory.
--
-- -   The wait semaphores specified when queuing the image for
--     presentation.
--
-- The application /can/ provide a fence that the implementation will
-- signal when all such queue operations have completed and the
-- presentation engine has taken a reference to the payload of any objects
-- it accesses as part of the present operation. For all binary wait
-- semaphores imported by the presentation engine using the equivalent of
-- reference transference, as described in
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-semaphores-importing Importing Semaphore Payloads>,
-- this fence /must/ not signal until all such semaphore payloads have been
-- reset by the presentation engine.
--
-- The application /can/ destroy the wait semaphores associated with a
-- given presentation operation when at least one of the associated fences
-- is signaled, and /can/ destroy the swapchain when the fences associated
-- with all past presentation requests referring to that swapchain have
-- signaled.
--
-- Fences associated with presentations to the same swapchain on the same
-- 'Vulkan.Core10.Handles.Queue' /must/ be signaled in the same order as
-- the present operations.
--
-- To specify a fence for each swapchain in a present operation, include
-- the 'SwapchainPresentFenceInfoEXT' structure in the @pNext@ chain of the
-- 'Vulkan.Extensions.VK_KHR_swapchain.PresentInfoKHR' structure.
--
-- == Valid Usage
--
-- -   #VUID-VkSwapchainPresentFenceInfoEXT-swapchainCount-07757#
--     @swapchainCount@ /must/ be equal to
--     'Vulkan.Extensions.VK_KHR_swapchain.PresentInfoKHR'::@swapchainCount@
--
-- -   #VUID-VkSwapchainPresentFenceInfoEXT-pFences-07758# Each element of
--     @pFences@ /must/ be unsignaled
--
-- -   #VUID-VkSwapchainPresentFenceInfoEXT-pFences-07759# Each element of
--     @pFences@ /must/ not be associated with any other queue command that
--     has not yet completed execution on that queue
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkSwapchainPresentFenceInfoEXT-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_SWAPCHAIN_PRESENT_FENCE_INFO_EXT'
--
-- -   #VUID-VkSwapchainPresentFenceInfoEXT-pFences-parameter# @pFences@
--     /must/ be a valid pointer to an array of @swapchainCount@ valid
--     'Vulkan.Core10.Handles.Fence' handles
--
-- -   #VUID-VkSwapchainPresentFenceInfoEXT-swapchainCount-arraylength#
--     @swapchainCount@ /must/ be greater than @0@
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_swapchain_maintenance1 VK_EXT_swapchain_maintenance1>,
-- 'Vulkan.Core10.Handles.Fence',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data SwapchainPresentFenceInfoEXT = SwapchainPresentFenceInfoEXT
  { -- | @pFences@ is a list of fences with @swapchainCount@ entries. Each entry
    -- /must/ be 'Vulkan.Core10.APIConstants.NULL_HANDLE' or the handle of a
    -- fence to signal when the relevant operations on the associated swapchain
    -- have completed.
    SwapchainPresentFenceInfoEXT -> Vector Fence
fences :: Vector Fence }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SwapchainPresentFenceInfoEXT)
#endif
deriving instance Show SwapchainPresentFenceInfoEXT

instance ToCStruct SwapchainPresentFenceInfoEXT where
  withCStruct :: forall b.
SwapchainPresentFenceInfoEXT
-> (Ptr SwapchainPresentFenceInfoEXT -> IO b) -> IO b
withCStruct SwapchainPresentFenceInfoEXT
x Ptr SwapchainPresentFenceInfoEXT -> IO b
f = Int -> (Ptr SwapchainPresentFenceInfoEXT -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((Ptr SwapchainPresentFenceInfoEXT -> IO b) -> IO b)
-> (Ptr SwapchainPresentFenceInfoEXT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr SwapchainPresentFenceInfoEXT
p -> Ptr SwapchainPresentFenceInfoEXT
-> SwapchainPresentFenceInfoEXT -> IO b -> IO b
forall b.
Ptr SwapchainPresentFenceInfoEXT
-> SwapchainPresentFenceInfoEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SwapchainPresentFenceInfoEXT
p SwapchainPresentFenceInfoEXT
x (Ptr SwapchainPresentFenceInfoEXT -> IO b
f Ptr SwapchainPresentFenceInfoEXT
p)
  pokeCStruct :: forall b.
Ptr SwapchainPresentFenceInfoEXT
-> SwapchainPresentFenceInfoEXT -> IO b -> IO b
pokeCStruct Ptr SwapchainPresentFenceInfoEXT
p SwapchainPresentFenceInfoEXT{Vector Fence
$sel:fences:SwapchainPresentFenceInfoEXT :: SwapchainPresentFenceInfoEXT -> Vector Fence
fences :: Vector Fence
..} 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 (m :: * -> *) a. Monad m => m a -> ContT b m a
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 SwapchainPresentFenceInfoEXT
p Ptr SwapchainPresentFenceInfoEXT -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SWAPCHAIN_PRESENT_FENCE_INFO_EXT)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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 SwapchainPresentFenceInfoEXT
p Ptr SwapchainPresentFenceInfoEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainPresentFenceInfoEXT
p Ptr SwapchainPresentFenceInfoEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Fence -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Fence -> Int) -> Vector Fence -> Int
forall a b. (a -> b) -> a -> b
$ (Vector Fence
fences)) :: Word32))
    Ptr Fence
pPFences' <- ((Ptr Fence -> IO b) -> IO b) -> ContT b IO (Ptr Fence)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Fence -> IO b) -> IO b) -> ContT b IO (Ptr Fence))
-> ((Ptr Fence -> IO b) -> IO b) -> ContT b IO (Ptr Fence)
forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @Fence ((Vector Fence -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Fence
fences)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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
$ (Int -> Fence -> IO ()) -> Vector Fence -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i Fence
e -> Ptr Fence -> Fence -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Fence
pPFences' Ptr Fence -> Int -> Ptr Fence
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Fence) (Fence
e)) (Vector Fence
fences)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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 Fence) -> Ptr Fence -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainPresentFenceInfoEXT
p Ptr SwapchainPresentFenceInfoEXT -> Int -> Ptr (Ptr Fence)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr Fence))) (Ptr Fence
pPFences')
    IO b -> ContT b IO b
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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 = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr SwapchainPresentFenceInfoEXT -> IO b -> IO b
pokeZeroCStruct Ptr SwapchainPresentFenceInfoEXT
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainPresentFenceInfoEXT
p Ptr SwapchainPresentFenceInfoEXT -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SWAPCHAIN_PRESENT_FENCE_INFO_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainPresentFenceInfoEXT
p Ptr SwapchainPresentFenceInfoEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO b
f

instance FromCStruct SwapchainPresentFenceInfoEXT where
  peekCStruct :: Ptr SwapchainPresentFenceInfoEXT -> IO SwapchainPresentFenceInfoEXT
peekCStruct Ptr SwapchainPresentFenceInfoEXT
p = do
    Word32
swapchainCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr SwapchainPresentFenceInfoEXT
p Ptr SwapchainPresentFenceInfoEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    Ptr Fence
pFences <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr Fence) ((Ptr SwapchainPresentFenceInfoEXT
p Ptr SwapchainPresentFenceInfoEXT -> Int -> Ptr (Ptr Fence)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr Fence)))
    Vector Fence
pFences' <- Int -> (Int -> IO Fence) -> IO (Vector Fence)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
swapchainCount) (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @Fence ((Ptr Fence
pFences Ptr Fence -> Int -> Ptr Fence
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Fence)))
    SwapchainPresentFenceInfoEXT -> IO SwapchainPresentFenceInfoEXT
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SwapchainPresentFenceInfoEXT -> IO SwapchainPresentFenceInfoEXT)
-> SwapchainPresentFenceInfoEXT -> IO SwapchainPresentFenceInfoEXT
forall a b. (a -> b) -> a -> b
$ Vector Fence -> SwapchainPresentFenceInfoEXT
SwapchainPresentFenceInfoEXT
             Vector Fence
pFences'

instance Zero SwapchainPresentFenceInfoEXT where
  zero :: SwapchainPresentFenceInfoEXT
zero = Vector Fence -> SwapchainPresentFenceInfoEXT
SwapchainPresentFenceInfoEXT
           Vector Fence
forall a. Monoid a => a
mempty


-- | VkSwapchainPresentModesCreateInfoEXT - All presentation modes usable by
-- the swapchain
--
-- == Valid Usage
--
-- -   #VUID-VkSwapchainPresentModesCreateInfoEXT-None-07762# Each entry in
--     pPresentModes /must/ be one of the
--     'Vulkan.Extensions.VK_KHR_surface.PresentModeKHR' values returned by
--     'Vulkan.Extensions.VK_KHR_surface.getPhysicalDeviceSurfacePresentModesKHR'
--     for the surface
--
-- -   #VUID-VkSwapchainPresentModesCreateInfoEXT-pPresentModes-07763# The
--     entries in pPresentModes /must/ be a subset of the present modes
--     returned in
--     'Vulkan.Extensions.VK_EXT_surface_maintenance1.SurfacePresentModeCompatibilityEXT'::@pPresentModes@,
--     given
--     'Vulkan.Extensions.VK_KHR_swapchain.SwapchainCreateInfoKHR'::@presentMode@
--     in
--     'Vulkan.Extensions.VK_EXT_surface_maintenance1.SurfacePresentModeEXT'
--
-- -   #VUID-VkSwapchainPresentModesCreateInfoEXT-presentMode-07764#
--     'Vulkan.Extensions.VK_KHR_swapchain.SwapchainCreateInfoKHR'::@presentMode@
--     /must/ be included in @pPresentModes@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkSwapchainPresentModesCreateInfoEXT-sType-sType# @sType@
--     /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_SWAPCHAIN_PRESENT_MODES_CREATE_INFO_EXT'
--
-- -   #VUID-VkSwapchainPresentModesCreateInfoEXT-pPresentModes-parameter#
--     @pPresentModes@ /must/ be a valid pointer to an array of
--     @presentModeCount@ valid
--     'Vulkan.Extensions.VK_KHR_surface.PresentModeKHR' values
--
-- -   #VUID-VkSwapchainPresentModesCreateInfoEXT-presentModeCount-arraylength#
--     @presentModeCount@ /must/ be greater than @0@
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_swapchain_maintenance1 VK_EXT_swapchain_maintenance1>,
-- 'Vulkan.Extensions.VK_KHR_surface.PresentModeKHR',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data SwapchainPresentModesCreateInfoEXT = SwapchainPresentModesCreateInfoEXT
  { -- | @pPresentModes@ is a list of presentation modes with @presentModeCount@
    -- entries
    SwapchainPresentModesCreateInfoEXT -> Vector PresentModeKHR
presentModes :: Vector PresentModeKHR }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SwapchainPresentModesCreateInfoEXT)
#endif
deriving instance Show SwapchainPresentModesCreateInfoEXT

instance ToCStruct SwapchainPresentModesCreateInfoEXT where
  withCStruct :: forall b.
SwapchainPresentModesCreateInfoEXT
-> (Ptr SwapchainPresentModesCreateInfoEXT -> IO b) -> IO b
withCStruct SwapchainPresentModesCreateInfoEXT
x Ptr SwapchainPresentModesCreateInfoEXT -> IO b
f = Int -> (Ptr SwapchainPresentModesCreateInfoEXT -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((Ptr SwapchainPresentModesCreateInfoEXT -> IO b) -> IO b)
-> (Ptr SwapchainPresentModesCreateInfoEXT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr SwapchainPresentModesCreateInfoEXT
p -> Ptr SwapchainPresentModesCreateInfoEXT
-> SwapchainPresentModesCreateInfoEXT -> IO b -> IO b
forall b.
Ptr SwapchainPresentModesCreateInfoEXT
-> SwapchainPresentModesCreateInfoEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SwapchainPresentModesCreateInfoEXT
p SwapchainPresentModesCreateInfoEXT
x (Ptr SwapchainPresentModesCreateInfoEXT -> IO b
f Ptr SwapchainPresentModesCreateInfoEXT
p)
  pokeCStruct :: forall b.
Ptr SwapchainPresentModesCreateInfoEXT
-> SwapchainPresentModesCreateInfoEXT -> IO b -> IO b
pokeCStruct Ptr SwapchainPresentModesCreateInfoEXT
p SwapchainPresentModesCreateInfoEXT{Vector PresentModeKHR
$sel:presentModes:SwapchainPresentModesCreateInfoEXT :: SwapchainPresentModesCreateInfoEXT -> Vector PresentModeKHR
presentModes :: Vector PresentModeKHR
..} 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 (m :: * -> *) a. Monad m => m a -> ContT b m a
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 SwapchainPresentModesCreateInfoEXT
p Ptr SwapchainPresentModesCreateInfoEXT -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SWAPCHAIN_PRESENT_MODES_CREATE_INFO_EXT)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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 SwapchainPresentModesCreateInfoEXT
p Ptr SwapchainPresentModesCreateInfoEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainPresentModesCreateInfoEXT
p Ptr SwapchainPresentModesCreateInfoEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector PresentModeKHR -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector PresentModeKHR -> Int) -> Vector PresentModeKHR -> Int
forall a b. (a -> b) -> a -> b
$ (Vector PresentModeKHR
presentModes)) :: Word32))
    Ptr PresentModeKHR
pPPresentModes' <- ((Ptr PresentModeKHR -> IO b) -> IO b)
-> ContT b IO (Ptr PresentModeKHR)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr PresentModeKHR -> IO b) -> IO b)
 -> ContT b IO (Ptr PresentModeKHR))
-> ((Ptr PresentModeKHR -> IO b) -> IO b)
-> ContT b IO (Ptr PresentModeKHR)
forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @PresentModeKHR ((Vector PresentModeKHR -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector PresentModeKHR
presentModes)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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
$ (Int -> PresentModeKHR -> IO ()) -> Vector PresentModeKHR -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i PresentModeKHR
e -> Ptr PresentModeKHR -> PresentModeKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PresentModeKHR
pPPresentModes' Ptr PresentModeKHR -> Int -> Ptr PresentModeKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr PresentModeKHR) (PresentModeKHR
e)) (Vector PresentModeKHR
presentModes)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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 PresentModeKHR) -> Ptr PresentModeKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainPresentModesCreateInfoEXT
p Ptr SwapchainPresentModesCreateInfoEXT
-> Int -> Ptr (Ptr PresentModeKHR)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr PresentModeKHR))) (Ptr PresentModeKHR
pPPresentModes')
    IO b -> ContT b IO b
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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 = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr SwapchainPresentModesCreateInfoEXT -> IO b -> IO b
pokeZeroCStruct Ptr SwapchainPresentModesCreateInfoEXT
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainPresentModesCreateInfoEXT
p Ptr SwapchainPresentModesCreateInfoEXT -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SWAPCHAIN_PRESENT_MODES_CREATE_INFO_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainPresentModesCreateInfoEXT
p Ptr SwapchainPresentModesCreateInfoEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO b
f

instance FromCStruct SwapchainPresentModesCreateInfoEXT where
  peekCStruct :: Ptr SwapchainPresentModesCreateInfoEXT
-> IO SwapchainPresentModesCreateInfoEXT
peekCStruct Ptr SwapchainPresentModesCreateInfoEXT
p = do
    Word32
presentModeCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr SwapchainPresentModesCreateInfoEXT
p Ptr SwapchainPresentModesCreateInfoEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    Ptr PresentModeKHR
pPresentModes <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr PresentModeKHR) ((Ptr SwapchainPresentModesCreateInfoEXT
p Ptr SwapchainPresentModesCreateInfoEXT
-> Int -> Ptr (Ptr PresentModeKHR)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr PresentModeKHR)))
    Vector PresentModeKHR
pPresentModes' <- Int -> (Int -> IO PresentModeKHR) -> IO (Vector PresentModeKHR)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
presentModeCount) (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @PresentModeKHR ((Ptr PresentModeKHR
pPresentModes Ptr PresentModeKHR -> Int -> Ptr PresentModeKHR
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr PresentModeKHR)))
    SwapchainPresentModesCreateInfoEXT
-> IO SwapchainPresentModesCreateInfoEXT
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SwapchainPresentModesCreateInfoEXT
 -> IO SwapchainPresentModesCreateInfoEXT)
-> SwapchainPresentModesCreateInfoEXT
-> IO SwapchainPresentModesCreateInfoEXT
forall a b. (a -> b) -> a -> b
$ Vector PresentModeKHR -> SwapchainPresentModesCreateInfoEXT
SwapchainPresentModesCreateInfoEXT
             Vector PresentModeKHR
pPresentModes'

instance Zero SwapchainPresentModesCreateInfoEXT where
  zero :: SwapchainPresentModesCreateInfoEXT
zero = Vector PresentModeKHR -> SwapchainPresentModesCreateInfoEXT
SwapchainPresentModesCreateInfoEXT
           Vector PresentModeKHR
forall a. Monoid a => a
mempty


-- | VkSwapchainPresentModeInfoEXT - Presentation modes for a
-- vkQueuePresentKHR operation
--
-- = Description
--
-- If the @pNext@ chain of
-- 'Vulkan.Extensions.VK_KHR_swapchain.PresentInfoKHR' includes a
-- 'SwapchainPresentModeInfoEXT' structure, then that structure defines the
-- presentation modes used for the current and subsequent presentation
-- operations.
--
-- When the application changes present modes with
-- 'SwapchainPresentModeInfoEXT', images that have already been queued for
-- presentation will continue to be presented according to the previous
-- present mode. The current image being queued for presentation and
-- subsequent images will be presented according to the new present mode.
-- The behavior during the transition between the two modes is defined as
-- follows.
--
-- -   Transition from
--     'Vulkan.Extensions.VK_KHR_surface.PRESENT_MODE_SHARED_CONTINUOUS_REFRESH_KHR'
--     to
--     'Vulkan.Extensions.VK_KHR_surface.PRESENT_MODE_SHARED_DEMAND_REFRESH_KHR':
--     the presentation engine updates the shared presentable image
--     according to the behavior of
--     'Vulkan.Extensions.VK_KHR_surface.PRESENT_MODE_SHARED_DEMAND_REFRESH_KHR'.
--
-- -   Transition from
--     'Vulkan.Extensions.VK_KHR_surface.PRESENT_MODE_SHARED_DEMAND_REFRESH_KHR'
--     to
--     'Vulkan.Extensions.VK_KHR_surface.PRESENT_MODE_SHARED_CONTINUOUS_REFRESH_KHR':
--     the presentation engine /may/ update the shared presentable image or
--     defer that to its regular refresh cycle, according to the behavior
--     of
--     'Vulkan.Extensions.VK_KHR_surface.PRESENT_MODE_SHARED_CONTINUOUS_REFRESH_KHR'.
--
-- -   Transition between
--     'Vulkan.Extensions.VK_KHR_surface.PRESENT_MODE_FIFO_KHR' and
--     'Vulkan.Extensions.VK_KHR_surface.PRESENT_MODE_FIFO_RELAXED_KHR':
--     Images continue to be appended to the same FIFO queue, and the
--     behavior with respect to waiting for vertical blanking period will
--     follow the new mode for current and subsequent images.
--
-- -   Transition from
--     'Vulkan.Extensions.VK_KHR_surface.PRESENT_MODE_IMMEDIATE_KHR' to
--     'Vulkan.Extensions.VK_KHR_surface.PRESENT_MODE_FIFO_KHR' or
--     'Vulkan.Extensions.VK_KHR_surface.PRESENT_MODE_FIFO_RELAXED_KHR': As
--     all prior present requests in the
--     'Vulkan.Extensions.VK_KHR_surface.PRESENT_MODE_IMMEDIATE_KHR' mode
--     are applied immediately, there are no outstanding present operations
--     in this mode, and current and subsequent images are appended to the
--     FIFO queue and presented according to the new mode.
--
-- -   Transition from
--     'Vulkan.Extensions.VK_KHR_surface.PRESENT_MODE_MAILBOX_KHR' to
--     'Vulkan.Extensions.VK_KHR_surface.PRESENT_MODE_FIFO_KHR' or
--     'Vulkan.Extensions.VK_KHR_surface.PRESENT_MODE_FIFO_RELAXED_KHR':
--     Presentation in both modes require waiting for the next vertical
--     blanking period, with
--     'Vulkan.Extensions.VK_KHR_surface.PRESENT_MODE_MAILBOX_KHR' allowing
--     the pending present operation to be replaced by a new one. In this
--     case, the current present operation will replace the pending present
--     operation and is applied according to the new mode.
--
-- -   Transition from
--     'Vulkan.Extensions.VK_KHR_surface.PRESENT_MODE_FIFO_KHR' or
--     'Vulkan.Extensions.VK_KHR_surface.PRESENT_MODE_FIFO_RELAXED_KHR' to
--     'Vulkan.Extensions.VK_KHR_surface.PRESENT_MODE_IMMEDIATE_KHR' or
--     'Vulkan.Extensions.VK_KHR_surface.PRESENT_MODE_MAILBOX_KHR': If the
--     FIFO queue is empty, presentation is done according to the behavior
--     of the new mode. If there are present operations in the FIFO queue,
--     once the last present operation is performed based on the respective
--     vertical blanking period, the current and subsequent updates are
--     applied according to the new mode.
--
-- -   The behavior during transition between any other present modes, if
--     possible, is implementation defined.
--
-- == Valid Usage
--
-- -   #VUID-VkSwapchainPresentModeInfoEXT-swapchainCount-07760#
--     @swapchainCount@ /must/ be equal to
--     'Vulkan.Extensions.VK_KHR_swapchain.PresentInfoKHR'::@swapchainCount@
--
-- -   #VUID-VkSwapchainPresentModeInfoEXT-pPresentModes-07761# Each entry
--     in @pPresentModes@ must be a presentation mode specified in
--     'SwapchainPresentModesCreateInfoEXT'::@pPresentModes@ when creating
--     the entry’s corresponding swapchain
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkSwapchainPresentModeInfoEXT-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_SWAPCHAIN_PRESENT_MODE_INFO_EXT'
--
-- -   #VUID-VkSwapchainPresentModeInfoEXT-pPresentModes-parameter#
--     @pPresentModes@ /must/ be a valid pointer to an array of
--     @swapchainCount@ valid
--     'Vulkan.Extensions.VK_KHR_surface.PresentModeKHR' values
--
-- -   #VUID-VkSwapchainPresentModeInfoEXT-swapchainCount-arraylength#
--     @swapchainCount@ /must/ be greater than @0@
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_swapchain_maintenance1 VK_EXT_swapchain_maintenance1>,
-- 'Vulkan.Extensions.VK_KHR_surface.PresentModeKHR',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data SwapchainPresentModeInfoEXT = SwapchainPresentModeInfoEXT
  { -- | @pPresentModes@ is a list of presentation modes with @swapchainCount@
    -- entries.
    SwapchainPresentModeInfoEXT -> Vector PresentModeKHR
presentModes :: Vector PresentModeKHR }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SwapchainPresentModeInfoEXT)
#endif
deriving instance Show SwapchainPresentModeInfoEXT

instance ToCStruct SwapchainPresentModeInfoEXT where
  withCStruct :: forall b.
SwapchainPresentModeInfoEXT
-> (Ptr SwapchainPresentModeInfoEXT -> IO b) -> IO b
withCStruct SwapchainPresentModeInfoEXT
x Ptr SwapchainPresentModeInfoEXT -> IO b
f = Int -> (Ptr SwapchainPresentModeInfoEXT -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((Ptr SwapchainPresentModeInfoEXT -> IO b) -> IO b)
-> (Ptr SwapchainPresentModeInfoEXT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr SwapchainPresentModeInfoEXT
p -> Ptr SwapchainPresentModeInfoEXT
-> SwapchainPresentModeInfoEXT -> IO b -> IO b
forall b.
Ptr SwapchainPresentModeInfoEXT
-> SwapchainPresentModeInfoEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SwapchainPresentModeInfoEXT
p SwapchainPresentModeInfoEXT
x (Ptr SwapchainPresentModeInfoEXT -> IO b
f Ptr SwapchainPresentModeInfoEXT
p)
  pokeCStruct :: forall b.
Ptr SwapchainPresentModeInfoEXT
-> SwapchainPresentModeInfoEXT -> IO b -> IO b
pokeCStruct Ptr SwapchainPresentModeInfoEXT
p SwapchainPresentModeInfoEXT{Vector PresentModeKHR
$sel:presentModes:SwapchainPresentModeInfoEXT :: SwapchainPresentModeInfoEXT -> Vector PresentModeKHR
presentModes :: Vector PresentModeKHR
..} 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 (m :: * -> *) a. Monad m => m a -> ContT b m a
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 SwapchainPresentModeInfoEXT
p Ptr SwapchainPresentModeInfoEXT -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SWAPCHAIN_PRESENT_MODE_INFO_EXT)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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 SwapchainPresentModeInfoEXT
p Ptr SwapchainPresentModeInfoEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainPresentModeInfoEXT
p Ptr SwapchainPresentModeInfoEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector PresentModeKHR -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector PresentModeKHR -> Int) -> Vector PresentModeKHR -> Int
forall a b. (a -> b) -> a -> b
$ (Vector PresentModeKHR
presentModes)) :: Word32))
    Ptr PresentModeKHR
pPPresentModes' <- ((Ptr PresentModeKHR -> IO b) -> IO b)
-> ContT b IO (Ptr PresentModeKHR)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr PresentModeKHR -> IO b) -> IO b)
 -> ContT b IO (Ptr PresentModeKHR))
-> ((Ptr PresentModeKHR -> IO b) -> IO b)
-> ContT b IO (Ptr PresentModeKHR)
forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @PresentModeKHR ((Vector PresentModeKHR -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector PresentModeKHR
presentModes)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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
$ (Int -> PresentModeKHR -> IO ()) -> Vector PresentModeKHR -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i PresentModeKHR
e -> Ptr PresentModeKHR -> PresentModeKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PresentModeKHR
pPPresentModes' Ptr PresentModeKHR -> Int -> Ptr PresentModeKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr PresentModeKHR) (PresentModeKHR
e)) (Vector PresentModeKHR
presentModes)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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 PresentModeKHR) -> Ptr PresentModeKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainPresentModeInfoEXT
p Ptr SwapchainPresentModeInfoEXT -> Int -> Ptr (Ptr PresentModeKHR)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr PresentModeKHR))) (Ptr PresentModeKHR
pPPresentModes')
    IO b -> ContT b IO b
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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 = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr SwapchainPresentModeInfoEXT -> IO b -> IO b
pokeZeroCStruct Ptr SwapchainPresentModeInfoEXT
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainPresentModeInfoEXT
p Ptr SwapchainPresentModeInfoEXT -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SWAPCHAIN_PRESENT_MODE_INFO_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainPresentModeInfoEXT
p Ptr SwapchainPresentModeInfoEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO b
f

instance FromCStruct SwapchainPresentModeInfoEXT where
  peekCStruct :: Ptr SwapchainPresentModeInfoEXT -> IO SwapchainPresentModeInfoEXT
peekCStruct Ptr SwapchainPresentModeInfoEXT
p = do
    Word32
swapchainCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr SwapchainPresentModeInfoEXT
p Ptr SwapchainPresentModeInfoEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    Ptr PresentModeKHR
pPresentModes <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr PresentModeKHR) ((Ptr SwapchainPresentModeInfoEXT
p Ptr SwapchainPresentModeInfoEXT -> Int -> Ptr (Ptr PresentModeKHR)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr PresentModeKHR)))
    Vector PresentModeKHR
pPresentModes' <- Int -> (Int -> IO PresentModeKHR) -> IO (Vector PresentModeKHR)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
swapchainCount) (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @PresentModeKHR ((Ptr PresentModeKHR
pPresentModes Ptr PresentModeKHR -> Int -> Ptr PresentModeKHR
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr PresentModeKHR)))
    SwapchainPresentModeInfoEXT -> IO SwapchainPresentModeInfoEXT
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SwapchainPresentModeInfoEXT -> IO SwapchainPresentModeInfoEXT)
-> SwapchainPresentModeInfoEXT -> IO SwapchainPresentModeInfoEXT
forall a b. (a -> b) -> a -> b
$ Vector PresentModeKHR -> SwapchainPresentModeInfoEXT
SwapchainPresentModeInfoEXT
             Vector PresentModeKHR
pPresentModes'

instance Zero SwapchainPresentModeInfoEXT where
  zero :: SwapchainPresentModeInfoEXT
zero = Vector PresentModeKHR -> SwapchainPresentModeInfoEXT
SwapchainPresentModeInfoEXT
           Vector PresentModeKHR
forall a. Monoid a => a
mempty


-- | VkSwapchainPresentScalingCreateInfoEXT - Scaling behavior when
-- presenting to the surface
--
-- = Description
--
-- If @scalingBehavior@ is @0@, the result of presenting a swapchain image
-- with dimensions that do not match the surface dimensions is
-- implementation and platform-dependent. If @presentGravityX@ or
-- @presentGravityY@ are @0@, the presentation gravity /must/ match that
-- defined by the native platform surface on platforms which define surface
-- gravity.
--
-- == Valid Usage
--
-- -   #VUID-VkSwapchainPresentScalingCreateInfoEXT-presentGravityX-07765#
--     If @presentGravityX@ is @0@, @presentGravityY@ /must/ be @0@
--
-- -   #VUID-VkSwapchainPresentScalingCreateInfoEXT-presentGravityX-07766#
--     If @presentGravityX@ is not @0@, @presentGravityY@ /must/ not be @0@
--
-- -   #VUID-VkSwapchainPresentScalingCreateInfoEXT-scalingBehavior-07767#
--     @scalingBehavior@ /must/ not have more than one bit set
--
-- -   #VUID-VkSwapchainPresentScalingCreateInfoEXT-presentGravityX-07768#
--     @presentGravityX@ /must/ not have more than one bit set
--
-- -   #VUID-VkSwapchainPresentScalingCreateInfoEXT-presentGravityY-07769#
--     @presentGravityY@ /must/ not have more than one bit set
--
-- -   #VUID-VkSwapchainPresentScalingCreateInfoEXT-scalingBehavior-07770#
--     @scalingBehavior@ /must/ be a valid scaling method for the surface
--     as returned in
--     'Vulkan.Extensions.VK_EXT_surface_maintenance1.SurfacePresentScalingCapabilitiesEXT'::@supportedPresentScaling@,
--     given
--     'Vulkan.Extensions.VK_KHR_swapchain.SwapchainCreateInfoKHR'::@presentMode@
--     in
--     'Vulkan.Extensions.VK_EXT_surface_maintenance1.SurfacePresentModeEXT'
--
-- -   #VUID-VkSwapchainPresentScalingCreateInfoEXT-scalingBehavior-07771#
--     If the swapchain is created with
--     'SwapchainPresentModesCreateInfoEXT', @scalingBehavior@ /must/ be a
--     valid scaling method for the surface as returned in
--     'Vulkan.Extensions.VK_EXT_surface_maintenance1.SurfacePresentScalingCapabilitiesEXT'::@supportedPresentScaling@,
--     given each present mode in
--     'SwapchainPresentModesCreateInfoEXT'::@pPresentModes@ in
--     'Vulkan.Extensions.VK_EXT_surface_maintenance1.SurfacePresentModeEXT'
--
-- -   #VUID-VkSwapchainPresentScalingCreateInfoEXT-presentGravityX-07772#
--     @presentGravityX@ /must/ be a valid x-axis present gravity for the
--     surface as returned in
--     'Vulkan.Extensions.VK_EXT_surface_maintenance1.SurfacePresentScalingCapabilitiesEXT'::@supportedPresentGravityX@,
--     given
--     'Vulkan.Extensions.VK_KHR_swapchain.SwapchainCreateInfoKHR'::@presentMode@
--     in
--     'Vulkan.Extensions.VK_EXT_surface_maintenance1.SurfacePresentModeEXT'
--
-- -   #VUID-VkSwapchainPresentScalingCreateInfoEXT-presentGravityX-07773#
--     If the swapchain is created with
--     'SwapchainPresentModesCreateInfoEXT', @presentGravityX@ /must/ be a
--     valid x-axis present gravity for the surface as returned in
--     'Vulkan.Extensions.VK_EXT_surface_maintenance1.SurfacePresentScalingCapabilitiesEXT'::@supportedPresentGravityX@,
--     given each present mode in
--     'SwapchainPresentModesCreateInfoEXT'::@pPresentModes@ in
--     'Vulkan.Extensions.VK_EXT_surface_maintenance1.SurfacePresentModeEXT'
--
-- -   #VUID-VkSwapchainPresentScalingCreateInfoEXT-presentGravityY-07774#
--     @presentGravityY@ /must/ be a valid y-axis present gravity for the
--     surface as returned in
--     'Vulkan.Extensions.VK_EXT_surface_maintenance1.SurfacePresentScalingCapabilitiesEXT'::@supportedPresentGravityY@,
--     given
--     'Vulkan.Extensions.VK_KHR_swapchain.SwapchainCreateInfoKHR'::@presentMode@
--     in
--     'Vulkan.Extensions.VK_EXT_surface_maintenance1.SurfacePresentModeEXT'
--
-- -   #VUID-VkSwapchainPresentScalingCreateInfoEXT-presentGravityY-07775#
--     If the swapchain is created with
--     'SwapchainPresentModesCreateInfoEXT', @presentGravityY@ /must/ be a
--     valid y-axis present gravity for the surface as returned in
--     'Vulkan.Extensions.VK_EXT_surface_maintenance1.SurfacePresentScalingCapabilitiesEXT'::@supportedPresentGravityY@,
--     given each present mode in
--     'SwapchainPresentModesCreateInfoEXT'::@pPresentModes@ in
--     'Vulkan.Extensions.VK_EXT_surface_maintenance1.SurfacePresentModeEXT'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkSwapchainPresentScalingCreateInfoEXT-sType-sType# @sType@
--     /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_SWAPCHAIN_PRESENT_SCALING_CREATE_INFO_EXT'
--
-- -   #VUID-VkSwapchainPresentScalingCreateInfoEXT-scalingBehavior-parameter#
--     @scalingBehavior@ /must/ be a valid combination of
--     'Vulkan.Extensions.VK_EXT_surface_maintenance1.PresentScalingFlagBitsEXT'
--     values
--
-- -   #VUID-VkSwapchainPresentScalingCreateInfoEXT-presentGravityX-parameter#
--     @presentGravityX@ /must/ be a valid combination of
--     'Vulkan.Extensions.VK_EXT_surface_maintenance1.PresentGravityFlagBitsEXT'
--     values
--
-- -   #VUID-VkSwapchainPresentScalingCreateInfoEXT-presentGravityY-parameter#
--     @presentGravityY@ /must/ be a valid combination of
--     'Vulkan.Extensions.VK_EXT_surface_maintenance1.PresentGravityFlagBitsEXT'
--     values
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_swapchain_maintenance1 VK_EXT_swapchain_maintenance1>,
-- 'Vulkan.Extensions.VK_EXT_surface_maintenance1.PresentGravityFlagsEXT',
-- 'Vulkan.Extensions.VK_EXT_surface_maintenance1.PresentScalingFlagsEXT',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data SwapchainPresentScalingCreateInfoEXT = SwapchainPresentScalingCreateInfoEXT
  { -- | @scalingBehavior@ is @0@ or the scaling method to use when the
    -- dimensions of the surface and swapchain images differ.
    SwapchainPresentScalingCreateInfoEXT -> PresentScalingFlagsEXT
scalingBehavior :: PresentScalingFlagsEXT
  , -- | @presentGravityX@ is @0@ or the x-axis direction in which swapchain
    -- image pixels gravitate relative to the surface when @scalingBehavior@
    -- does not result in a one-to-one pixel mapping between the scaled
    -- swapchain image and the surface.
    SwapchainPresentScalingCreateInfoEXT -> PresentGravityFlagsEXT
presentGravityX :: PresentGravityFlagsEXT
  , -- | @presentGravityY@ is @0@ or the y-axis direction in which swapchain
    -- image pixels gravitate relative to the surface when @scalingBehavior@
    -- does not result in a one-to-one pixel mapping between the scaled
    -- swapchain image and the surface.
    SwapchainPresentScalingCreateInfoEXT -> PresentGravityFlagsEXT
presentGravityY :: PresentGravityFlagsEXT
  }
  deriving (Typeable, SwapchainPresentScalingCreateInfoEXT
-> SwapchainPresentScalingCreateInfoEXT -> Bool
(SwapchainPresentScalingCreateInfoEXT
 -> SwapchainPresentScalingCreateInfoEXT -> Bool)
-> (SwapchainPresentScalingCreateInfoEXT
    -> SwapchainPresentScalingCreateInfoEXT -> Bool)
-> Eq SwapchainPresentScalingCreateInfoEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SwapchainPresentScalingCreateInfoEXT
-> SwapchainPresentScalingCreateInfoEXT -> Bool
== :: SwapchainPresentScalingCreateInfoEXT
-> SwapchainPresentScalingCreateInfoEXT -> Bool
$c/= :: SwapchainPresentScalingCreateInfoEXT
-> SwapchainPresentScalingCreateInfoEXT -> Bool
/= :: SwapchainPresentScalingCreateInfoEXT
-> SwapchainPresentScalingCreateInfoEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SwapchainPresentScalingCreateInfoEXT)
#endif
deriving instance Show SwapchainPresentScalingCreateInfoEXT

instance ToCStruct SwapchainPresentScalingCreateInfoEXT where
  withCStruct :: forall b.
SwapchainPresentScalingCreateInfoEXT
-> (Ptr SwapchainPresentScalingCreateInfoEXT -> IO b) -> IO b
withCStruct SwapchainPresentScalingCreateInfoEXT
x Ptr SwapchainPresentScalingCreateInfoEXT -> IO b
f = Int -> (Ptr SwapchainPresentScalingCreateInfoEXT -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((Ptr SwapchainPresentScalingCreateInfoEXT -> IO b) -> IO b)
-> (Ptr SwapchainPresentScalingCreateInfoEXT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr SwapchainPresentScalingCreateInfoEXT
p -> Ptr SwapchainPresentScalingCreateInfoEXT
-> SwapchainPresentScalingCreateInfoEXT -> IO b -> IO b
forall b.
Ptr SwapchainPresentScalingCreateInfoEXT
-> SwapchainPresentScalingCreateInfoEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SwapchainPresentScalingCreateInfoEXT
p SwapchainPresentScalingCreateInfoEXT
x (Ptr SwapchainPresentScalingCreateInfoEXT -> IO b
f Ptr SwapchainPresentScalingCreateInfoEXT
p)
  pokeCStruct :: forall b.
Ptr SwapchainPresentScalingCreateInfoEXT
-> SwapchainPresentScalingCreateInfoEXT -> IO b -> IO b
pokeCStruct Ptr SwapchainPresentScalingCreateInfoEXT
p SwapchainPresentScalingCreateInfoEXT{PresentGravityFlagsEXT
PresentScalingFlagsEXT
$sel:scalingBehavior:SwapchainPresentScalingCreateInfoEXT :: SwapchainPresentScalingCreateInfoEXT -> PresentScalingFlagsEXT
$sel:presentGravityX:SwapchainPresentScalingCreateInfoEXT :: SwapchainPresentScalingCreateInfoEXT -> PresentGravityFlagsEXT
$sel:presentGravityY:SwapchainPresentScalingCreateInfoEXT :: SwapchainPresentScalingCreateInfoEXT -> PresentGravityFlagsEXT
scalingBehavior :: PresentScalingFlagsEXT
presentGravityX :: PresentGravityFlagsEXT
presentGravityY :: PresentGravityFlagsEXT
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainPresentScalingCreateInfoEXT
p Ptr SwapchainPresentScalingCreateInfoEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SWAPCHAIN_PRESENT_SCALING_CREATE_INFO_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainPresentScalingCreateInfoEXT
p Ptr SwapchainPresentScalingCreateInfoEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr PresentScalingFlagsEXT -> PresentScalingFlagsEXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainPresentScalingCreateInfoEXT
p Ptr SwapchainPresentScalingCreateInfoEXT
-> Int -> Ptr PresentScalingFlagsEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PresentScalingFlagsEXT)) (PresentScalingFlagsEXT
scalingBehavior)
    Ptr PresentGravityFlagsEXT -> PresentGravityFlagsEXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainPresentScalingCreateInfoEXT
p Ptr SwapchainPresentScalingCreateInfoEXT
-> Int -> Ptr PresentGravityFlagsEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr PresentGravityFlagsEXT)) (PresentGravityFlagsEXT
presentGravityX)
    Ptr PresentGravityFlagsEXT -> PresentGravityFlagsEXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainPresentScalingCreateInfoEXT
p Ptr SwapchainPresentScalingCreateInfoEXT
-> Int -> Ptr PresentGravityFlagsEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr PresentGravityFlagsEXT)) (PresentGravityFlagsEXT
presentGravityY)
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr SwapchainPresentScalingCreateInfoEXT -> IO b -> IO b
pokeZeroCStruct Ptr SwapchainPresentScalingCreateInfoEXT
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainPresentScalingCreateInfoEXT
p Ptr SwapchainPresentScalingCreateInfoEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SWAPCHAIN_PRESENT_SCALING_CREATE_INFO_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainPresentScalingCreateInfoEXT
p Ptr SwapchainPresentScalingCreateInfoEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO b
f

instance FromCStruct SwapchainPresentScalingCreateInfoEXT where
  peekCStruct :: Ptr SwapchainPresentScalingCreateInfoEXT
-> IO SwapchainPresentScalingCreateInfoEXT
peekCStruct Ptr SwapchainPresentScalingCreateInfoEXT
p = do
    PresentScalingFlagsEXT
scalingBehavior <- forall a. Storable a => Ptr a -> IO a
peek @PresentScalingFlagsEXT ((Ptr SwapchainPresentScalingCreateInfoEXT
p Ptr SwapchainPresentScalingCreateInfoEXT
-> Int -> Ptr PresentScalingFlagsEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PresentScalingFlagsEXT))
    PresentGravityFlagsEXT
presentGravityX <- forall a. Storable a => Ptr a -> IO a
peek @PresentGravityFlagsEXT ((Ptr SwapchainPresentScalingCreateInfoEXT
p Ptr SwapchainPresentScalingCreateInfoEXT
-> Int -> Ptr PresentGravityFlagsEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr PresentGravityFlagsEXT))
    PresentGravityFlagsEXT
presentGravityY <- forall a. Storable a => Ptr a -> IO a
peek @PresentGravityFlagsEXT ((Ptr SwapchainPresentScalingCreateInfoEXT
p Ptr SwapchainPresentScalingCreateInfoEXT
-> Int -> Ptr PresentGravityFlagsEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr PresentGravityFlagsEXT))
    SwapchainPresentScalingCreateInfoEXT
-> IO SwapchainPresentScalingCreateInfoEXT
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SwapchainPresentScalingCreateInfoEXT
 -> IO SwapchainPresentScalingCreateInfoEXT)
-> SwapchainPresentScalingCreateInfoEXT
-> IO SwapchainPresentScalingCreateInfoEXT
forall a b. (a -> b) -> a -> b
$ PresentScalingFlagsEXT
-> PresentGravityFlagsEXT
-> PresentGravityFlagsEXT
-> SwapchainPresentScalingCreateInfoEXT
SwapchainPresentScalingCreateInfoEXT
             PresentScalingFlagsEXT
scalingBehavior PresentGravityFlagsEXT
presentGravityX PresentGravityFlagsEXT
presentGravityY

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

instance Zero SwapchainPresentScalingCreateInfoEXT where
  zero :: SwapchainPresentScalingCreateInfoEXT
zero = PresentScalingFlagsEXT
-> PresentGravityFlagsEXT
-> PresentGravityFlagsEXT
-> SwapchainPresentScalingCreateInfoEXT
SwapchainPresentScalingCreateInfoEXT
           PresentScalingFlagsEXT
forall a. Zero a => a
zero
           PresentGravityFlagsEXT
forall a. Zero a => a
zero
           PresentGravityFlagsEXT
forall a. Zero a => a
zero


-- | VkReleaseSwapchainImagesInfoEXT - Structure describing a list of
-- swapchain image indices to be released
--
-- == Valid Usage
--
-- -   #VUID-VkReleaseSwapchainImagesInfoEXT-pImageIndices-07785# Each
--     element of @pImageIndices@ /must/ be the index of a presentable
--     image acquired from the swapchain specified by @swapchain@
--
-- -   #VUID-VkReleaseSwapchainImagesInfoEXT-pImageIndices-07786# All uses
--     of presentable images identified by elements of @pImageIndices@
--     /must/ have completed execution
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkReleaseSwapchainImagesInfoEXT-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_RELEASE_SWAPCHAIN_IMAGES_INFO_EXT'
--
-- -   #VUID-VkReleaseSwapchainImagesInfoEXT-pNext-pNext# @pNext@ /must/ be
--     @NULL@
--
-- -   #VUID-VkReleaseSwapchainImagesInfoEXT-swapchain-parameter#
--     @swapchain@ /must/ be a valid
--     'Vulkan.Extensions.Handles.SwapchainKHR' handle
--
-- -   #VUID-VkReleaseSwapchainImagesInfoEXT-pImageIndices-parameter#
--     @pImageIndices@ /must/ be a valid pointer to an array of
--     @imageIndexCount@ @uint32_t@ values
--
-- -   #VUID-VkReleaseSwapchainImagesInfoEXT-imageIndexCount-arraylength#
--     @imageIndexCount@ /must/ be greater than @0@
--
-- == Host Synchronization
--
-- -   Host access to @swapchain@ /must/ be externally synchronized
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_swapchain_maintenance1 VK_EXT_swapchain_maintenance1>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'Vulkan.Extensions.Handles.SwapchainKHR', 'releaseSwapchainImagesEXT'
data ReleaseSwapchainImagesInfoEXT = ReleaseSwapchainImagesInfoEXT
  { -- | @swapchain@ is a swapchain to which images are being released.
    ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT) -> SwapchainKHR
swapchain :: SwapchainKHR
  , -- | @pImageIndices@ is a pointer to an array of indices into the array of
    -- @swapchain@’s presentable images, with @imageIndexCount@ entries.
    ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT) -> Vector Word32
imageIndices :: Vector Word32
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ReleaseSwapchainImagesInfoEXT)
#endif
deriving instance Show ReleaseSwapchainImagesInfoEXT

instance ToCStruct ReleaseSwapchainImagesInfoEXT where
  withCStruct :: forall b.
("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
-> (Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT) -> IO b)
-> IO b
withCStruct "releaseInfo" ::: ReleaseSwapchainImagesInfoEXT
x Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT) -> IO b
f = Int
-> (Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT) -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
40 ((Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT) -> IO b)
 -> IO b)
-> (Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT) -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
p -> Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
-> ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
-> IO b
-> IO b
forall b.
Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
-> ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
-> IO b
-> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
p "releaseInfo" ::: ReleaseSwapchainImagesInfoEXT
x (Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT) -> IO b
f Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
p)
  pokeCStruct :: forall b.
Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
-> ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
-> IO b
-> IO b
pokeCStruct Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
p ReleaseSwapchainImagesInfoEXT{Vector Word32
SwapchainKHR
$sel:swapchain:ReleaseSwapchainImagesInfoEXT :: ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT) -> SwapchainKHR
$sel:imageIndices:ReleaseSwapchainImagesInfoEXT :: ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT) -> Vector Word32
swapchain :: SwapchainKHR
imageIndices :: Vector Word32
..} 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 (m :: * -> *) a. Monad m => m a -> ContT b m a
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 ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
p Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_RELEASE_SWAPCHAIN_IMAGES_INFO_EXT)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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 ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
p Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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 SwapchainKHR -> SwapchainKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
p Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
-> Int -> Ptr SwapchainKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr SwapchainKHR)) (SwapchainKHR
swapchain)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
p Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Word32 -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Word32 -> Int) -> Vector Word32 -> Int
forall a b. (a -> b) -> a -> b
$ (Vector Word32
imageIndices)) :: Word32))
    Ptr Word32
pPImageIndices' <- ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32))
-> ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @Word32 ((Vector Word32 -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Word32
imageIndices)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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
$ (Int -> Word32 -> IO ()) -> Vector Word32 -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i Word32
e -> Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word32
pPImageIndices' Ptr Word32 -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32) (Word32
e)) (Vector Word32
imageIndices)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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 Word32) -> Ptr Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
p Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
-> Int -> Ptr (Ptr Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (Ptr Word32))) (Ptr Word32
pPImageIndices')
    IO b -> ContT b IO b
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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 = Int
40
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
-> IO b -> IO b
pokeZeroCStruct Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
p Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_RELEASE_SWAPCHAIN_IMAGES_INFO_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
p Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr SwapchainKHR -> SwapchainKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
p Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
-> Int -> Ptr SwapchainKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr SwapchainKHR)) (SwapchainKHR
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct ReleaseSwapchainImagesInfoEXT where
  peekCStruct :: Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
-> IO ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
peekCStruct Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
p = do
    SwapchainKHR
swapchain <- forall a. Storable a => Ptr a -> IO a
peek @SwapchainKHR ((Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
p Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
-> Int -> Ptr SwapchainKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr SwapchainKHR))
    Word32
imageIndexCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
p Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32))
    Ptr Word32
pImageIndices <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr Word32) ((Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
p Ptr ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
-> Int -> Ptr (Ptr Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (Ptr Word32)))
    Vector Word32
pImageIndices' <- Int -> (Int -> IO Word32) -> IO (Vector Word32)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
imageIndexCount) (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr Word32
pImageIndices Ptr Word32 -> Int -> Ptr Word32
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32)))
    ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
-> IO ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
 -> IO ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT))
-> ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
-> IO ("releaseInfo" ::: ReleaseSwapchainImagesInfoEXT)
forall a b. (a -> b) -> a -> b
$ SwapchainKHR
-> Vector Word32 -> "releaseInfo" ::: ReleaseSwapchainImagesInfoEXT
ReleaseSwapchainImagesInfoEXT
             SwapchainKHR
swapchain Vector Word32
pImageIndices'

instance Zero ReleaseSwapchainImagesInfoEXT where
  zero :: "releaseInfo" ::: ReleaseSwapchainImagesInfoEXT
zero = SwapchainKHR
-> Vector Word32 -> "releaseInfo" ::: ReleaseSwapchainImagesInfoEXT
ReleaseSwapchainImagesInfoEXT
           SwapchainKHR
forall a. Zero a => a
zero
           Vector Word32
forall a. Monoid a => a
mempty


type EXT_SWAPCHAIN_MAINTENANCE_1_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_EXT_SWAPCHAIN_MAINTENANCE_1_SPEC_VERSION"
pattern EXT_SWAPCHAIN_MAINTENANCE_1_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_SWAPCHAIN_MAINTENANCE_1_SPEC_VERSION :: forall a. Integral a => a
$mEXT_SWAPCHAIN_MAINTENANCE_1_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_SWAPCHAIN_MAINTENANCE_1_SPEC_VERSION = 1


type EXT_SWAPCHAIN_MAINTENANCE_1_EXTENSION_NAME = "VK_EXT_swapchain_maintenance1"

-- No documentation found for TopLevel "VK_EXT_SWAPCHAIN_MAINTENANCE_1_EXTENSION_NAME"
pattern EXT_SWAPCHAIN_MAINTENANCE_1_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_SWAPCHAIN_MAINTENANCE_1_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mEXT_SWAPCHAIN_MAINTENANCE_1_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_SWAPCHAIN_MAINTENANCE_1_EXTENSION_NAME = "VK_EXT_swapchain_maintenance1"