{-# language CPP #-}
-- | = Name
--
-- VK_KHR_incremental_present - device extension
--
-- == VK_KHR_incremental_present
--
-- [__Name String__]
--     @VK_KHR_incremental_present@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     85
--
-- [__Revision__]
--     2
--
-- [__Extension and Version Dependencies__]
--
--     -   Requires Vulkan 1.0
--
--     -   Requires @VK_KHR_swapchain@
--
-- [__Contact__]
--
--     -   Ian Elliott
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_KHR_incremental_present] @ianelliottus%0A<<Here describe the issue or question you have about the VK_KHR_incremental_present extension>> >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2016-11-02
--
-- [__IP Status__]
--     No known IP claims.
--
-- [__Contributors__]
--
--     -   Ian Elliott, Google
--
--     -   Jesse Hall, Google
--
--     -   Alon Or-bach, Samsung
--
--     -   James Jones, NVIDIA
--
--     -   Daniel Rakos, AMD
--
--     -   Ray Smith, ARM
--
--     -   Mika Isojarvi, Google
--
--     -   Jeff Juliano, NVIDIA
--
--     -   Jeff Bolz, NVIDIA
--
-- == Description
--
-- This device extension extends
-- 'Vulkan.Extensions.VK_KHR_swapchain.queuePresentKHR', from the
-- @VK_KHR_swapchain@ extension, allowing an application to specify a list
-- of rectangular, modified regions of each image to present. This should
-- be used in situations where an application is only changing a small
-- portion of the presentable images within a swapchain, since it enables
-- the presentation engine to avoid wasting time presenting parts of the
-- surface that have not changed.
--
-- This extension is leveraged from the @EGL_KHR_swap_buffers_with_damage@
-- extension.
--
-- == New Structures
--
-- -   'PresentRegionKHR'
--
-- -   'RectLayerKHR'
--
-- -   Extending 'Vulkan.Extensions.VK_KHR_swapchain.PresentInfoKHR':
--
--     -   'PresentRegionsKHR'
--
-- == New Enum Constants
--
-- -   'KHR_INCREMENTAL_PRESENT_EXTENSION_NAME'
--
-- -   'KHR_INCREMENTAL_PRESENT_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PRESENT_REGIONS_KHR'
--
-- == Issues
--
-- 1) How should we handle steroescopic-3D swapchains? We need to add a
-- layer for each rectangle. One approach is to create another struct
-- containing the 'Vulkan.Core10.FundamentalTypes.Rect2D' plus layer, and
-- have 'PresentRegionsKHR' point to an array of that struct. Another
-- approach is to have two parallel arrays, @pRectangles@ and @pLayers@,
-- where @pRectangles@[i] and @pLayers@[i] must be used together. Which
-- approach should we use, and if the array of a new structure, what should
-- that be called?
--
-- __RESOLVED__: Create a new structure, which is a
-- 'Vulkan.Core10.FundamentalTypes.Rect2D' plus a layer, and will be called
-- 'RectLayerKHR'.
--
-- 2) Where is the origin of the 'RectLayerKHR'?
--
-- __RESOLVED__: The upper left corner of the presentable image(s) of the
-- swapchain, per the definition of framebuffer coordinates.
--
-- 3) Does the rectangular region, 'RectLayerKHR', specify pixels of the
-- swapchain’s image(s), or of the surface?
--
-- __RESOLVED__: Of the image(s). Some presentation engines may scale the
-- pixels of a swapchain’s image(s) to the size of the surface. The size of
-- the swapchain’s image(s) will be consistent, where the size of the
-- surface may vary over time.
--
-- 4) What if all of the rectangles for a given swapchain contain a width
-- and\/or height of zero?
--
-- __RESOLVED__: The application is indicating that no pixels changed since
-- the last present. The presentation engine may use such a hint and not
-- update any pixels for the swapchain. However, all other semantics of
-- 'Vulkan.Extensions.VK_KHR_swapchain.queuePresentKHR' must still be
-- honored, including waiting for semaphores to signal.
--
-- 5) When the swapchain is created with
-- 'Vulkan.Extensions.VK_KHR_swapchain.SwapchainCreateInfoKHR'::@preTransform@
-- set to a value other than
-- 'Vulkan.Extensions.VK_KHR_surface.SURFACE_TRANSFORM_IDENTITY_BIT_KHR',
-- should the rectangular region, 'RectLayerKHR', be transformed to align
-- with the @preTransform@?
--
-- __RESOLVED__: No. The rectangular region in 'RectLayerKHR' should not be
-- tranformed. As such, it may not align with the extents of the
-- swapchain’s image(s). It is the responsibility of the presentation
-- engine to transform the rectangular region. This matches the behavior of
-- the Android presentation engine, which set the precedent.
--
-- == Version History
--
-- -   Revision 1, 2016-11-02 (Ian Elliott)
--
--     -   Internal revisions
--
-- -   Revision 2, 2021-03-18 (Ian Elliott)
--
--     -   Clarified alignment of rectangles for presentation engines that
--         support transformed swapchains.
--
-- == See Also
--
-- 'PresentRegionKHR', 'PresentRegionsKHR', 'RectLayerKHR'
--
-- == Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_incremental_present Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_KHR_incremental_present  ( PresentRegionsKHR(..)
                                                     , PresentRegionKHR(..)
                                                     , RectLayerKHR(..)
                                                     , KHR_INCREMENTAL_PRESENT_SPEC_VERSION
                                                     , pattern KHR_INCREMENTAL_PRESENT_SPEC_VERSION
                                                     , KHR_INCREMENTAL_PRESENT_EXTENSION_NAME
                                                     , pattern KHR_INCREMENTAL_PRESENT_EXTENSION_NAME
                                                     ) where

