{-# language CPP #-}
-- | = Name
--
-- VK_EXT_frame_boundary - device extension
--
-- == VK_EXT_frame_boundary
--
-- [__Name String__]
--     @VK_EXT_frame_boundary@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     376
--
-- [__Revision__]
--     1
--
-- [__Ratification Status__]
--     Ratified
--
-- [__Extension and Version Dependencies__; __Contact__]
--
--     -   James Fitzpatrick
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_EXT_frame_boundary] @jamesfitzpatrick%0A*Here describe the issue or question you have about the VK_EXT_frame_boundary extension* >
--
-- [__Extension Proposal__]
--     <https://github.com/KhronosGroup/Vulkan-Docs/tree/main/proposals/VK_EXT_frame_boundary.adoc VK_EXT_frame_boundary>
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2023-06-14
--
-- [__Contributors__]
--
--     -   James Fitzpatrick, Imagination Technologies
--
--     -   Hugues Evrard, Google
--
--     -   Melih Yasin Yalcin, Google
--
--     -   Andrew Garrard, Imagination Technologies
--
--     -   Jan-Harald Fredriksen, Arm
--
--     -   Vassili Nikolaev, NVIDIA
--
--     -   Ting Wei, Huawei
--
-- == Description
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_frame_boundary VK_EXT_frame_boundary>
-- is a device extension that helps __tools__ (such as debuggers) to group
-- queue submissions per frames in non-trivial scenarios, typically when
-- 'Vulkan.Extensions.VK_KHR_swapchain.queuePresentKHR' is not a relevant
-- frame boundary delimiter.
--
-- == New Structures
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDeviceFrameBoundaryFeaturesEXT'
--
-- -   Extending 'Vulkan.Core10.Queue.SubmitInfo',
--     'Vulkan.Core13.Promoted_From_VK_KHR_synchronization2.SubmitInfo2',
--     'Vulkan.Extensions.VK_KHR_swapchain.PresentInfoKHR',
--     'Vulkan.Core10.SparseResourceMemoryManagement.BindSparseInfo':
--
--     -   'FrameBoundaryEXT'
--
-- == New Enums
--
-- -   'FrameBoundaryFlagBitsEXT'
--
-- == New Bitmasks
--
-- -   'FrameBoundaryFlagsEXT'
--
-- == New Enum Constants
--
-- -   'EXT_FRAME_BOUNDARY_EXTENSION_NAME'
--
-- -   'EXT_FRAME_BOUNDARY_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_FRAME_BOUNDARY_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_FRAME_BOUNDARY_FEATURES_EXT'
--
-- == Version History
--
-- -   Revision 0, 2022-01-14 (Hugues Evard)
--
--     -   Initial proposal
--
-- -   Revision 1, 2023-06-14 (James Fitzpatrick)
--
--     -   Initial draft
--
-- == See Also
--
-- 'FrameBoundaryEXT', 'FrameBoundaryFlagBitsEXT', 'FrameBoundaryFlagsEXT',
-- 'PhysicalDeviceFrameBoundaryFeaturesEXT'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_EXT_frame_boundary 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_frame_boundary  ( FrameBoundaryEXT(..)
                                                , PhysicalDeviceFrameBoundaryFeaturesEXT(..)
                                                , FrameBoundaryFlagsEXT
                                                , FrameBoundaryFlagBitsEXT( FRAME_BOUNDARY_FRAME_END_BIT_EXT
                                                                          , ..
                                                                          )
                                                , EXT_FRAME_BOUNDARY_SPEC_VERSION
                                                , pattern EXT_FRAME_BOUNDARY_SPEC_VERSION
                                                , EXT_FRAME_BOUNDARY_EXTENSION_NAME
                                                , pattern EXT_FRAME_BOUNDARY_EXTENSION_NAME
                                                ) where

