{-# language CPP #-}
-- | = Name
--
-- VK_KHR_present_id - device extension
--
-- == VK_KHR_present_id
--
-- [__Name String__]
--     @VK_KHR_present_id@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     295
--
-- [__Revision__]
--     1
--
-- [__Extension and Version Dependencies__]
--
--     -   Requires support for Vulkan 1.0
--
--     -   Requires @VK_KHR_swapchain@ to be enabled for any device-level
--         functionality
--
-- [__Contact__]
--
--     -   Keith Packard
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_KHR_present_id] @keithp%0A*Here describe the issue or question you have about the VK_KHR_present_id extension* >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2019-05-15
--
-- [__IP Status__]
--     No known IP claims.
--
-- [__Contributors__]
--
--     -   Keith Packard, Valve
--
--     -   Ian Elliott, Google
--
--     -   Alon Or-bach, Samsung
--
-- == Description
--
-- This device extension allows an application that uses the
-- @VK_KHR_swapchain@ extension to provide an identifier for present
-- operations on a swapchain. An application /can/ use this to reference
-- specific present operations in other extensions.
--
-- == New Structures
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDevicePresentIdFeaturesKHR'
--
-- -   Extending 'Vulkan.Extensions.VK_KHR_swapchain.PresentInfoKHR':
--
--     -   'PresentIdKHR'
--
-- == New Enum Constants
--
-- -   'KHR_PRESENT_ID_EXTENSION_NAME'
--
-- -   'KHR_PRESENT_ID_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_PRESENT_ID_FEATURES_KHR'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PRESENT_ID_KHR'
--
-- == Issues
--
-- None.
--
-- == Version History
--
-- -   Revision 1, 2019-05-15 (Keith Packard)
--
--     -   Initial version
--
-- == See Also
--
-- 'PhysicalDevicePresentIdFeaturesKHR', 'PresentIdKHR'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_KHR_present_id 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_present_id  ( PhysicalDevicePresentIdFeaturesKHR(..)
                                            , PresentIdKHR(..)
                                            , KHR_PRESENT_ID_SPEC_VERSION
                                            , pattern KHR_PRESENT_ID_SPEC_VERSION
                                            , KHR_PRESENT_ID_EXTENSION_NAME
                                            , pattern KHR_PRESENT_ID_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.Word (Word64)
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.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_PRESENT_ID_FEATURES_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PRESENT_ID_KHR))
-- | VkPhysicalDevicePresentIdFeaturesKHR - Structure indicating support for
-- present id
--
-- = Members
--
-- This structure describes the following feature:
--
-- = Description
--
-- If the 'PhysicalDevicePresentIdFeaturesKHR' 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. 'PhysicalDevicePresentIdFeaturesKHR' /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_KHR_present_id VK_KHR_present_id>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDevicePresentIdFeaturesKHR = PhysicalDevicePresentIdFeaturesKHR
  { -- | #features-presentId# @presentId@ indicates that the implementation
    -- supports specifying present ID values in the 'PresentIdKHR' extension to
    -- the 'Vulkan.Extensions.VK_KHR_swapchain.PresentInfoKHR' struct.
    PhysicalDevicePresentIdFeaturesKHR -> Bool
presentId :: Bool }
  deriving (Typeable, PhysicalDevicePresentIdFeaturesKHR
-> PhysicalDevicePresentIdFeaturesKHR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDevicePresentIdFeaturesKHR
-> PhysicalDevicePresentIdFeaturesKHR -> Bool
$c/= :: PhysicalDevicePresentIdFeaturesKHR
-> PhysicalDevicePresentIdFeaturesKHR -> Bool
== :: PhysicalDevicePresentIdFeaturesKHR
-> PhysicalDevicePresentIdFeaturesKHR -> Bool
$c== :: PhysicalDevicePresentIdFeaturesKHR
-> PhysicalDevicePresentIdFeaturesKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDevicePresentIdFeaturesKHR)
#endif
deriving instance Show PhysicalDevicePresentIdFeaturesKHR

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

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

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

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