import Control.Monad (unless)
import Foreign.Marshal.Alloc (allocaBytes)
import GHC.IO (throwIO)
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 qualified Data.Vector (null)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
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 (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 (Extent2D)
import Vulkan.Core10.FundamentalTypes (Offset2D)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PRESENT_REGIONS_KHR))
-- | VkPresentRegionsKHR - Structure hint of rectangular regions changed by
-- vkQueuePresentKHR
--
-- == Valid Usage
--
-- -   #VUID-VkPresentRegionsKHR-swapchainCount-01260# @swapchainCount@
--     /must/ be the same value as
--     'Vulkan.Extensions.VK_KHR_swapchain.PresentInfoKHR'::@swapchainCount@,
--     where 'Vulkan.Extensions.VK_KHR_swapchain.PresentInfoKHR' is
--     included in the @pNext@ chain of this 'PresentRegionsKHR' structure
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkPresentRegionsKHR-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PRESENT_REGIONS_KHR'
--
-- -   #VUID-VkPresentRegionsKHR-pRegions-parameter# If @pRegions@ is not
--     @NULL@, @pRegions@ /must/ be a valid pointer to an array of
--     @swapchainCount@ valid 'PresentRegionKHR' structures
--
-- -   #VUID-VkPresentRegionsKHR-swapchainCount-arraylength#
--     @swapchainCount@ /must/ be greater than @0@
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_incremental_present VK_KHR_incremental_present>,
-- 'PresentRegionKHR', 'Vulkan.Core10.Enums.StructureType.StructureType'
data PresentRegionsKHR = PresentRegionsKHR
  { -- | @swapchainCount@ is the number of swapchains being presented to by this
    -- command.
    PresentRegionsKHR -> Word32
swapchainCount :: Word32
  , -- | @pRegions@ is @NULL@ or a pointer to an array of 'PresentRegionKHR'
    -- elements with @swapchainCount@ entries. If not @NULL@, each element of
    -- @pRegions@ contains the region that has changed since the last present
    -- to the swapchain in the corresponding entry in the
    -- 'Vulkan.Extensions.VK_KHR_swapchain.PresentInfoKHR'::@pSwapchains@
    -- array.
    PresentRegionsKHR -> Vector PresentRegionKHR
regions :: Vector PresentRegionKHR
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PresentRegionsKHR)
#endif
deriving instance Show PresentRegionsKHR

instance ToCStruct PresentRegionsKHR where
  withCStruct :: PresentRegionsKHR -> (Ptr PresentRegionsKHR -> IO b) -> IO b