import Data.Bits (Bits)
import Data.Bits (FiniteBits)
import Vulkan.Internal.Utils (enumReadPrec)
import Vulkan.Internal.Utils (enumShowsPrec)
import Control.Monad (unless)
import Foreign.Marshal.Alloc (allocaBytes)
import GHC.IO (throwIO)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import GHC.Show (showString)
import Numeric (showHex)
import Data.Coerce (coerce)
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 Vulkan.Zero (Zero(..))
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.C.Types (CSize)
import Foreign.C.Types (CSize(..))
import Foreign.C.Types (CSize(CSize))
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 GHC.Read (Read(readPrec))
import GHC.Show (Show(showsPrec))
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.Handles (Buffer)
import Vulkan.Core10.FundamentalTypes (Flags)
import Vulkan.Core10.Handles (Image)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_FRAME_BOUNDARY_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_FRAME_BOUNDARY_FEATURES_EXT))
-- | VkFrameBoundaryEXT - Add frame boundary information to queue submissions
--
-- = Description
--
-- The application /can/ associate frame boundary information to a queue
-- submission call by adding a 'FrameBoundaryEXT' structure to the @pNext@
-- chain of
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#devsandqueues-submission queue submission>,
-- 'Vulkan.Extensions.VK_KHR_swapchain.PresentInfoKHR', or
-- 'Vulkan.Core10.SparseResourceMemoryManagement.BindSparseInfo'.
--
-- The frame identifier is used to associate one or more queue submission
-- to a frame, it is thus meant to be unique within a frame lifetime, i.e.
-- it is possible (but not recommended) to reuse frame identifiers, as long
-- as any two frames with any chance of having overlapping queue
-- submissions (as in the example above) use two different frame
-- identifiers.
--
-- Note
--
-- Since the concept of frame is application-dependent, there is no way to
-- validate the use of frame identifier. It is good practice to use a
-- monotonically increasing counter as the frame identifier and not reuse
-- identifiers between frames.
--
-- The @pImages@ and @pBuffers@ arrays contain a list of images and buffers
-- which store the \"end result\" of the frame. As the concept of frame is
-- application-dependent, not all frames /may/ produce their results in
-- images or buffers, yet this is a sufficiently common case to be handled
-- by 'FrameBoundaryEXT'. Note that no extra information, such as image
-- layout is being provided, since the images are meant to be used by tools
-- which would already be tracking this required information. Having the
-- possibility of passing a list of end-result images makes
-- 'FrameBoundaryEXT' as expressive as
-- 'Vulkan.Extensions.VK_KHR_swapchain.queuePresentKHR', which is often the
-- default frame boundary delimiter.
--
-- The application /can/ also associate arbitrary extra information via tag
-- data using @tagName@, @tagSize@ and @pTag@. This extra information is
-- typically tool-specific.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkFrameBoundaryEXT-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_FRAME_BOUNDARY_EXT'
--
-- -   #VUID-VkFrameBoundaryEXT-flags-parameter# @flags@ /must/ be a valid
--     combination of 'FrameBoundaryFlagBitsEXT' values
--
-- -   #VUID-VkFrameBoundaryEXT-pImages-parameter# If @imageCount@ is not
--     @0@, and @pImages@ is not @NULL@, @pImages@ /must/ be a valid
--     pointer to an array of @imageCount@ valid
--     'Vulkan.Core10.Handles.Image' handles
--
-- -   #VUID-VkFrameBoundaryEXT-pBuffers-parameter# If @bufferCount@ is not
--     @0@, and @pBuffers@ is not @NULL@, @pBuffers@ /must/ be a valid
--     pointer to an array of @bufferCount@ valid
--     'Vulkan.Core10.Handles.Buffer' handles
--
-- -   #VUID-VkFrameBoundaryEXT-pTag-parameter# If @tagSize@ is not @0@,
--     and @pTag@ is not @NULL@, @pTag@ /must/ be a valid pointer to an
--     array of @tagSize@ bytes
--
-- -   #VUID-VkFrameBoundaryEXT-commonparent# Both of the elements of
--     @pBuffers@, and the elements of @pImages@ that are valid handles of
--     non-ignored parameters /must/ have been created, allocated, or
--     retrieved from the same 'Vulkan.Core10.Handles.Device'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_frame_boundary VK_EXT_frame_boundary>,
-- 'Vulkan.Core10.Handles.Buffer', 'FrameBoundaryFlagsEXT',
-- 'Vulkan.Core10.Handles.Image',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data FrameBoundaryEXT = FrameBoundaryEXT
  { -- | @flags@ is a bitmask of 'FrameBoundaryFlagBitsEXT' that can flag the
    -- last submission of a frame identifier.
    FrameBoundaryEXT -> FrameBoundaryFlagBitsEXT
flags :: FrameBoundaryFlagsEXT
  , -- | @frameID@ is the frame identifier.
    FrameBoundaryEXT -> Word64
frameID :: Word64
  , -- | @imageCount@ is the number of images that store frame results.
    FrameBoundaryEXT -> Flags
imageCount :: Word32
  , -- | @pImages@ is a pointer to an array of VkImage objects with imageCount
    -- entries.
    FrameBoundaryEXT -> Vector Image
images :: Vector Image
  , -- | @bufferCount@ is the number of buffers the store the frame results.
    FrameBoundaryEXT -> Flags
bufferCount :: Word32
  , -- | @pBuffers@ is a pointer to an array of VkBuffer objects with bufferCount
    -- entries.
    FrameBoundaryEXT -> Vector Buffer
buffers :: Vector Buffer
  , -- | @tagName@ is a numerical identifier for tag data.
    FrameBoundaryEXT -> Word64
tagName :: Word64
  , -- | @tagSize@ is the number of bytes of tag data.
    FrameBoundaryEXT -> Word64
tagSize :: Word64
  , -- | @pTag@ is a pointer to an array of @tagSize@ bytes containing tag data.
    FrameBoundaryEXT -> Ptr ()
tag :: Ptr ()
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (FrameBoundaryEXT)
#endif
deriving instance Show FrameBoundaryEXT

instance ToCStruct FrameBoundaryEXT where
  withCStruct :: forall b.
FrameBoundaryEXT -> (Ptr FrameBoundaryEXT -> IO b) -> IO b
withCStruct FrameBoundaryEXT
x Ptr FrameBoundaryEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
88 forall a b. (a -> b) -> a -> b
$ \Ptr FrameBoundaryEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr FrameBoundaryEXT
p FrameBoundaryEXT
x (Ptr FrameBoundaryEXT -> IO b
f Ptr FrameBoundaryEXT
p)
  pokeCStruct :: forall b. Ptr FrameBoundaryEXT -> FrameBoundaryEXT -> IO b -> IO b
pokeCStruct Ptr FrameBoundaryEXT
p FrameBoundaryEXT{Flags
Word64
Ptr ()
Vector Image
Vector Buffer
FrameBoundaryFlagBitsEXT
tag :: Ptr ()
tagSize :: Word64
tagName :: Word64
buffers :: Vector Buffer
bufferCount :: Flags
images :: Vector Image
imageCount :: Flags
frameID :: Word64
flags :: FrameBoundaryFlagBitsEXT
$sel:tag:FrameBoundaryEXT :: FrameBoundaryEXT -> Ptr ()
$sel:tagSize:FrameBoundaryEXT :: FrameBoundaryEXT -> Word64
$sel:tagName:FrameBoundaryEXT :: FrameBoundaryEXT -> Word64
$sel:buffers:FrameBoundaryEXT :: FrameBoundaryEXT -> Vector Buffer
$sel:bufferCount:FrameBoundaryEXT :: FrameBoundaryEXT -> Flags
$sel:images:FrameBoundaryEXT :: FrameBoundaryEXT -> Vector Image
$sel:imageCount:FrameBoundaryEXT :: FrameBoundaryEXT -> Flags
$sel:frameID:FrameBoundaryEXT :: FrameBoundaryEXT -> Word64
$sel:flags:FrameBoundaryEXT :: FrameBoundaryEXT -> FrameBoundaryFlagBitsEXT
..} 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 FrameBoundaryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_FRAME_BOUNDARY_EXT)
    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 FrameBoundaryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    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 FrameBoundaryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr FrameBoundaryFlagsEXT)) (FrameBoundaryFlagBitsEXT
flags)
    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 FrameBoundaryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word64)) (Word64
frameID)
    let pImagesLength :: Int