-- | VkPresentIdKHR - The list of presentation identifiers
--
-- = Description
--
-- For applications to be able to reference specific presentation events
-- queued by a call to
-- 'Vulkan.Extensions.VK_KHR_swapchain.queuePresentKHR', an identifier
-- needs to be associated with them. When the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-presentId presentId>
-- feature is enabled, applications /can/ include the 'PresentIdKHR'
-- structure in the @pNext@ chain of the
-- 'Vulkan.Extensions.VK_KHR_swapchain.PresentInfoKHR' structure to supply
-- identifiers.
--
-- Each 'Vulkan.Extensions.Handles.SwapchainKHR' has a presentId associated
-- with it. This value is initially set to zero when the
-- 'Vulkan.Extensions.Handles.SwapchainKHR' is created.
--
-- When a 'PresentIdKHR' structure with a non-NULL @pPresentIds@ is
-- included in the @pNext@ chain of a
-- 'Vulkan.Extensions.VK_KHR_swapchain.PresentInfoKHR' structure, each
-- @pSwapchains@ entry has a presentId associated in the @pPresentIds@
-- array at the same index as the swapchain in the @pSwapchains@ array. If
-- this presentId is non-zero, then the application /can/ later use this
-- value to refer to that image presentation. A value of zero indicates
-- that this presentation has no associated presentId. A non-zero presentId
-- /must/ be greater than any non-zero presentId passed previously by the
-- application for the same swapchain.
--
-- There is no requirement for any precise timing relationship between the
-- presentation of the image to the user and the update of the presentId
-- value, but implementations /should/ make this as close as possible to
-- the presentation of the first pixel in the new image to the user.
--
-- == Valid Usage
--
-- -   #VUID-VkPresentIdKHR-swapchainCount-04998# @swapchainCount@ /must/
--     be the same value as
--     'Vulkan.Extensions.VK_KHR_swapchain.PresentInfoKHR'::@swapchainCount@,
--     where this 'PresentIdKHR' is in the @pNext@ chain of the
--     'Vulkan.Extensions.VK_KHR_swapchain.PresentInfoKHR' structure
--
-- -   #VUID-VkPresentIdKHR-presentIds-04999# Each @presentIds@ entry
--     /must/ be greater than any previous @presentIds@ entry passed for
--     the associated @pSwapchains@ entry
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkPresentIdKHR-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PRESENT_ID_KHR'
--
-- -   #VUID-VkPresentIdKHR-pPresentIds-parameter# If @pPresentIds@ is not
--     @NULL@, @pPresentIds@ /must/ be a valid pointer to an array of
--     @swapchainCount@ @uint64_t@ values
--
-- -   #VUID-VkPresentIdKHR-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_present_id VK_KHR_present_id>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PresentIdKHR = PresentIdKHR
  { -- | @swapchainCount@ is the number of swapchains being presented to the
    -- 'Vulkan.Extensions.VK_KHR_swapchain.queuePresentKHR' command.
    PresentIdKHR -> Word32
swapchainCount :: Word32
  , -- | @pPresentIds@ is @NULL@ or a pointer to an array of uint64_t with
    -- @swapchainCount@ entries. If not @NULL@, each non-zero value in
    -- @pPresentIds@ specifies the present id to be associated with the
    -- presentation of the swapchain with the same index in the
    -- 'Vulkan.Extensions.VK_KHR_swapchain.queuePresentKHR' call.
    PresentIdKHR -> Vector Word64
presentIds :: Vector Word64
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PresentIdKHR)
#endif
deriving instance Show PresentIdKHR

instance ToCStruct PresentIdKHR where
  withCStruct :: forall b. PresentIdKHR -> (Ptr PresentIdKHR -> IO b) -> IO b
withCStruct PresentIdKHR
x Ptr PresentIdKHR -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \Ptr PresentIdKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PresentIdKHR
p PresentIdKHR
x (Ptr PresentIdKHR -> IO b
f Ptr PresentIdKHR
p)
  pokeCStruct :: forall b. Ptr PresentIdKHR -> PresentIdKHR -> IO b -> IO b
pokeCStruct Ptr PresentIdKHR
p PresentIdKHR{Word32
Vector Word64
presentIds :: Vector Word64
swapchainCount :: Word32
$sel:presentIds:PresentIdKHR :: PresentIdKHR -> Vector Word64
$sel:swapchainCount:PresentIdKHR :: PresentIdKHR -> Word32
..} IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PresentIdKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PRESENT_ID_KHR)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PresentIdKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    let pPresentIdsLength :: Int
pPresentIdsLength = forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector Word64
presentIds)
    Word32
swapchainCount'' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ if (Word32
swapchainCount) forall a. Eq a => a -> a -> Bool
== Word32
0
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pPresentIdsLength
      else do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pPresentIdsLength forall a. Eq a => a -> a -> Bool
== (Word32
swapchainCount) Bool -> Bool -> Bool
|| Int
pPresentIdsLength forall a. Eq a => a -> a -> Bool
== Int
0) forall a b. (a -> b) -> a -> b
$
          forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"pPresentIds must be empty or have 'swapchainCount' elements" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32
swapchainCount)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PresentIdKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
swapchainCount'')
    Ptr Word64
pPresentIds'' <- if forall a. Vector a -> Bool
Data.Vector.null (Vector Word64
presentIds)
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
      else do
        Ptr Word64
pPPresentIds <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @Word64 (((forall a. Vector a -> Int
Data.Vector.length (Vector Word64
presentIds))) forall a. Num a => a -> a -> a
* Int
8)
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i Word64
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word64
pPPresentIds forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word64) (Word64
e)) ((Vector Word64
presentIds))
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Ptr Word64
pPPresentIds
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PresentIdKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr Word64))) Ptr Word64
pPresentIds''
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr PresentIdKHR -> IO b -> IO b
pokeZeroCStruct Ptr PresentIdKHR
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PresentIdKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PRESENT_ID_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PresentIdKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    IO b
f

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

instance Zero PresentIdKHR where
  zero :: PresentIdKHR
zero = Word32 -> Vector Word64 -> PresentIdKHR
PresentIdKHR
           forall a. Zero a => a
zero
           forall a. Monoid a => a
mempty


type KHR_PRESENT_ID_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_KHR_PRESENT_ID_SPEC_VERSION"
pattern KHR_PRESENT_ID_SPEC_VERSION :: forall a . Integral a => a
pattern $bKHR_PRESENT_ID_SPEC_VERSION :: forall a. Integral a => a
$mKHR_PRESENT_ID_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
KHR_PRESENT_ID_SPEC_VERSION = 1


type KHR_PRESENT_ID_EXTENSION_NAME = "VK_KHR_present_id"

-- No documentation found for TopLevel "VK_KHR_PRESENT_ID_EXTENSION_NAME"
pattern KHR_PRESENT_ID_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bKHR_PRESENT_ID_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mKHR_PRESENT_ID_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
KHR_PRESENT_ID_EXTENSION_NAME = "VK_KHR_present_id"