withCStruct PresentRegionsKHR
x Ptr PresentRegionsKHR -> IO b
f = Int -> (Ptr PresentRegionsKHR -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((Ptr PresentRegionsKHR -> IO b) -> IO b)
-> (Ptr PresentRegionsKHR -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PresentRegionsKHR
p -> Ptr PresentRegionsKHR -> PresentRegionsKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PresentRegionsKHR
p PresentRegionsKHR
x (Ptr PresentRegionsKHR -> IO b
f Ptr PresentRegionsKHR
p)
  pokeCStruct :: Ptr PresentRegionsKHR -> PresentRegionsKHR -> IO b -> IO b
pokeCStruct Ptr PresentRegionsKHR
p PresentRegionsKHR{Word32
Vector PresentRegionKHR
regions :: Vector PresentRegionKHR
swapchainCount :: Word32
$sel:regions:PresentRegionsKHR :: PresentRegionsKHR -> Vector PresentRegionKHR
$sel:swapchainCount:PresentRegionsKHR :: PresentRegionsKHR -> 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 (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 PresentRegionsKHR
p Ptr PresentRegionsKHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PRESENT_REGIONS_KHR)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PresentRegionsKHR
p Ptr PresentRegionsKHR -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    let pRegionsLength :: Int
pRegionsLength = Vector PresentRegionKHR -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector PresentRegionKHR -> Int) -> Vector PresentRegionKHR -> Int
forall a b. (a -> b) -> a -> b
$ (Vector PresentRegionKHR
regions)
    Word32
swapchainCount'' <- IO Word32 -> ContT b IO Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word32 -> ContT b IO Word32) -> IO Word32 -> ContT b IO Word32
forall a b. (a -> b) -> a -> b
$ if (Word32
swapchainCount) Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0
      then Word32 -> IO Word32
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32 -> IO Word32) -> Word32 -> IO Word32
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pRegionsLength
      else do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pRegionsLength Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== (Word32
swapchainCount) Bool -> Bool -> Bool
|| Int
pRegionsLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (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
"pRegions must be empty or have 'swapchainCount' elements" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
        Word32 -> IO Word32
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32
swapchainCount)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PresentRegionsKHR
p Ptr PresentRegionsKHR -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
swapchainCount'')
    Ptr PresentRegionKHR
pRegions'' <- if Vector PresentRegionKHR -> Bool
forall a. Vector a -> Bool
Data.Vector.null (Vector PresentRegionKHR
regions)
      then Ptr PresentRegionKHR -> ContT b IO (Ptr PresentRegionKHR)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr PresentRegionKHR
forall a. Ptr a
nullPtr
      else do
        Ptr PresentRegionKHR
pPRegions <- ((Ptr PresentRegionKHR -> IO b) -> IO b)
-> ContT b IO (Ptr PresentRegionKHR)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr PresentRegionKHR -> IO b) -> IO b)
 -> ContT b IO (Ptr PresentRegionKHR))
-> ((Ptr PresentRegionKHR -> IO b) -> IO b)
-> ContT b IO (Ptr PresentRegionKHR)
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr PresentRegionKHR -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @PresentRegionKHR (((Vector PresentRegionKHR -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector PresentRegionKHR
regions))) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16)
        (Int -> PresentRegionKHR -> ContT b IO ())
-> Vector PresentRegionKHR -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i PresentRegionKHR
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PresentRegionKHR -> PresentRegionKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (Ptr PresentRegionKHR
pPRegions Ptr PresentRegionKHR -> Int -> Ptr PresentRegionKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr PresentRegionKHR) (PresentRegionKHR
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) ((Vector PresentRegionKHR
regions))
        Ptr PresentRegionKHR -> ContT b IO (Ptr PresentRegionKHR)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr PresentRegionKHR -> ContT b IO (Ptr PresentRegionKHR))
-> Ptr PresentRegionKHR -> ContT b IO (Ptr PresentRegionKHR)
forall a b. (a -> b) -> a -> b
$ Ptr PresentRegionKHR
pPRegions
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr PresentRegionKHR) -> Ptr PresentRegionKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PresentRegionsKHR
p Ptr PresentRegionsKHR -> Int -> Ptr (Ptr PresentRegionKHR)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr PresentRegionKHR))) Ptr PresentRegionKHR
pRegions''
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr PresentRegionsKHR -> IO b -> IO b
pokeZeroCStruct Ptr PresentRegionsKHR
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PresentRegionsKHR
p Ptr PresentRegionsKHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PRESENT_REGIONS_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PresentRegionsKHR
p Ptr PresentRegionsKHR -> 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 PresentRegionsKHR where
  peekCStruct :: Ptr PresentRegionsKHR -> IO PresentRegionsKHR