pImagesLength = forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector Image
images)
    Flags
imageCount'' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ if (Flags
imageCount) forall a. Eq a => a -> a -> Bool
== Flags
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
pImagesLength
      else do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pImagesLength forall a. Eq a => a -> a -> Bool
== (Flags
imageCount) Bool -> Bool -> Bool
|| Int
pImagesLength 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
"pImages must be empty or have 'imageCount' elements" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Flags
imageCount)
    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 FrameBoundaryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) (Flags
imageCount'')
    Ptr Image
pImages'' <- if forall a. Vector a -> Bool
Data.Vector.null (Vector Image
images)
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
      else do
        Ptr Image
pPImages <- 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 @Image (((forall a. Vector a -> Int
Data.Vector.length (Vector Image
images))) 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 Image
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Image
pPImages forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Image) (Image
e)) ((Vector Image
images))
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Ptr Image
pPImages
    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 FrameBoundaryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr Image))) Ptr Image
pImages''
    let pBuffersLength :: Int
pBuffersLength = forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector Buffer
buffers)
    Flags
bufferCount'' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ if (Flags
bufferCount) forall a. Eq a => a -> a -> Bool
== Flags
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
pBuffersLength
      else do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pBuffersLength forall a. Eq a => a -> a -> Bool
== (Flags
bufferCount) Bool -> Bool -> Bool
|| Int
pBuffersLength 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
"pBuffers must be empty or have 'bufferCount' elements" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Flags
bufferCount)
    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 FrameBoundaryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Word32)) (Flags
bufferCount'')
    Ptr Buffer