peekCStruct Ptr PresentRegionsKHR
p = do
    Word32
swapchainCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PresentRegionsKHR
p Ptr PresentRegionsKHR -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    Ptr PresentRegionKHR
pRegions <- Ptr (Ptr PresentRegionKHR) -> IO (Ptr PresentRegionKHR)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr PresentRegionKHR) ((Ptr PresentRegionsKHR
p Ptr PresentRegionsKHR -> Int -> Ptr (Ptr PresentRegionKHR)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr PresentRegionKHR)))
    let pRegionsLength :: Int
pRegionsLength = if Ptr PresentRegionKHR
pRegions Ptr PresentRegionKHR -> Ptr PresentRegionKHR -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr PresentRegionKHR
forall a. Ptr a
nullPtr then Int
0 else (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
swapchainCount)
    Vector PresentRegionKHR
pRegions' <- Int -> (Int -> IO PresentRegionKHR) -> IO (Vector PresentRegionKHR)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM Int
pRegionsLength (\Int
i -> Ptr PresentRegionKHR -> IO PresentRegionKHR
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PresentRegionKHR ((Ptr PresentRegionKHR
pRegions Ptr PresentRegionKHR -> Int -> Ptr PresentRegionKHR
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr PresentRegionKHR)))
    PresentRegionsKHR -> IO PresentRegionsKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PresentRegionsKHR -> IO PresentRegionsKHR)
-> PresentRegionsKHR -> IO PresentRegionsKHR
forall a b. (a -> b) -> a -> b
$ Word32 -> Vector PresentRegionKHR -> PresentRegionsKHR
PresentRegionsKHR
             Word32
swapchainCount Vector PresentRegionKHR
pRegions'

instance Zero PresentRegionsKHR where
  zero :: PresentRegionsKHR
zero = Word32 -> Vector PresentRegionKHR -> PresentRegionsKHR
PresentRegionsKHR
           Word32
forall a. Zero a => a
zero
           Vector PresentRegionKHR
forall a. Monoid a => a
mempty


-- | VkPresentRegionKHR - Structure containing rectangular region changed by
-- vkQueuePresentKHR for a given VkImage
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkPresentRegionKHR-pRectangles-parameter# If @rectangleCount@
--     is not @0@, and @pRectangles@ is not @NULL@, @pRectangles@ /must/ be
--     a valid pointer to an array of @rectangleCount@ valid 'RectLayerKHR'
--     structures
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_incremental_present VK_KHR_incremental_present>,
-- 'PresentRegionsKHR', 'RectLayerKHR'
data PresentRegionKHR = PresentRegionKHR
  { -- | @rectangleCount@ is the number of rectangles in @pRectangles@, or zero
    -- if the entire image has changed and should be presented.
    PresentRegionKHR -> Word32
rectangleCount :: Word32
  , -- | @pRectangles@ is either @NULL@ or a pointer to an array of
    -- 'RectLayerKHR' structures. The 'RectLayerKHR' structure is the
    -- framebuffer coordinates, plus layer, of a portion of a presentable image
    -- that has changed and /must/ be presented. If non-@NULL@, each entry in
    -- @pRectangles@ is a rectangle of the given image that has changed since
    -- the last image was presented to the given swapchain. The rectangles
    -- /must/ be specified relative to
    -- 'Vulkan.Extensions.VK_KHR_surface.SurfaceCapabilitiesKHR'::@currentTransform@,
    -- regardless of the swapchain’s @preTransform@. The presentation engine
    -- will apply the @preTransform@ transformation to the rectangles, along
    -- with any further transformation it applies to the image content.
    PresentRegionKHR -> Vector RectLayerKHR
rectangles :: Vector RectLayerKHR
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PresentRegionKHR)
#endif
deriving instance Show PresentRegionKHR

instance ToCStruct PresentRegionKHR where
  withCStruct :: PresentRegionKHR -> (Ptr PresentRegionKHR -> IO b) -> IO b
withCStruct PresentRegionKHR
x Ptr PresentRegionKHR -> IO b
f = Int -> (Ptr PresentRegionKHR -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
16 ((Ptr PresentRegionKHR -> IO b) -> IO b)
-> (Ptr PresentRegionKHR -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PresentRegionKHR
p -> Ptr PresentRegionKHR -> PresentRegionKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PresentRegionKHR
p PresentRegionKHR
x (Ptr PresentRegionKHR -> IO b
f Ptr PresentRegionKHR
p)
  pokeCStruct :: Ptr PresentRegionKHR -> PresentRegionKHR -> IO b -> IO b
pokeCStruct Ptr PresentRegionKHR
p PresentRegionKHR{Word32
Vector RectLayerKHR
rectangles :: Vector RectLayerKHR
rectangleCount :: Word32
$sel:rectangles:PresentRegionKHR :: PresentRegionKHR -> Vector RectLayerKHR
$sel:rectangleCount:PresentRegionKHR :: PresentRegionKHR -> 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
    let pRectanglesLength :: Int
pRectanglesLength = Vector RectLayerKHR -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector RectLayerKHR -> Int) -> Vector RectLayerKHR -> Int
forall a b. (a -> b) -> a -> b
$ (Vector RectLayerKHR
rectangles)
    Word32
rectangleCount'' <- IO Word32 -> ContT b IO Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word32 -> ContT b IO Word32) -> IO Word32 -> ContT b IO Word32
forall a b. (a -> b) -> a -> b
$ if (Word32
rectangleCount) Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0
      then Word32 -> IO Word32
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32 -> IO Word32) -> Word32 -> IO Word32
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pRectanglesLength
      else do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pRectanglesLength Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== (Word32
rectangleCount) Bool -> Bool -> Bool
|| Int
pRectanglesLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (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
"pRectangles must be empty or have 'rectangleCount' elements" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
        Word32 -> IO Word32
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32
rectangleCount)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PresentRegionKHR
p Ptr PresentRegionKHR -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32)) (Word32
rectangleCount'')
    Ptr RectLayerKHR
pRectangles'' <- if Vector RectLayerKHR -> Bool
forall a. Vector a -> Bool
Data.Vector.null (Vector RectLayerKHR
rectangles)
      then Ptr RectLayerKHR -> ContT b IO (Ptr RectLayerKHR)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr RectLayerKHR
forall a. Ptr a
nullPtr
      else do
        Ptr RectLayerKHR
pPRectangles <- ((Ptr RectLayerKHR -> IO b) -> IO b)
-> ContT b IO (Ptr RectLayerKHR)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr RectLayerKHR -> IO b) -> IO b)
 -> ContT b IO (Ptr RectLayerKHR))
-> ((Ptr RectLayerKHR -> IO b) -> IO b)
-> ContT b IO (Ptr RectLayerKHR)
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr RectLayerKHR -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @RectLayerKHR (((Vector RectLayerKHR -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector RectLayerKHR
rectangles))) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
20)
        IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> RectLayerKHR -> IO ()) -> Vector RectLayerKHR -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i RectLayerKHR
e -> Ptr RectLayerKHR -> RectLayerKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr RectLayerKHR
pPRectangles Ptr RectLayerKHR -> Int -> Ptr RectLayerKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
20 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr RectLayerKHR) (RectLayerKHR
e)) ((Vector RectLayerKHR
rectangles))
        Ptr RectLayerKHR -> ContT b IO (Ptr RectLayerKHR)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr RectLayerKHR -> ContT b IO (Ptr RectLayerKHR))
-> Ptr RectLayerKHR -> ContT b IO (Ptr RectLayerKHR)
forall a b. (a -> b) -> a -> b
$ Ptr RectLayerKHR
pPRectangles
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr RectLayerKHR) -> Ptr RectLayerKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PresentRegionKHR
p Ptr PresentRegionKHR -> Int -> Ptr (Ptr RectLayerKHR)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr RectLayerKHR))) Ptr RectLayerKHR
pRectangles''
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = Int
16
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr PresentRegionKHR -> IO b -> IO b
pokeZeroCStruct Ptr PresentRegionKHR
_ IO b
f = IO b
f

instance FromCStruct PresentRegionKHR where
  peekCStruct :: Ptr PresentRegionKHR -> IO PresentRegionKHR
peekCStruct Ptr PresentRegionKHR
p = do
    Word32
rectangleCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PresentRegionKHR
p Ptr PresentRegionKHR -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32))
    Ptr RectLayerKHR