pBuffers'' <- if forall a. Vector a -> Bool
Data.Vector.null (Vector Buffer
buffers)
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
      else do
        Ptr Buffer
pPBuffers <- 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 @Buffer (((forall a. Vector a -> Int
Data.Vector.length (Vector Buffer
buffers))) 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 Buffer
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Buffer
pPBuffers forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Buffer) (Buffer
e)) ((Vector Buffer
buffers))
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Ptr Buffer
pPBuffers
    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 FrameBoundaryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr (Ptr Buffer))) Ptr Buffer
pBuffers''
    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 FrameBoundaryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr Word64)) (Word64
tagName)
    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 FrameBoundaryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr CSize)) (Word64 -> CSize
CSize (Word64
tagSize))
    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 FrameBoundaryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80 :: Ptr (Ptr ()))) (Ptr ()
tag)
    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
88
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr FrameBoundaryEXT -> IO b -> IO b
pokeZeroCStruct Ptr FrameBoundaryEXT
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FrameBoundaryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_FRAME_BOUNDARY_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FrameBoundaryEXT
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 FrameBoundaryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word64)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct FrameBoundaryEXT where
  peekCStruct :: Ptr FrameBoundaryEXT -> IO FrameBoundaryEXT
peekCStruct Ptr FrameBoundaryEXT
p = do
    FrameBoundaryFlagBitsEXT
flags <- forall a. Storable a => Ptr a -> IO a
peek @FrameBoundaryFlagsEXT ((Ptr FrameBoundaryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr FrameBoundaryFlagsEXT))
    Word64
frameID <- forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr FrameBoundaryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word64))
    Flags
imageCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr FrameBoundaryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32))
    Ptr Image
pImages <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr Image) ((Ptr FrameBoundaryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr Image)))
    let pImagesLength :: Int
pImagesLength = if Ptr Image
pImages 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 Flags
imageCount)
    Vector Image
pImages' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM Int
pImagesLength (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @Image ((Ptr Image
pImages forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Image)))
    Flags
bufferCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr FrameBoundaryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Word32))
    Ptr Buffer
pBuffers <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr Buffer) ((Ptr FrameBoundaryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr (Ptr Buffer)))
    let pBuffersLength :: Int
pBuffersLength = if Ptr Buffer
pBuffers 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 Flags
bufferCount)
    Vector Buffer
pBuffers' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM Int
pBuffersLength (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @Buffer ((Ptr Buffer
pBuffers forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Buffer)))
    Word64
tagName <- forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr FrameBoundaryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr Word64))
    CSize
tagSize <- forall a. Storable a => Ptr a -> IO a
peek @CSize ((Ptr FrameBoundaryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr CSize))
    Ptr ()
pTag <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr FrameBoundaryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80 :: Ptr (Ptr ())))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FrameBoundaryFlagBitsEXT
-> Word64
-> Flags
-> Vector Image
-> Flags
-> Vector Buffer
-> Word64
-> Word64
-> Ptr ()
-> FrameBoundaryEXT
FrameBoundaryEXT
             FrameBoundaryFlagBitsEXT
flags
             Word64
frameID
             Flags
imageCount
             Vector Image
pImages'
             Flags
bufferCount
             Vector Buffer
pBuffers'
             Word64
tagName
             (coerce :: forall a b. Coercible a b => a -> b
coerce @CSize @Word64 CSize
tagSize)
             Ptr ()
pTag

instance Zero FrameBoundaryEXT where
  zero :: FrameBoundaryEXT