pRectangles <- Ptr (Ptr RectLayerKHR) -> IO (Ptr RectLayerKHR)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr RectLayerKHR) ((Ptr PresentRegionKHR
p Ptr PresentRegionKHR -> Int -> Ptr (Ptr RectLayerKHR)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr RectLayerKHR)))
    let pRectanglesLength :: Int
pRectanglesLength = if Ptr RectLayerKHR
pRectangles Ptr RectLayerKHR -> Ptr RectLayerKHR -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr RectLayerKHR
forall a. Ptr a
nullPtr then Int
0 else (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
rectangleCount)
    Vector RectLayerKHR
pRectangles' <- Int -> (Int -> IO RectLayerKHR) -> IO (Vector RectLayerKHR)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM Int
pRectanglesLength (\Int
i -> Ptr RectLayerKHR -> IO RectLayerKHR
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @RectLayerKHR ((Ptr RectLayerKHR
pRectangles Ptr RectLayerKHR -> Int -> Ptr RectLayerKHR
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
20 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr RectLayerKHR)))
    PresentRegionKHR -> IO PresentRegionKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PresentRegionKHR -> IO PresentRegionKHR)
-> PresentRegionKHR -> IO PresentRegionKHR
forall a b. (a -> b) -> a -> b
$ Word32 -> Vector RectLayerKHR -> PresentRegionKHR
PresentRegionKHR
             Word32
rectangleCount Vector RectLayerKHR
pRectangles'

instance Zero PresentRegionKHR where
  zero :: PresentRegionKHR
zero = Word32 -> Vector RectLayerKHR -> PresentRegionKHR
PresentRegionKHR
           Word32
forall a. Zero a => a
zero
           Vector RectLayerKHR
forall a. Monoid a => a
mempty


-- | VkRectLayerKHR - Structure containing a rectangle, including layer,
-- changed by vkQueuePresentKHR for a given VkImage
--
-- = Description
--
-- Some platforms allow the size of a surface to change, and then scale the
-- pixels of the image to fit the surface. 'RectLayerKHR' specifies pixels
-- of the swapchain’s image(s), which will be constant for the life of the
-- swapchain.
--
-- == Valid Usage
--
-- -   #VUID-VkRectLayerKHR-offset-04864# The sum of @offset@ and @extent@,
--     after being transformed according to the @preTransform@ member of
--     the 'Vulkan.Extensions.VK_KHR_swapchain.SwapchainCreateInfoKHR'
--     structure, /must/ be no greater than the @imageExtent@ member of the
--     'Vulkan.Extensions.VK_KHR_swapchain.SwapchainCreateInfoKHR'
--     structure passed to
--     'Vulkan.Extensions.VK_KHR_swapchain.createSwapchainKHR'
--
-- -   #VUID-VkRectLayerKHR-layer-01262# @layer@ /must/ be less than the
--     @imageArrayLayers@ member of the
--     'Vulkan.Extensions.VK_KHR_swapchain.SwapchainCreateInfoKHR'
--     structure passed to
--     'Vulkan.Extensions.VK_KHR_swapchain.createSwapchainKHR'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_incremental_present VK_KHR_incremental_present>,
-- 'Vulkan.Core10.FundamentalTypes.Extent2D',
-- 'Vulkan.Core10.FundamentalTypes.Offset2D', 'PresentRegionKHR'
data RectLayerKHR = RectLayerKHR
  { -- | @offset@ is the origin of the rectangle, in pixels.
    RectLayerKHR -> Offset2D
offset :: Offset2D
  , -- | @extent@ is the size of the rectangle, in pixels.
    RectLayerKHR -> Extent2D
extent :: Extent2D
  , -- | @layer@ is the layer of the image. For images with only one layer, the
    -- value of @layer@ /must/ be 0.
    RectLayerKHR -> Word32
layer :: Word32
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (RectLayerKHR)
#endif
deriving instance Show RectLayerKHR

instance ToCStruct RectLayerKHR where
  withCStruct :: RectLayerKHR -> (Ptr RectLayerKHR -> IO b) -> IO b
withCStruct RectLayerKHR
x Ptr RectLayerKHR -> IO b
f = Int -> (Ptr RectLayerKHR -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
20 ((Ptr RectLayerKHR -> IO b) -> IO b)
-> (Ptr RectLayerKHR -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr RectLayerKHR
p -> Ptr RectLayerKHR -> RectLayerKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr RectLayerKHR
p RectLayerKHR
x (Ptr RectLayerKHR -> IO b
f Ptr RectLayerKHR
p)
  pokeCStruct :: Ptr RectLayerKHR -> RectLayerKHR -> IO b -> IO b
pokeCStruct Ptr RectLayerKHR
p RectLayerKHR{Word32
Offset2D
Extent2D
layer :: Word32
extent :: Extent2D
offset :: Offset2D
$sel:layer:RectLayerKHR :: RectLayerKHR -> Word32
$sel:extent:RectLayerKHR :: RectLayerKHR -> Extent2D
$sel:offset:RectLayerKHR :: RectLayerKHR -> Offset2D
..} IO b
f = do
    Ptr Offset2D -> Offset2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RectLayerKHR
p Ptr RectLayerKHR -> Int -> Ptr Offset2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Offset2D)) (Offset2D
offset)
    Ptr Extent2D -> Extent2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RectLayerKHR
p Ptr RectLayerKHR -> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Extent2D)) (Extent2D
extent)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RectLayerKHR
p Ptr RectLayerKHR -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
layer)
    IO b
f
  cStructSize :: Int
cStructSize = Int
20
  cStructAlignment :: Int
cStructAlignment = Int
4
  pokeZeroCStruct :: Ptr RectLayerKHR -> IO b -> IO b
pokeZeroCStruct Ptr RectLayerKHR
p IO b
f = do
    Ptr Offset2D -> Offset2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RectLayerKHR
p Ptr RectLayerKHR -> Int -> Ptr Offset2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Offset2D)) (Offset2D
forall a. Zero a => a
zero)
    Ptr Extent2D -> Extent2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RectLayerKHR
p Ptr RectLayerKHR -> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Extent2D)) (Extent2D
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RectLayerKHR
p Ptr RectLayerKHR -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct RectLayerKHR where
  peekCStruct :: Ptr RectLayerKHR -> IO RectLayerKHR
peekCStruct Ptr RectLayerKHR
p = do
    Offset2D
offset <- Ptr Offset2D -> IO Offset2D
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Offset2D ((Ptr RectLayerKHR
p Ptr RectLayerKHR -> Int -> Ptr Offset2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Offset2D))
    Extent2D
extent <- Ptr Extent2D -> IO Extent2D
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent2D ((Ptr RectLayerKHR
p Ptr RectLayerKHR -> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Extent2D))
    Word32
layer <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr RectLayerKHR
p Ptr RectLayerKHR -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    RectLayerKHR -> IO RectLayerKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RectLayerKHR -> IO RectLayerKHR)
-> RectLayerKHR -> IO RectLayerKHR
forall a b. (a -> b) -> a -> b
$ Offset2D -> Extent2D -> Word32 -> RectLayerKHR
RectLayerKHR
             Offset2D
offset Extent2D
extent Word32
layer

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

instance Zero RectLayerKHR where
  zero :: RectLayerKHR
zero = Offset2D -> Extent2D -> Word32 -> RectLayerKHR
RectLayerKHR
           Offset2D
forall a. Zero a => a
zero
           Extent2D
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero


type KHR_INCREMENTAL_PRESENT_SPEC_VERSION = 2

-- No documentation found for TopLevel "VK_KHR_INCREMENTAL_PRESENT_SPEC_VERSION"
pattern KHR_INCREMENTAL_PRESENT_SPEC_VERSION :: forall a . Integral a => a
pattern $bKHR_INCREMENTAL_PRESENT_SPEC_VERSION :: a
$mKHR_INCREMENTAL_PRESENT_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
KHR_INCREMENTAL_PRESENT_SPEC_VERSION = 2


type KHR_INCREMENTAL_PRESENT_EXTENSION_NAME = "VK_KHR_incremental_present"

-- No documentation found for TopLevel "VK_KHR_INCREMENTAL_PRESENT_EXTENSION_NAME"
pattern KHR_INCREMENTAL_PRESENT_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bKHR_INCREMENTAL_PRESENT_EXTENSION_NAME :: a
$mKHR_INCREMENTAL_PRESENT_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
KHR_INCREMENTAL_PRESENT_EXTENSION_NAME = "VK_KHR_incremental_present"