zero = FrameBoundaryFlagBitsEXT
-> Word64
-> Flags
-> Vector Image
-> Flags
-> Vector Buffer
-> Word64
-> Word64
-> Ptr ()
-> FrameBoundaryEXT
FrameBoundaryEXT
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Monoid a => a
mempty
           forall a. Zero a => a
zero
           forall a. Monoid a => a
mempty
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkPhysicalDeviceFrameBoundaryFeaturesEXT - Structure describing the
-- frame boundary features that can be supported by an implementation
--
-- = Members
--
-- This structure describes the following feature:
--
-- = Description
--
-- If the 'PhysicalDeviceFrameBoundaryFeaturesEXT' 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. 'PhysicalDeviceFrameBoundaryFeaturesEXT' /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_frame_boundary VK_EXT_frame_boundary>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceFrameBoundaryFeaturesEXT = PhysicalDeviceFrameBoundaryFeaturesEXT
  { -- | #features-frameBoundary# @frameBoundary@ indicates whether the
    -- implementation supports frame boundary information.
    PhysicalDeviceFrameBoundaryFeaturesEXT -> Bool
frameBoundary :: Bool }
  deriving (Typeable, PhysicalDeviceFrameBoundaryFeaturesEXT
-> PhysicalDeviceFrameBoundaryFeaturesEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceFrameBoundaryFeaturesEXT
-> PhysicalDeviceFrameBoundaryFeaturesEXT -> Bool
$c/= :: PhysicalDeviceFrameBoundaryFeaturesEXT
-> PhysicalDeviceFrameBoundaryFeaturesEXT -> Bool
== :: PhysicalDeviceFrameBoundaryFeaturesEXT
-> PhysicalDeviceFrameBoundaryFeaturesEXT -> Bool
$c== :: PhysicalDeviceFrameBoundaryFeaturesEXT
-> PhysicalDeviceFrameBoundaryFeaturesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceFrameBoundaryFeaturesEXT)
#endif
deriving instance Show PhysicalDeviceFrameBoundaryFeaturesEXT

instance ToCStruct PhysicalDeviceFrameBoundaryFeaturesEXT where
  withCStruct :: forall b.
PhysicalDeviceFrameBoundaryFeaturesEXT
-> (Ptr PhysicalDeviceFrameBoundaryFeaturesEXT -> IO b) -> IO b
withCStruct PhysicalDeviceFrameBoundaryFeaturesEXT
x Ptr PhysicalDeviceFrameBoundaryFeaturesEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceFrameBoundaryFeaturesEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceFrameBoundaryFeaturesEXT
p PhysicalDeviceFrameBoundaryFeaturesEXT
x (Ptr PhysicalDeviceFrameBoundaryFeaturesEXT -> IO b
f Ptr PhysicalDeviceFrameBoundaryFeaturesEXT
p)
  pokeCStruct :: forall b.
Ptr PhysicalDeviceFrameBoundaryFeaturesEXT
-> PhysicalDeviceFrameBoundaryFeaturesEXT -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceFrameBoundaryFeaturesEXT
p PhysicalDeviceFrameBoundaryFeaturesEXT{Bool
frameBoundary :: Bool
$sel:frameBoundary:PhysicalDeviceFrameBoundaryFeaturesEXT :: PhysicalDeviceFrameBoundaryFeaturesEXT -> Bool
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceFrameBoundaryFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_FRAME_BOUNDARY_FEATURES_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceFrameBoundaryFeaturesEXT
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 PhysicalDeviceFrameBoundaryFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
frameBoundary))
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceFrameBoundaryFeaturesEXT -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceFrameBoundaryFeaturesEXT
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceFrameBoundaryFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_FRAME_BOUNDARY_FEATURES_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceFrameBoundaryFeaturesEXT
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 PhysicalDeviceFrameBoundaryFeaturesEXT
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 PhysicalDeviceFrameBoundaryFeaturesEXT where
  peekCStruct :: Ptr PhysicalDeviceFrameBoundaryFeaturesEXT
-> IO PhysicalDeviceFrameBoundaryFeaturesEXT
peekCStruct Ptr PhysicalDeviceFrameBoundaryFeaturesEXT
p = do
    Bool32
frameBoundary <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceFrameBoundaryFeaturesEXT
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 -> PhysicalDeviceFrameBoundaryFeaturesEXT
PhysicalDeviceFrameBoundaryFeaturesEXT
             (Bool32 -> Bool
bool32ToBool Bool32
frameBoundary)

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

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


type FrameBoundaryFlagsEXT = FrameBoundaryFlagBitsEXT

-- | VkFrameBoundaryFlagBitsEXT - Bitmask specifying whether a queue
-- submission is the last one for a given frame
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_frame_boundary VK_EXT_frame_boundary>,
-- 'FrameBoundaryFlagsEXT'
newtype FrameBoundaryFlagBitsEXT = FrameBoundaryFlagBitsEXT Flags
  deriving newtype (FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT -> Bool
$c/= :: FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT -> Bool
== :: FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT -> Bool
$c== :: FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT -> Bool
Eq, Eq FrameBoundaryFlagBitsEXT
FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT -> Bool
FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT -> Ordering
FrameBoundaryFlagBitsEXT
-> FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FrameBoundaryFlagBitsEXT
-> FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT
$cmin :: FrameBoundaryFlagBitsEXT
-> FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT
max :: FrameBoundaryFlagBitsEXT
-> FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT
$cmax :: FrameBoundaryFlagBitsEXT
-> FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT
>= :: FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT -> Bool
$c>= :: FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT -> Bool
> :: FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT -> Bool
$c> :: FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT -> Bool
<= :: FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT -> Bool
$c<= :: FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT -> Bool
< :: FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT -> Bool
$c< :: FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT -> Bool
compare :: FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT -> Ordering
$ccompare :: FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT -> Ordering
Ord, Ptr FrameBoundaryFlagBitsEXT -> IO FrameBoundaryFlagBitsEXT
Ptr FrameBoundaryFlagBitsEXT -> Int -> IO FrameBoundaryFlagBitsEXT
Ptr FrameBoundaryFlagBitsEXT
-> Int -> FrameBoundaryFlagBitsEXT -> IO ()
Ptr FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT -> IO ()
FrameBoundaryFlagBitsEXT -> Int
forall b. Ptr b -> Int -> IO FrameBoundaryFlagBitsEXT
forall b. Ptr b -> Int -> FrameBoundaryFlagBitsEXT -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT -> IO ()
$cpoke :: Ptr FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT -> IO ()
peek :: Ptr FrameBoundaryFlagBitsEXT -> IO FrameBoundaryFlagBitsEXT
$cpeek :: Ptr FrameBoundaryFlagBitsEXT -> IO FrameBoundaryFlagBitsEXT
pokeByteOff :: forall b. Ptr b -> Int -> FrameBoundaryFlagBitsEXT -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> FrameBoundaryFlagBitsEXT -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO FrameBoundaryFlagBitsEXT
$cpeekByteOff :: forall b. Ptr b -> Int -> IO FrameBoundaryFlagBitsEXT
pokeElemOff :: Ptr FrameBoundaryFlagBitsEXT
-> Int -> FrameBoundaryFlagBitsEXT -> IO ()
$cpokeElemOff :: Ptr FrameBoundaryFlagBitsEXT
-> Int -> FrameBoundaryFlagBitsEXT -> IO ()
peekElemOff :: Ptr FrameBoundaryFlagBitsEXT -> Int -> IO FrameBoundaryFlagBitsEXT
$cpeekElemOff :: Ptr FrameBoundaryFlagBitsEXT -> Int -> IO FrameBoundaryFlagBitsEXT
alignment :: FrameBoundaryFlagBitsEXT -> Int
$calignment :: FrameBoundaryFlagBitsEXT -> Int
sizeOf :: FrameBoundaryFlagBitsEXT -> Int
$csizeOf :: FrameBoundaryFlagBitsEXT -> Int
Storable, FrameBoundaryFlagBitsEXT
forall a. a -> Zero a
zero :: FrameBoundaryFlagBitsEXT
$czero :: FrameBoundaryFlagBitsEXT
Zero, Eq FrameBoundaryFlagBitsEXT
FrameBoundaryFlagBitsEXT
Int -> FrameBoundaryFlagBitsEXT
FrameBoundaryFlagBitsEXT -> Bool
FrameBoundaryFlagBitsEXT -> Int
FrameBoundaryFlagBitsEXT -> Maybe Int
FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT
FrameBoundaryFlagBitsEXT -> Int -> Bool
FrameBoundaryFlagBitsEXT -> Int -> FrameBoundaryFlagBitsEXT
FrameBoundaryFlagBitsEXT
-> FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: FrameBoundaryFlagBitsEXT -> Int
$cpopCount :: FrameBoundaryFlagBitsEXT -> Int
rotateR :: FrameBoundaryFlagBitsEXT -> Int -> FrameBoundaryFlagBitsEXT
$crotateR :: FrameBoundaryFlagBitsEXT -> Int -> FrameBoundaryFlagBitsEXT
rotateL :: FrameBoundaryFlagBitsEXT -> Int -> FrameBoundaryFlagBitsEXT
$crotateL :: FrameBoundaryFlagBitsEXT -> Int -> FrameBoundaryFlagBitsEXT
unsafeShiftR :: FrameBoundaryFlagBitsEXT -> Int -> FrameBoundaryFlagBitsEXT
$cunsafeShiftR :: FrameBoundaryFlagBitsEXT -> Int -> FrameBoundaryFlagBitsEXT
shiftR :: FrameBoundaryFlagBitsEXT -> Int -> FrameBoundaryFlagBitsEXT
$cshiftR :: FrameBoundaryFlagBitsEXT -> Int -> FrameBoundaryFlagBitsEXT
unsafeShiftL :: FrameBoundaryFlagBitsEXT -> Int -> FrameBoundaryFlagBitsEXT
$cunsafeShiftL :: FrameBoundaryFlagBitsEXT -> Int -> FrameBoundaryFlagBitsEXT
shiftL :: FrameBoundaryFlagBitsEXT -> Int -> FrameBoundaryFlagBitsEXT
$cshiftL :: FrameBoundaryFlagBitsEXT -> Int -> FrameBoundaryFlagBitsEXT
isSigned :: FrameBoundaryFlagBitsEXT -> Bool
$cisSigned :: FrameBoundaryFlagBitsEXT -> Bool
bitSize :: FrameBoundaryFlagBitsEXT -> Int
$cbitSize :: FrameBoundaryFlagBitsEXT -> Int
bitSizeMaybe :: FrameBoundaryFlagBitsEXT -> Maybe Int
$cbitSizeMaybe :: FrameBoundaryFlagBitsEXT -> Maybe Int
testBit :: FrameBoundaryFlagBitsEXT -> Int -> Bool
$ctestBit :: FrameBoundaryFlagBitsEXT -> Int -> Bool
complementBit :: FrameBoundaryFlagBitsEXT -> Int -> FrameBoundaryFlagBitsEXT
$ccomplementBit :: FrameBoundaryFlagBitsEXT -> Int -> FrameBoundaryFlagBitsEXT
clearBit :: FrameBoundaryFlagBitsEXT -> Int -> FrameBoundaryFlagBitsEXT
$cclearBit :: FrameBoundaryFlagBitsEXT -> Int -> FrameBoundaryFlagBitsEXT
setBit :: FrameBoundaryFlagBitsEXT -> Int -> FrameBoundaryFlagBitsEXT
$csetBit :: FrameBoundaryFlagBitsEXT -> Int -> FrameBoundaryFlagBitsEXT
bit :: Int -> FrameBoundaryFlagBitsEXT
$cbit :: Int -> FrameBoundaryFlagBitsEXT
zeroBits :: FrameBoundaryFlagBitsEXT
$czeroBits :: FrameBoundaryFlagBitsEXT
rotate :: FrameBoundaryFlagBitsEXT -> Int -> FrameBoundaryFlagBitsEXT
$crotate :: FrameBoundaryFlagBitsEXT -> Int -> FrameBoundaryFlagBitsEXT
shift :: FrameBoundaryFlagBitsEXT -> Int -> FrameBoundaryFlagBitsEXT
$cshift :: FrameBoundaryFlagBitsEXT -> Int -> FrameBoundaryFlagBitsEXT
complement :: FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT
$ccomplement :: FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT
xor :: FrameBoundaryFlagBitsEXT
-> FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT
$cxor :: FrameBoundaryFlagBitsEXT
-> FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT
.|. :: FrameBoundaryFlagBitsEXT
-> FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT
$c.|. :: FrameBoundaryFlagBitsEXT
-> FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT
.&. :: FrameBoundaryFlagBitsEXT
-> FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT
$c.&. :: FrameBoundaryFlagBitsEXT
-> FrameBoundaryFlagBitsEXT -> FrameBoundaryFlagBitsEXT
Bits, Bits FrameBoundaryFlagBitsEXT
FrameBoundaryFlagBitsEXT -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
countTrailingZeros :: FrameBoundaryFlagBitsEXT -> Int
$ccountTrailingZeros :: FrameBoundaryFlagBitsEXT -> Int
countLeadingZeros :: FrameBoundaryFlagBitsEXT -> Int
$ccountLeadingZeros :: FrameBoundaryFlagBitsEXT -> Int
finiteBitSize :: FrameBoundaryFlagBitsEXT -> Int
$cfiniteBitSize :: FrameBoundaryFlagBitsEXT -> Int
FiniteBits)

-- | 'FRAME_BOUNDARY_FRAME_END_BIT_EXT' specifies that this queue submission
-- is the last one for this frame, i.e. once this queue submission has
-- terminated, then the work for this frame is completed.
pattern $bFRAME_BOUNDARY_FRAME_END_BIT_EXT :: FrameBoundaryFlagBitsEXT
$mFRAME_BOUNDARY_FRAME_END_BIT_EXT :: forall {r}.
FrameBoundaryFlagBitsEXT -> ((# #) -> r) -> ((# #) -> r) -> r
FRAME_BOUNDARY_FRAME_END_BIT_EXT = FrameBoundaryFlagBitsEXT 0x00000001

conNameFrameBoundaryFlagBitsEXT :: String
conNameFrameBoundaryFlagBitsEXT :: String
conNameFrameBoundaryFlagBitsEXT = String
"FrameBoundaryFlagBitsEXT"

enumPrefixFrameBoundaryFlagBitsEXT :: String
enumPrefixFrameBoundaryFlagBitsEXT :: String
enumPrefixFrameBoundaryFlagBitsEXT = String
"FRAME_BOUNDARY_FRAME_END_BIT_EXT"

showTableFrameBoundaryFlagBitsEXT :: [(FrameBoundaryFlagBitsEXT, String)]
showTableFrameBoundaryFlagBitsEXT :: [(FrameBoundaryFlagBitsEXT, String)]
showTableFrameBoundaryFlagBitsEXT = [(FrameBoundaryFlagBitsEXT
FRAME_BOUNDARY_FRAME_END_BIT_EXT, String
"")]

instance Show FrameBoundaryFlagBitsEXT where
  showsPrec :: Int -> FrameBoundaryFlagBitsEXT -> ShowS
showsPrec =
    forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
      String
enumPrefixFrameBoundaryFlagBitsEXT
      [(FrameBoundaryFlagBitsEXT, String)]
showTableFrameBoundaryFlagBitsEXT
      String
conNameFrameBoundaryFlagBitsEXT
      (\(FrameBoundaryFlagBitsEXT Flags
x) -> Flags
x)
      (\Flags
x -> String -> ShowS
showString String
"0x" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Integral a, Show a) => a -> ShowS
showHex Flags
x)

instance Read FrameBoundaryFlagBitsEXT where
  readPrec :: ReadPrec FrameBoundaryFlagBitsEXT
readPrec =
    forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
      String
enumPrefixFrameBoundaryFlagBitsEXT
      [(FrameBoundaryFlagBitsEXT, String)]
showTableFrameBoundaryFlagBitsEXT
      String
conNameFrameBoundaryFlagBitsEXT
      Flags -> FrameBoundaryFlagBitsEXT
FrameBoundaryFlagBitsEXT

type EXT_FRAME_BOUNDARY_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_EXT_FRAME_BOUNDARY_SPEC_VERSION"
pattern EXT_FRAME_BOUNDARY_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_FRAME_BOUNDARY_SPEC_VERSION :: forall a. Integral a => a
$mEXT_FRAME_BOUNDARY_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_FRAME_BOUNDARY_SPEC_VERSION = 1


type EXT_FRAME_BOUNDARY_EXTENSION_NAME = "VK_EXT_frame_boundary"

-- No documentation found for TopLevel "VK_EXT_FRAME_BOUNDARY_EXTENSION_NAME"
pattern EXT_FRAME_BOUNDARY_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_FRAME_BOUNDARY_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mEXT_FRAME_BOUNDARY_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_FRAME_BOUNDARY_EXTENSION_NAME = "VK_EXT_frame_boundary"