{-# language CPP #-}
-- | = Name
--
-- VK_NV_low_latency2 - device extension
--
-- == VK_NV_low_latency2
--
-- [__Name String__]
--     @VK_NV_low_latency2@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     506
--
-- [__Revision__]
--     1
--
-- [__Ratification Status__]
--     Not ratified
--
-- [__Extension and Version Dependencies__; __Contact__]
--
--     -   Charles Hansen
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_NV_low_latency2] @cshansen%0A*Here describe the issue or question you have about the VK_NV_low_latency2 extension* >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2023-09-25
--
-- [__Contributors__]
--
--     -   Charles Hansen, NVIDIA
--
--     -   Liam Middlebrook, NVIDIA
--
--     -   Lionel Duc, NVIDIA
--
--     -   James Jones, NVIDIA
--
--     -   Eric Sullivan, NVIDIA
--
-- == New Commands
--
-- -   'getLatencyTimingsNV'
--
-- -   'latencySleepNV'
--
-- -   'queueNotifyOutOfBandNV'
--
-- -   'setLatencyMarkerNV'
--
-- -   'setLatencySleepModeNV'
--
-- == New Structures
--
-- -   'GetLatencyMarkerInfoNV'
--
-- -   'LatencySleepInfoNV'
--
-- -   'LatencySleepModeInfoNV'
--
-- -   'LatencyTimingsFrameReportNV'
--
-- -   'OutOfBandQueueTypeInfoNV'
--
-- -   'SetLatencyMarkerInfoNV'
--
-- -   Extending 'Vulkan.Core10.Queue.SubmitInfo',
--     'Vulkan.Core13.Promoted_From_VK_KHR_synchronization2.SubmitInfo2':
--
--     -   'LatencySubmissionPresentIdNV'
--
-- -   Extending
--     'Vulkan.Extensions.VK_KHR_get_surface_capabilities2.SurfaceCapabilities2KHR':
--
--     -   'LatencySurfaceCapabilitiesNV'
--
-- -   Extending
--     'Vulkan.Extensions.VK_KHR_swapchain.SwapchainCreateInfoKHR':
--
--     -   'SwapchainLatencyCreateInfoNV'
--
-- == New Enums
--
-- -   'LatencyMarkerNV'
--
-- -   'OutOfBandQueueTypeNV'
--
-- == New Enum Constants
--
-- -   'NV_LOW_LATENCY_2_EXTENSION_NAME'
--
-- -   'NV_LOW_LATENCY_2_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_GET_LATENCY_MARKER_INFO_NV'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_LATENCY_SLEEP_INFO_NV'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_LATENCY_SLEEP_MODE_INFO_NV'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_LATENCY_SUBMISSION_PRESENT_ID_NV'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_LATENCY_SURFACE_CAPABILITIES_NV'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_LATENCY_TIMINGS_FRAME_REPORT_NV'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_OUT_OF_BAND_QUEUE_TYPE_INFO_NV'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_SET_LATENCY_MARKER_INFO_NV'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_SWAPCHAIN_LATENCY_CREATE_INFO_NV'
--
-- == Description
--
-- This extension gives applications timing suggestions on when to start
-- the recording of new frames to reduce the latency between input sampling
-- and frame presentation. Applications can accomplish this through the
-- extension by calling 'setLatencySleepModeNV' to allow the driver to pace
-- a given swapchain, then calling 'latencySleepNV' before input sampling
-- to delay the start of the CPU side work. Additional methods and
-- structures are provided to give insight into the latency pipeline of an
-- application through the latency markers. @VK_NV_low_latency@ provides
-- legacy support for applications that make use of the NVIDIA Reflex SDK
-- whereas new implementations should use the @VK_NV_low_latency2@
-- extension.
--
-- == Issues
--
-- 1) How does Low Latency 2 work with applications that utilize device
-- groups?
--
-- Low Latency 2 does not support device groups.
--
-- == Version History
--
-- -   Revision 1, 2023-09-25 (Charles Hansen)
--
--     -   Internal revisions
--
-- == See Also
--
-- 'GetLatencyMarkerInfoNV', 'LatencyMarkerNV', 'LatencySleepInfoNV',
-- 'LatencySleepModeInfoNV', 'LatencySubmissionPresentIdNV',
-- 'LatencySurfaceCapabilitiesNV', 'LatencyTimingsFrameReportNV',
-- 'OutOfBandQueueTypeInfoNV', 'OutOfBandQueueTypeNV',
-- 'SetLatencyMarkerInfoNV', 'SwapchainLatencyCreateInfoNV',
-- 'getLatencyTimingsNV', 'latencySleepNV', 'queueNotifyOutOfBandNV',
-- 'setLatencyMarkerNV', 'setLatencySleepModeNV'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_NV_low_latency2 Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_NV_low_latency2  ( setLatencySleepModeNV
                                             , latencySleepNV
                                             , setLatencyMarkerNV
                                             , getLatencyTimingsNV
                                             , queueNotifyOutOfBandNV
                                             , LatencySleepModeInfoNV(..)
                                             , LatencySleepInfoNV(..)
                                             , SetLatencyMarkerInfoNV(..)
                                             , GetLatencyMarkerInfoNV(..)
                                             , LatencyTimingsFrameReportNV(..)
                                             , OutOfBandQueueTypeInfoNV(..)
                                             , LatencySubmissionPresentIdNV(..)
                                             , SwapchainLatencyCreateInfoNV(..)
                                             , LatencySurfaceCapabilitiesNV(..)
                                             , LatencyMarkerNV( LATENCY_MARKER_SIMULATION_START_NV
                                                              , LATENCY_MARKER_SIMULATION_END_NV
                                                              , LATENCY_MARKER_RENDERSUBMIT_START_NV
                                                              , LATENCY_MARKER_RENDERSUBMIT_END_NV
                                                              , LATENCY_MARKER_PRESENT_START_NV
                                                              , LATENCY_MARKER_PRESENT_END_NV
                                                              , LATENCY_MARKER_INPUT_SAMPLE_NV
                                                              , LATENCY_MARKER_TRIGGER_FLASH_NV
                                                              , LATENCY_MARKER_OUT_OF_BAND_RENDERSUBMIT_START_NV
                                                              , LATENCY_MARKER_OUT_OF_BAND_RENDERSUBMIT_END_NV
                                                              , LATENCY_MARKER_OUT_OF_BAND_PRESENT_START_NV
                                                              , LATENCY_MARKER_OUT_OF_BAND_PRESENT_END_NV
                                                              , ..
                                                              )
                                             , OutOfBandQueueTypeNV( OUT_OF_BAND_QUEUE_TYPE_RENDER_NV
                                                                   , OUT_OF_BAND_QUEUE_TYPE_PRESENT_NV
                                                                   , ..
                                                                   )
                                             , NV_LOW_LATENCY_2_SPEC_VERSION
                                             , pattern NV_LOW_LATENCY_2_SPEC_VERSION
                                             , NV_LOW_LATENCY_2_EXTENSION_NAME
                                             , pattern NV_LOW_LATENCY_2_EXTENSION_NAME
                                             , SwapchainKHR(..)
                                             , PresentModeKHR(..)
                                             ) where

import Vulkan.Internal.Utils (enumReadPrec)
import Vulkan.Internal.Utils (enumShowsPrec)
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import GHC.Show (showsPrec)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
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 Control.Monad.IO.Class (MonadIO)
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Data.Int (Int32)
import Foreign.Ptr (FunPtr)
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 Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkGetLatencyTimingsNV))
import Vulkan.Dynamic (DeviceCmds(pVkLatencySleepNV))
import Vulkan.Dynamic (DeviceCmds(pVkQueueNotifyOutOfBandNV))
import Vulkan.Dynamic (DeviceCmds(pVkSetLatencyMarkerNV))
import Vulkan.Dynamic (DeviceCmds(pVkSetLatencySleepModeNV))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Extensions.VK_KHR_surface (PresentModeKHR)
import Vulkan.Core10.Handles (Queue)
import Vulkan.Core10.Handles (Queue(..))
import Vulkan.Core10.Handles (Queue(Queue))
import Vulkan.Core10.Handles (Queue_T)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Handles (Semaphore)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Extensions.Handles (SwapchainKHR)
import Vulkan.Extensions.Handles (SwapchainKHR(..))
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_GET_LATENCY_MARKER_INFO_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_LATENCY_SLEEP_INFO_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_LATENCY_SLEEP_MODE_INFO_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_LATENCY_SUBMISSION_PRESENT_ID_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_LATENCY_SURFACE_CAPABILITIES_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_LATENCY_TIMINGS_FRAME_REPORT_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_OUT_OF_BAND_QUEUE_TYPE_INFO_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SET_LATENCY_MARKER_INFO_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SWAPCHAIN_LATENCY_CREATE_INFO_NV))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Extensions.VK_KHR_surface (PresentModeKHR(..))
import Vulkan.Extensions.Handles (SwapchainKHR(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkSetLatencySleepModeNV
  :: FunPtr (Ptr Device_T -> SwapchainKHR -> Ptr LatencySleepModeInfoNV -> IO Result) -> Ptr Device_T -> SwapchainKHR -> Ptr LatencySleepModeInfoNV -> IO Result

-- | vkSetLatencySleepModeNV - Enable or Disable low latency mode on a
-- swapchain
--
-- = Description
--
-- If @pSleepModeInfo@ is @NULL@, 'setLatencySleepModeNV' will disable low
-- latency mode, low latency boost, and set the minimum present interval
-- previously specified by 'LatencySleepModeInfoNV' to zero on @swapchain@.
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_INITIALIZATION_FAILED'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_low_latency2 VK_NV_low_latency2>,
-- 'Vulkan.Core10.Handles.Device', 'LatencySleepModeInfoNV',
-- 'Vulkan.Extensions.Handles.SwapchainKHR'
setLatencySleepModeNV :: forall io
                       . (MonadIO io)
                      => -- | @device@ is the device associated with @swapchain@.
                         --
                         -- #VUID-vkSetLatencySleepModeNV-device-parameter# @device@ /must/ be a
                         -- valid 'Vulkan.Core10.Handles.Device' handle
                         Device
                      -> -- | @swapchain@ is the swapchain to enable or disable low latency mode on.
                         --
                         -- #VUID-vkSetLatencySleepModeNV-swapchain-parameter# @swapchain@ /must/ be
                         -- a valid 'Vulkan.Extensions.Handles.SwapchainKHR' handle
                         --
                         -- #VUID-vkSetLatencySleepModeNV-swapchain-parent# @swapchain@ /must/ have
                         -- been created, allocated, or retrieved from @device@
                         SwapchainKHR
                      -> -- | @pSleepModeInfo@ is @NULL@ or a pointer to a 'LatencySleepModeInfoNV'
                         -- structure specifying the parameters of the latency sleep mode.
                         --
                         -- #VUID-vkSetLatencySleepModeNV-pSleepModeInfo-parameter# @pSleepModeInfo@
                         -- /must/ be a valid pointer to a valid 'LatencySleepModeInfoNV' structure
                         LatencySleepModeInfoNV
                      -> io ()
setLatencySleepModeNV :: forall (io :: * -> *).
MonadIO io =>
Device -> SwapchainKHR -> LatencySleepModeInfoNV -> io ()
setLatencySleepModeNV Device
device SwapchainKHR
swapchain LatencySleepModeInfoNV
sleepModeInfo = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> io ()) -> ContT () IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  let vkSetLatencySleepModeNVPtr :: FunPtr
  (Ptr Device_T
   -> SwapchainKHR -> Ptr LatencySleepModeInfoNV -> IO Result)
vkSetLatencySleepModeNVPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> SwapchainKHR -> Ptr LatencySleepModeInfoNV -> IO Result)
pVkSetLatencySleepModeNV (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> SwapchainKHR -> Ptr LatencySleepModeInfoNV -> IO Result)
vkSetLatencySleepModeNVPtr FunPtr
  (Ptr Device_T
   -> SwapchainKHR -> Ptr LatencySleepModeInfoNV -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> SwapchainKHR -> Ptr LatencySleepModeInfoNV -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> SwapchainKHR -> Ptr LatencySleepModeInfoNV -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkSetLatencySleepModeNV is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkSetLatencySleepModeNV' :: Ptr Device_T
-> SwapchainKHR -> Ptr LatencySleepModeInfoNV -> IO Result
vkSetLatencySleepModeNV' = FunPtr
  (Ptr Device_T
   -> SwapchainKHR -> Ptr LatencySleepModeInfoNV -> IO Result)
-> Ptr Device_T
-> SwapchainKHR
-> Ptr LatencySleepModeInfoNV
-> IO Result
mkVkSetLatencySleepModeNV FunPtr
  (Ptr Device_T
   -> SwapchainKHR -> Ptr LatencySleepModeInfoNV -> IO Result)
vkSetLatencySleepModeNVPtr
  Ptr LatencySleepModeInfoNV
pSleepModeInfo <- ((Ptr LatencySleepModeInfoNV -> IO ()) -> IO ())
-> ContT () IO (Ptr LatencySleepModeInfoNV)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr LatencySleepModeInfoNV -> IO ()) -> IO ())
 -> ContT () IO (Ptr LatencySleepModeInfoNV))
-> ((Ptr LatencySleepModeInfoNV -> IO ()) -> IO ())
-> ContT () IO (Ptr LatencySleepModeInfoNV)
forall a b. (a -> b) -> a -> b
$ LatencySleepModeInfoNV
-> (Ptr LatencySleepModeInfoNV -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
forall b.
LatencySleepModeInfoNV
-> (Ptr LatencySleepModeInfoNV -> IO b) -> IO b
withCStruct (LatencySleepModeInfoNV
sleepModeInfo)
  Result
r <- IO Result -> ContT () IO Result
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT () IO Result)
-> IO Result -> ContT () IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkSetLatencySleepModeNV" (Ptr Device_T
-> SwapchainKHR -> Ptr LatencySleepModeInfoNV -> IO Result
vkSetLatencySleepModeNV'
                                                            (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                            (SwapchainKHR
swapchain)
                                                            Ptr LatencySleepModeInfoNV
pSleepModeInfo)
  IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkLatencySleepNV
  :: FunPtr (Ptr Device_T -> SwapchainKHR -> Ptr LatencySleepInfoNV -> IO Result) -> Ptr Device_T -> SwapchainKHR -> Ptr LatencySleepInfoNV -> IO Result

-- | vkLatencySleepNV - Trigger low latency mode Sleep
--
-- = Description
--
-- 'latencySleepNV' returns immediately. Applications /should/ use
-- 'Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore.waitSemaphores'
-- with
-- @pSleepInfo@::'Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore.signalSemaphore'
-- to delay host CPU work. CPU work refers to application work done before
-- presenting which includes but is not limited to: input sampling,
-- simulation, command buffer recording, command buffer submission, and
-- present submission. It is recommended to call this function before input
-- sampling. When using this function, it /should/ be called exactly once
-- between presents.
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_UNKNOWN'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_low_latency2 VK_NV_low_latency2>,
-- 'Vulkan.Core10.Handles.Device', 'LatencySleepInfoNV',
-- 'Vulkan.Extensions.Handles.SwapchainKHR'
latencySleepNV :: forall io
                . (MonadIO io)
               => -- | @device@ is the device associated with @swapchain@.
                  --
                  -- #VUID-vkLatencySleepNV-device-parameter# @device@ /must/ be a valid
                  -- 'Vulkan.Core10.Handles.Device' handle
                  Device
               -> -- | @swapchain@ is the swapchain to delay associated CPU work based on
                  -- 'LatencySubmissionPresentIdNV' submissions.
                  --
                  -- #VUID-vkLatencySleepNV-swapchain-parameter# @swapchain@ /must/ be a
                  -- valid 'Vulkan.Extensions.Handles.SwapchainKHR' handle
                  --
                  -- #VUID-vkLatencySleepNV-swapchain-parent# @swapchain@ /must/ have been
                  -- created, allocated, or retrieved from @device@
                  SwapchainKHR
               -> -- | @pSleepInfo@ is a pointer to a 'LatencySleepInfoNV' structure specifying
                  -- the parameters of the latency sleep.
                  --
                  -- #VUID-vkLatencySleepNV-pSleepInfo-parameter# @pSleepInfo@ /must/ be a
                  -- valid pointer to a valid 'LatencySleepInfoNV' structure
                  LatencySleepInfoNV
               -> io ()
latencySleepNV :: forall (io :: * -> *).
MonadIO io =>
Device -> SwapchainKHR -> LatencySleepInfoNV -> io ()
latencySleepNV Device
device SwapchainKHR
swapchain LatencySleepInfoNV
sleepInfo = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> io ()) -> ContT () IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  let vkLatencySleepNVPtr :: FunPtr
  (Ptr Device_T
   -> SwapchainKHR -> Ptr LatencySleepInfoNV -> IO Result)
vkLatencySleepNVPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> SwapchainKHR -> Ptr LatencySleepInfoNV -> IO Result)
pVkLatencySleepNV (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> SwapchainKHR -> Ptr LatencySleepInfoNV -> IO Result)
vkLatencySleepNVPtr FunPtr
  (Ptr Device_T
   -> SwapchainKHR -> Ptr LatencySleepInfoNV -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> SwapchainKHR -> Ptr LatencySleepInfoNV -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> SwapchainKHR -> Ptr LatencySleepInfoNV -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkLatencySleepNV is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkLatencySleepNV' :: Ptr Device_T -> SwapchainKHR -> Ptr LatencySleepInfoNV -> IO Result
vkLatencySleepNV' = FunPtr
  (Ptr Device_T
   -> SwapchainKHR -> Ptr LatencySleepInfoNV -> IO Result)
-> Ptr Device_T
-> SwapchainKHR
-> Ptr LatencySleepInfoNV
-> IO Result
mkVkLatencySleepNV FunPtr
  (Ptr Device_T
   -> SwapchainKHR -> Ptr LatencySleepInfoNV -> IO Result)
vkLatencySleepNVPtr
  Ptr LatencySleepInfoNV
pSleepInfo <- ((Ptr LatencySleepInfoNV -> IO ()) -> IO ())
-> ContT () IO (Ptr LatencySleepInfoNV)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr LatencySleepInfoNV -> IO ()) -> IO ())
 -> ContT () IO (Ptr LatencySleepInfoNV))
-> ((Ptr LatencySleepInfoNV -> IO ()) -> IO ())
-> ContT () IO (Ptr LatencySleepInfoNV)
forall a b. (a -> b) -> a -> b
$ LatencySleepInfoNV -> (Ptr LatencySleepInfoNV -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
forall b.
LatencySleepInfoNV -> (Ptr LatencySleepInfoNV -> IO b) -> IO b
withCStruct (LatencySleepInfoNV
sleepInfo)
  Result
r <- IO Result -> ContT () IO Result
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT () IO Result)
-> IO Result -> ContT () IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkLatencySleepNV" (Ptr Device_T -> SwapchainKHR -> Ptr LatencySleepInfoNV -> IO Result
vkLatencySleepNV'
                                                     (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                     (SwapchainKHR
swapchain)
                                                     Ptr LatencySleepInfoNV
pSleepInfo)
  IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkSetLatencyMarkerNV
  :: FunPtr (Ptr Device_T -> SwapchainKHR -> Ptr SetLatencyMarkerInfoNV -> IO ()) -> Ptr Device_T -> SwapchainKHR -> Ptr SetLatencyMarkerInfoNV -> IO ()

-- | vkSetLatencyMarkerNV - Pass in marker for timing info
--
-- = Description
--
-- At the beginning and end of simulation and render threads and beginning
-- and end of 'Vulkan.Extensions.VK_KHR_swapchain.queuePresentKHR' calls,
-- 'setLatencyMarkerNV' /can/ be called to provide timestamps for the
-- application’s reference. These timestamps are returned with a call to
-- 'getLatencyTimingsNV' alongside driver provided timestamps at various
-- points of interest with regards to latency within the application.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_low_latency2 VK_NV_low_latency2>,
-- 'Vulkan.Core10.Handles.Device', 'SetLatencyMarkerInfoNV',
-- 'Vulkan.Extensions.Handles.SwapchainKHR'
setLatencyMarkerNV :: forall io
                    . (MonadIO io)
                   => -- | @device@ is the device associated with @swapchain@.
                      --
                      -- #VUID-vkSetLatencyMarkerNV-device-parameter# @device@ /must/ be a valid
                      -- 'Vulkan.Core10.Handles.Device' handle
                      Device
                   -> -- | @swapchain@ is the swapchain to capture timestamps on.
                      --
                      -- #VUID-vkSetLatencyMarkerNV-swapchain-parameter# @swapchain@ /must/ be a
                      -- valid 'Vulkan.Extensions.Handles.SwapchainKHR' handle
                      --
                      -- #VUID-vkSetLatencyMarkerNV-swapchain-parent# @swapchain@ /must/ have
                      -- been created, allocated, or retrieved from @device@
                      SwapchainKHR
                   -> -- | #VUID-vkSetLatencyMarkerNV-pLatencyMarkerInfo-parameter#
                      -- @pLatencyMarkerInfo@ /must/ be a valid pointer to a valid
                      -- 'SetLatencyMarkerInfoNV' structure
                      SetLatencyMarkerInfoNV
                   -> io ()
setLatencyMarkerNV :: forall (io :: * -> *).
MonadIO io =>
Device -> SwapchainKHR -> SetLatencyMarkerInfoNV -> io ()
setLatencyMarkerNV Device
device SwapchainKHR
swapchain SetLatencyMarkerInfoNV
latencyMarkerInfo = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> io ()) -> ContT () IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  let vkSetLatencyMarkerNVPtr :: FunPtr
  (Ptr Device_T
   -> SwapchainKHR -> Ptr SetLatencyMarkerInfoNV -> IO ())
vkSetLatencyMarkerNVPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> SwapchainKHR -> Ptr SetLatencyMarkerInfoNV -> IO ())
pVkSetLatencyMarkerNV (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> SwapchainKHR -> Ptr SetLatencyMarkerInfoNV -> IO ())
vkSetLatencyMarkerNVPtr FunPtr
  (Ptr Device_T
   -> SwapchainKHR -> Ptr SetLatencyMarkerInfoNV -> IO ())
-> FunPtr
     (Ptr Device_T
      -> SwapchainKHR -> Ptr SetLatencyMarkerInfoNV -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> SwapchainKHR -> Ptr SetLatencyMarkerInfoNV -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkSetLatencyMarkerNV is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkSetLatencyMarkerNV' :: Ptr Device_T -> SwapchainKHR -> Ptr SetLatencyMarkerInfoNV -> IO ()
vkSetLatencyMarkerNV' = FunPtr
  (Ptr Device_T
   -> SwapchainKHR -> Ptr SetLatencyMarkerInfoNV -> IO ())
-> Ptr Device_T
-> SwapchainKHR
-> Ptr SetLatencyMarkerInfoNV
-> IO ()
mkVkSetLatencyMarkerNV FunPtr
  (Ptr Device_T
   -> SwapchainKHR -> Ptr SetLatencyMarkerInfoNV -> IO ())
vkSetLatencyMarkerNVPtr
  Ptr SetLatencyMarkerInfoNV
pLatencyMarkerInfo <- ((Ptr SetLatencyMarkerInfoNV -> IO ()) -> IO ())
-> ContT () IO (Ptr SetLatencyMarkerInfoNV)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr SetLatencyMarkerInfoNV -> IO ()) -> IO ())
 -> ContT () IO (Ptr SetLatencyMarkerInfoNV))
-> ((Ptr SetLatencyMarkerInfoNV -> IO ()) -> IO ())
-> ContT () IO (Ptr SetLatencyMarkerInfoNV)
forall a b. (a -> b) -> a -> b
$ SetLatencyMarkerInfoNV
-> (Ptr SetLatencyMarkerInfoNV -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
forall b.
SetLatencyMarkerInfoNV
-> (Ptr SetLatencyMarkerInfoNV -> IO b) -> IO b
withCStruct (SetLatencyMarkerInfoNV
latencyMarkerInfo)
  IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkSetLatencyMarkerNV" (Ptr Device_T -> SwapchainKHR -> Ptr SetLatencyMarkerInfoNV -> IO ()
vkSetLatencyMarkerNV'
                                                    (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                    (SwapchainKHR
swapchain)
                                                    Ptr SetLatencyMarkerInfoNV
pLatencyMarkerInfo)
  () -> ContT () IO ()
forall a. a -> ContT () IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetLatencyTimingsNV
  :: FunPtr (Ptr Device_T -> SwapchainKHR -> Ptr Word32 -> Ptr GetLatencyMarkerInfoNV -> IO ()) -> Ptr Device_T -> SwapchainKHR -> Ptr Word32 -> Ptr GetLatencyMarkerInfoNV -> IO ()

-- | vkGetLatencyTimingsNV - Get latency marker results
--
-- = Description
--
-- The timings returned by 'getLatencyTimingsNV' contain the timestamps
-- requested from 'setLatencyMarkerNV' and additional
-- implementation-specific markers defined in
-- 'LatencyTimingsFrameReportNV'. If @pTimings@ is @NULL@, then the maximum
-- number of queryable frame data is returned in @pTimingCount@. Otherwise,
-- @pTimingCount@ /must/ point to a variable set by the user to the number
-- of elements in the @pTimings@ array in @pGetLatencyMarkerInfo@, and on
-- return the variable is overwritten with the number of values actually
-- written to @pTimings@.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_low_latency2 VK_NV_low_latency2>,
-- 'Vulkan.Core10.Handles.Device', 'GetLatencyMarkerInfoNV',
-- 'Vulkan.Extensions.Handles.SwapchainKHR'
getLatencyTimingsNV :: forall io
                     . (MonadIO io)
                    => -- | @device@ is the device associated with @swapchain@.
                       --
                       -- #VUID-vkGetLatencyTimingsNV-device-parameter# @device@ /must/ be a valid
                       -- 'Vulkan.Core10.Handles.Device' handle
                       Device
                    -> -- | @swapchain@ is the swapchain to return data from.
                       --
                       -- #VUID-vkGetLatencyTimingsNV-swapchain-parameter# @swapchain@ /must/ be a
                       -- valid 'Vulkan.Extensions.Handles.SwapchainKHR' handle
                       --
                       -- #VUID-vkGetLatencyTimingsNV-swapchain-parent# @swapchain@ /must/ have
                       -- been created, allocated, or retrieved from @device@
                       SwapchainKHR
                    -> io (("timingCount" ::: Word32), GetLatencyMarkerInfoNV)
getLatencyTimingsNV :: forall (io :: * -> *).
MonadIO io =>
Device
-> SwapchainKHR
-> io ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
getLatencyTimingsNV Device
device SwapchainKHR
swapchain = IO ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
-> io ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
 -> io ("timingCount" ::: Word32, GetLatencyMarkerInfoNV))
-> (ContT
      ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
      IO
      ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
    -> IO ("timingCount" ::: Word32, GetLatencyMarkerInfoNV))
-> ContT
     ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
     IO
     ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
-> io ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
  IO
  ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
-> IO ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
   IO
   ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
 -> io ("timingCount" ::: Word32, GetLatencyMarkerInfoNV))
-> ContT
     ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
     IO
     ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
-> io ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
forall a b. (a -> b) -> a -> b
$ do
  let vkGetLatencyTimingsNVPtr :: FunPtr
  (Ptr Device_T
   -> SwapchainKHR
   -> Ptr ("timingCount" ::: Word32)
   -> Ptr GetLatencyMarkerInfoNV
   -> IO ())
vkGetLatencyTimingsNVPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> SwapchainKHR
      -> Ptr ("timingCount" ::: Word32)
      -> Ptr GetLatencyMarkerInfoNV
      -> IO ())
pVkGetLatencyTimingsNV (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO ()
-> ContT ("timingCount" ::: Word32, GetLatencyMarkerInfoNV) IO ()
forall (m :: * -> *) a.
Monad m =>
m a -> ContT ("timingCount" ::: Word32, GetLatencyMarkerInfoNV) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT ("timingCount" ::: Word32, GetLatencyMarkerInfoNV) IO ())
-> IO ()
-> ContT ("timingCount" ::: Word32, GetLatencyMarkerInfoNV) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> SwapchainKHR
   -> Ptr ("timingCount" ::: Word32)
   -> Ptr GetLatencyMarkerInfoNV
   -> IO ())
vkGetLatencyTimingsNVPtr FunPtr
  (Ptr Device_T
   -> SwapchainKHR
   -> Ptr ("timingCount" ::: Word32)
   -> Ptr GetLatencyMarkerInfoNV
   -> IO ())
-> FunPtr
     (Ptr Device_T
      -> SwapchainKHR
      -> Ptr ("timingCount" ::: Word32)
      -> Ptr GetLatencyMarkerInfoNV
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> SwapchainKHR
   -> Ptr ("timingCount" ::: Word32)
   -> Ptr GetLatencyMarkerInfoNV
   -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetLatencyTimingsNV is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetLatencyTimingsNV' :: Ptr Device_T
-> SwapchainKHR
-> Ptr ("timingCount" ::: Word32)
-> Ptr GetLatencyMarkerInfoNV
-> IO ()
vkGetLatencyTimingsNV' = FunPtr
  (Ptr Device_T
   -> SwapchainKHR
   -> Ptr ("timingCount" ::: Word32)
   -> Ptr GetLatencyMarkerInfoNV
   -> IO ())
-> Ptr Device_T
-> SwapchainKHR
-> Ptr ("timingCount" ::: Word32)
-> Ptr GetLatencyMarkerInfoNV
-> IO ()
mkVkGetLatencyTimingsNV FunPtr
  (Ptr Device_T
   -> SwapchainKHR
   -> Ptr ("timingCount" ::: Word32)
   -> Ptr GetLatencyMarkerInfoNV
   -> IO ())
vkGetLatencyTimingsNVPtr
  Ptr ("timingCount" ::: Word32)
pPTimingCount <- ((Ptr ("timingCount" ::: Word32)
  -> IO ("timingCount" ::: Word32, GetLatencyMarkerInfoNV))
 -> IO ("timingCount" ::: Word32, GetLatencyMarkerInfoNV))
-> ContT
     ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
     IO
     (Ptr ("timingCount" ::: Word32))
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ("timingCount" ::: Word32)
   -> IO ("timingCount" ::: Word32, GetLatencyMarkerInfoNV))
  -> IO ("timingCount" ::: Word32, GetLatencyMarkerInfoNV))
 -> ContT
      ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
      IO
      (Ptr ("timingCount" ::: Word32)))
-> ((Ptr ("timingCount" ::: Word32)
     -> IO ("timingCount" ::: Word32, GetLatencyMarkerInfoNV))
    -> IO ("timingCount" ::: Word32, GetLatencyMarkerInfoNV))
-> ContT
     ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
     IO
     (Ptr ("timingCount" ::: Word32))
forall a b. (a -> b) -> a -> b
$ IO (Ptr ("timingCount" ::: Word32))
-> (Ptr ("timingCount" ::: Word32) -> IO ())
-> (Ptr ("timingCount" ::: Word32)
    -> IO ("timingCount" ::: Word32, GetLatencyMarkerInfoNV))
-> IO ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @Word32 Int
4) Ptr ("timingCount" ::: Word32) -> IO ()
forall a. Ptr a -> IO ()
free
  Ptr GetLatencyMarkerInfoNV
pPLatencyMarkerInfo <- ((Ptr GetLatencyMarkerInfoNV
  -> IO ("timingCount" ::: Word32, GetLatencyMarkerInfoNV))
 -> IO ("timingCount" ::: Word32, GetLatencyMarkerInfoNV))
-> ContT
     ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
     IO
     (Ptr GetLatencyMarkerInfoNV)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @GetLatencyMarkerInfoNV)
  IO ()
-> ContT ("timingCount" ::: Word32, GetLatencyMarkerInfoNV) IO ()
forall (m :: * -> *) a.
Monad m =>
m a -> ContT ("timingCount" ::: Word32, GetLatencyMarkerInfoNV) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT ("timingCount" ::: Word32, GetLatencyMarkerInfoNV) IO ())
-> IO ()
-> ContT ("timingCount" ::: Word32, GetLatencyMarkerInfoNV) IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetLatencyTimingsNV" (Ptr Device_T
-> SwapchainKHR
-> Ptr ("timingCount" ::: Word32)
-> Ptr GetLatencyMarkerInfoNV
-> IO ()
vkGetLatencyTimingsNV'
                                                     (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                     (SwapchainKHR
swapchain)
                                                     (Ptr ("timingCount" ::: Word32)
pPTimingCount)
                                                     (Ptr GetLatencyMarkerInfoNV
pPLatencyMarkerInfo))
  "timingCount" ::: Word32
pTimingCount <- IO ("timingCount" ::: Word32)
-> ContT
     ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
     IO
     ("timingCount" ::: Word32)
forall (m :: * -> *) a.
Monad m =>
m a -> ContT ("timingCount" ::: Word32, GetLatencyMarkerInfoNV) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("timingCount" ::: Word32)
 -> ContT
      ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
      IO
      ("timingCount" ::: Word32))
-> IO ("timingCount" ::: Word32)
-> ContT
     ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
     IO
     ("timingCount" ::: Word32)
forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Word32 Ptr ("timingCount" ::: Word32)
pPTimingCount
  GetLatencyMarkerInfoNV
pLatencyMarkerInfo <- IO GetLatencyMarkerInfoNV
-> ContT
     ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
     IO
     GetLatencyMarkerInfoNV
forall (m :: * -> *) a.
Monad m =>
m a -> ContT ("timingCount" ::: Word32, GetLatencyMarkerInfoNV) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO GetLatencyMarkerInfoNV
 -> ContT
      ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
      IO
      GetLatencyMarkerInfoNV)
-> IO GetLatencyMarkerInfoNV
-> ContT
     ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
     IO
     GetLatencyMarkerInfoNV
forall a b. (a -> b) -> a -> b
$ forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @GetLatencyMarkerInfoNV Ptr GetLatencyMarkerInfoNV
pPLatencyMarkerInfo
  ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
-> ContT
     ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
     IO
     ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
forall a.
a -> ContT ("timingCount" ::: Word32, GetLatencyMarkerInfoNV) IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
 -> ContT
      ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
      IO
      ("timingCount" ::: Word32, GetLatencyMarkerInfoNV))
-> ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
-> ContT
     ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
     IO
     ("timingCount" ::: Word32, GetLatencyMarkerInfoNV)
forall a b. (a -> b) -> a -> b
$ ("timingCount" ::: Word32
pTimingCount, GetLatencyMarkerInfoNV
pLatencyMarkerInfo)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkQueueNotifyOutOfBandNV
  :: FunPtr (Ptr Queue_T -> Ptr OutOfBandQueueTypeInfoNV -> IO ()) -> Ptr Queue_T -> Ptr OutOfBandQueueTypeInfoNV -> IO ()

-- | vkQueueNotifyOutOfBandNV - Notify out of band queue
--
-- == Command Properties
--
-- \'
--
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
-- | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkCommandBufferLevel Command Buffer Levels> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginRenderPass Render Pass Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginVideoCodingKHR Video Coding Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkQueueFlagBits Supported Queue Types> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-queueoperation-command-types Command Type> |
-- +============================================================================================================================+========================================================================================================================+=============================================================================================================================+=======================================================================================================================+========================================================================================================================================+
-- | -                                                                                                                          | -                                                                                                                      | -                                                                                                                           | Any                                                                                                                   | -                                                                                                                                      |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_low_latency2 VK_NV_low_latency2>,
-- 'OutOfBandQueueTypeInfoNV', 'Vulkan.Core10.Handles.Queue'
queueNotifyOutOfBandNV :: forall io
                        . (MonadIO io)
                       => -- | @queue@ is the VkQueue to be marked as out of band.
                          --
                          -- #VUID-vkQueueNotifyOutOfBandNV-queue-parameter# @queue@ /must/ be a
                          -- valid 'Vulkan.Core10.Handles.Queue' handle
                          Queue
                       -> -- | @pQueueTypeInfo@ is a pointer to a 'OutOfBandQueueTypeInfoNV' structure
                          -- specifying the queue type.
                          --
                          -- #VUID-vkQueueNotifyOutOfBandNV-pQueueTypeInfo-parameter#
                          -- @pQueueTypeInfo@ /must/ be a valid pointer to a valid
                          -- 'OutOfBandQueueTypeInfoNV' structure
                          OutOfBandQueueTypeInfoNV
                       -> io ()
queueNotifyOutOfBandNV :: forall (io :: * -> *).
MonadIO io =>
Queue -> OutOfBandQueueTypeInfoNV -> io ()
queueNotifyOutOfBandNV Queue
queue OutOfBandQueueTypeInfoNV
queueTypeInfo = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> io ()) -> ContT () IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  let vkQueueNotifyOutOfBandNVPtr :: FunPtr (Ptr Queue_T -> Ptr OutOfBandQueueTypeInfoNV -> IO ())
vkQueueNotifyOutOfBandNVPtr = DeviceCmds
-> FunPtr (Ptr Queue_T -> Ptr OutOfBandQueueTypeInfoNV -> IO ())
pVkQueueNotifyOutOfBandNV (case Queue
queue of Queue{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Queue :: Queue -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr (Ptr Queue_T -> Ptr OutOfBandQueueTypeInfoNV -> IO ())
vkQueueNotifyOutOfBandNVPtr FunPtr (Ptr Queue_T -> Ptr OutOfBandQueueTypeInfoNV -> IO ())
-> FunPtr (Ptr Queue_T -> Ptr OutOfBandQueueTypeInfoNV -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr (Ptr Queue_T -> Ptr OutOfBandQueueTypeInfoNV -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkQueueNotifyOutOfBandNV is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkQueueNotifyOutOfBandNV' :: Ptr Queue_T -> Ptr OutOfBandQueueTypeInfoNV -> IO ()
vkQueueNotifyOutOfBandNV' = FunPtr (Ptr Queue_T -> Ptr OutOfBandQueueTypeInfoNV -> IO ())
-> Ptr Queue_T -> Ptr OutOfBandQueueTypeInfoNV -> IO ()
mkVkQueueNotifyOutOfBandNV FunPtr (Ptr Queue_T -> Ptr OutOfBandQueueTypeInfoNV -> IO ())
vkQueueNotifyOutOfBandNVPtr
  Ptr OutOfBandQueueTypeInfoNV
pQueueTypeInfo <- ((Ptr OutOfBandQueueTypeInfoNV -> IO ()) -> IO ())
-> ContT () IO (Ptr OutOfBandQueueTypeInfoNV)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr OutOfBandQueueTypeInfoNV -> IO ()) -> IO ())
 -> ContT () IO (Ptr OutOfBandQueueTypeInfoNV))
-> ((Ptr OutOfBandQueueTypeInfoNV -> IO ()) -> IO ())
-> ContT () IO (Ptr OutOfBandQueueTypeInfoNV)
forall a b. (a -> b) -> a -> b
$ OutOfBandQueueTypeInfoNV
-> (Ptr OutOfBandQueueTypeInfoNV -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
forall b.
OutOfBandQueueTypeInfoNV
-> (Ptr OutOfBandQueueTypeInfoNV -> IO b) -> IO b
withCStruct (OutOfBandQueueTypeInfoNV
queueTypeInfo)
  IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkQueueNotifyOutOfBandNV" (Ptr Queue_T -> Ptr OutOfBandQueueTypeInfoNV -> IO ()
vkQueueNotifyOutOfBandNV'
                                                        (Queue -> Ptr Queue_T
queueHandle (Queue
queue))
                                                        Ptr OutOfBandQueueTypeInfoNV
pQueueTypeInfo)
  () -> ContT () IO ()
forall a. a -> ContT () IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()


-- | VkLatencySleepModeInfoNV - Structure to set low latency mode
--
-- = Description
--
-- If @lowLatencyMode@ is set to 'Vulkan.Core10.FundamentalTypes.FALSE',
-- @lowLatencyBoost@ will still hint to the GPU to increase its power state
-- and 'latencySleepNV' will still enforce @minimumIntervalUs@ between
-- 'Vulkan.Extensions.VK_KHR_swapchain.queuePresentKHR' calls.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_low_latency2 VK_NV_low_latency2>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'setLatencySleepModeNV'
data LatencySleepModeInfoNV = LatencySleepModeInfoNV
  { -- | @lowLatencyMode@ is the toggle to enable or disable low latency mode.
    LatencySleepModeInfoNV -> Bool
lowLatencyMode :: Bool
  , -- | @lowLatencyBoost@ allows an application to hint to the GPU to increase
    -- performance to provide additional latency savings at a cost of increased
    -- power consumption.
    LatencySleepModeInfoNV -> Bool
lowLatencyBoost :: Bool
  , -- No documentation found for Nested "VkLatencySleepModeInfoNV" "minimumIntervalUs"
    LatencySleepModeInfoNV -> "timingCount" ::: Word32
minimumIntervalUs :: Word32
  }
  deriving (Typeable, LatencySleepModeInfoNV -> LatencySleepModeInfoNV -> Bool
(LatencySleepModeInfoNV -> LatencySleepModeInfoNV -> Bool)
-> (LatencySleepModeInfoNV -> LatencySleepModeInfoNV -> Bool)
-> Eq LatencySleepModeInfoNV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LatencySleepModeInfoNV -> LatencySleepModeInfoNV -> Bool
== :: LatencySleepModeInfoNV -> LatencySleepModeInfoNV -> Bool
$c/= :: LatencySleepModeInfoNV -> LatencySleepModeInfoNV -> Bool
/= :: LatencySleepModeInfoNV -> LatencySleepModeInfoNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (LatencySleepModeInfoNV)
#endif
deriving instance Show LatencySleepModeInfoNV

instance ToCStruct LatencySleepModeInfoNV where
  withCStruct :: forall b.
LatencySleepModeInfoNV
-> (Ptr LatencySleepModeInfoNV -> IO b) -> IO b
withCStruct LatencySleepModeInfoNV
x Ptr LatencySleepModeInfoNV -> IO b
f = Int -> (Ptr LatencySleepModeInfoNV -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((Ptr LatencySleepModeInfoNV -> IO b) -> IO b)
-> (Ptr LatencySleepModeInfoNV -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr LatencySleepModeInfoNV
p -> Ptr LatencySleepModeInfoNV
-> LatencySleepModeInfoNV -> IO b -> IO b
forall b.
Ptr LatencySleepModeInfoNV
-> LatencySleepModeInfoNV -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr LatencySleepModeInfoNV
p LatencySleepModeInfoNV
x (Ptr LatencySleepModeInfoNV -> IO b
f Ptr LatencySleepModeInfoNV
p)
  pokeCStruct :: forall b.
Ptr LatencySleepModeInfoNV
-> LatencySleepModeInfoNV -> IO b -> IO b
pokeCStruct Ptr LatencySleepModeInfoNV
p LatencySleepModeInfoNV{Bool
"timingCount" ::: Word32
$sel:lowLatencyMode:LatencySleepModeInfoNV :: LatencySleepModeInfoNV -> Bool
$sel:lowLatencyBoost:LatencySleepModeInfoNV :: LatencySleepModeInfoNV -> Bool
$sel:minimumIntervalUs:LatencySleepModeInfoNV :: LatencySleepModeInfoNV -> "timingCount" ::: Word32
lowLatencyMode :: Bool
lowLatencyBoost :: Bool
minimumIntervalUs :: "timingCount" ::: Word32
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencySleepModeInfoNV
p Ptr LatencySleepModeInfoNV -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_LATENCY_SLEEP_MODE_INFO_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencySleepModeInfoNV
p Ptr LatencySleepModeInfoNV -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencySleepModeInfoNV
p Ptr LatencySleepModeInfoNV -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
lowLatencyMode))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencySleepModeInfoNV
p Ptr LatencySleepModeInfoNV -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
lowLatencyBoost))
    Ptr ("timingCount" ::: Word32)
-> ("timingCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencySleepModeInfoNV
p Ptr LatencySleepModeInfoNV -> Int -> Ptr ("timingCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) ("timingCount" ::: Word32
minimumIntervalUs)
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr LatencySleepModeInfoNV -> IO b -> IO b
pokeZeroCStruct Ptr LatencySleepModeInfoNV
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencySleepModeInfoNV
p Ptr LatencySleepModeInfoNV -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_LATENCY_SLEEP_MODE_INFO_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencySleepModeInfoNV
p Ptr LatencySleepModeInfoNV -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencySleepModeInfoNV
p Ptr LatencySleepModeInfoNV -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencySleepModeInfoNV
p Ptr LatencySleepModeInfoNV -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr ("timingCount" ::: Word32)
-> ("timingCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencySleepModeInfoNV
p Ptr LatencySleepModeInfoNV -> Int -> Ptr ("timingCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) ("timingCount" ::: Word32
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct LatencySleepModeInfoNV where
  peekCStruct :: Ptr LatencySleepModeInfoNV -> IO LatencySleepModeInfoNV
peekCStruct Ptr LatencySleepModeInfoNV
p = do
    Bool32
lowLatencyMode <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr LatencySleepModeInfoNV
p Ptr LatencySleepModeInfoNV -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
    Bool32
lowLatencyBoost <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr LatencySleepModeInfoNV
p Ptr LatencySleepModeInfoNV -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32))
    "timingCount" ::: Word32
minimumIntervalUs <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr LatencySleepModeInfoNV
p Ptr LatencySleepModeInfoNV -> Int -> Ptr ("timingCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32))
    LatencySleepModeInfoNV -> IO LatencySleepModeInfoNV
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LatencySleepModeInfoNV -> IO LatencySleepModeInfoNV)
-> LatencySleepModeInfoNV -> IO LatencySleepModeInfoNV
forall a b. (a -> b) -> a -> b
$ Bool
-> Bool -> ("timingCount" ::: Word32) -> LatencySleepModeInfoNV
LatencySleepModeInfoNV
             (Bool32 -> Bool
bool32ToBool Bool32
lowLatencyMode)
             (Bool32 -> Bool
bool32ToBool Bool32
lowLatencyBoost)
             "timingCount" ::: Word32
minimumIntervalUs

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

instance Zero LatencySleepModeInfoNV where
  zero :: LatencySleepModeInfoNV
zero = Bool
-> Bool -> ("timingCount" ::: Word32) -> LatencySleepModeInfoNV
LatencySleepModeInfoNV
           Bool
forall a. Zero a => a
zero
           Bool
forall a. Zero a => a
zero
           "timingCount" ::: Word32
forall a. Zero a => a
zero


-- | VkLatencySleepInfoNV - Structure specifying the parameters of
-- vkLatencySleepNV
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_low_latency2 VK_NV_low_latency2>,
-- 'Vulkan.Core10.Handles.Semaphore',
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'latencySleepNV'
data LatencySleepInfoNV = LatencySleepInfoNV
  { -- | 'Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore.signalSemaphore'
    -- is a semaphore that is signaled to indicate that the application
    -- /should/ resume input sampling work.
    --
    -- #VUID-VkLatencySleepInfoNV-signalSemaphore-09361#
    -- 'Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore.signalSemaphore'
    -- /must/ be a timeline semaphore
    --
    -- #VUID-VkLatencySleepInfoNV-signalSemaphore-parameter#
    -- 'Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore.signalSemaphore'
    -- /must/ be a valid 'Vulkan.Core10.Handles.Semaphore' handle
    LatencySleepInfoNV -> Semaphore
signalSemaphore :: Semaphore
  , -- | @value@ is the value that
    -- 'Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore.signalSemaphore'
    -- is set to for resuming sampling work.
    LatencySleepInfoNV -> Word64
value :: Word64
  }
  deriving (Typeable, LatencySleepInfoNV -> LatencySleepInfoNV -> Bool
(LatencySleepInfoNV -> LatencySleepInfoNV -> Bool)
-> (LatencySleepInfoNV -> LatencySleepInfoNV -> Bool)
-> Eq LatencySleepInfoNV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LatencySleepInfoNV -> LatencySleepInfoNV -> Bool
== :: LatencySleepInfoNV -> LatencySleepInfoNV -> Bool
$c/= :: LatencySleepInfoNV -> LatencySleepInfoNV -> Bool
/= :: LatencySleepInfoNV -> LatencySleepInfoNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (LatencySleepInfoNV)
#endif
deriving instance Show LatencySleepInfoNV

instance ToCStruct LatencySleepInfoNV where
  withCStruct :: forall b.
LatencySleepInfoNV -> (Ptr LatencySleepInfoNV -> IO b) -> IO b
withCStruct LatencySleepInfoNV
x Ptr LatencySleepInfoNV -> IO b
f = Int -> (Ptr LatencySleepInfoNV -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((Ptr LatencySleepInfoNV -> IO b) -> IO b)
-> (Ptr LatencySleepInfoNV -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr LatencySleepInfoNV
p -> Ptr LatencySleepInfoNV -> LatencySleepInfoNV -> IO b -> IO b
forall b.
Ptr LatencySleepInfoNV -> LatencySleepInfoNV -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr LatencySleepInfoNV
p LatencySleepInfoNV
x (Ptr LatencySleepInfoNV -> IO b
f Ptr LatencySleepInfoNV
p)
  pokeCStruct :: forall b.
Ptr LatencySleepInfoNV -> LatencySleepInfoNV -> IO b -> IO b
pokeCStruct Ptr LatencySleepInfoNV
p LatencySleepInfoNV{Word64
Semaphore
$sel:signalSemaphore:LatencySleepInfoNV :: LatencySleepInfoNV -> Semaphore
$sel:value:LatencySleepInfoNV :: LatencySleepInfoNV -> Word64
signalSemaphore :: Semaphore
value :: Word64
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencySleepInfoNV
p Ptr LatencySleepInfoNV -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_LATENCY_SLEEP_INFO_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencySleepInfoNV
p Ptr LatencySleepInfoNV -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Semaphore -> Semaphore -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencySleepInfoNV
p Ptr LatencySleepInfoNV -> Int -> Ptr Semaphore
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Semaphore)) (Semaphore
signalSemaphore)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencySleepInfoNV
p Ptr LatencySleepInfoNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word64)) (Word64
value)
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr LatencySleepInfoNV -> IO b -> IO b
pokeZeroCStruct Ptr LatencySleepInfoNV
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencySleepInfoNV
p Ptr LatencySleepInfoNV -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_LATENCY_SLEEP_INFO_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencySleepInfoNV
p Ptr LatencySleepInfoNV -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Semaphore -> Semaphore -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencySleepInfoNV
p Ptr LatencySleepInfoNV -> Int -> Ptr Semaphore
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Semaphore)) (Semaphore
forall a. Zero a => a
zero)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencySleepInfoNV
p Ptr LatencySleepInfoNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word64)) (Word64
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct LatencySleepInfoNV where
  peekCStruct :: Ptr LatencySleepInfoNV -> IO LatencySleepInfoNV
peekCStruct Ptr LatencySleepInfoNV
p = do
    Semaphore
signalSemaphore <- forall a. Storable a => Ptr a -> IO a
peek @Semaphore ((Ptr LatencySleepInfoNV
p Ptr LatencySleepInfoNV -> Int -> Ptr Semaphore
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Semaphore))
    Word64
value <- forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr LatencySleepInfoNV
p Ptr LatencySleepInfoNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word64))
    LatencySleepInfoNV -> IO LatencySleepInfoNV
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LatencySleepInfoNV -> IO LatencySleepInfoNV)
-> LatencySleepInfoNV -> IO LatencySleepInfoNV
forall a b. (a -> b) -> a -> b
$ Semaphore -> Word64 -> LatencySleepInfoNV
LatencySleepInfoNV
             Semaphore
signalSemaphore Word64
value

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

instance Zero LatencySleepInfoNV where
  zero :: LatencySleepInfoNV
zero = Semaphore -> Word64 -> LatencySleepInfoNV
LatencySleepInfoNV
           Semaphore
forall a. Zero a => a
zero
           Word64
forall a. Zero a => a
zero


-- | VkSetLatencyMarkerInfoNV - Structure specifying the parameters of
-- vkSetLatencyMarkerNV
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_low_latency2 VK_NV_low_latency2>,
-- 'LatencyMarkerNV', 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'setLatencyMarkerNV'
data SetLatencyMarkerInfoNV = SetLatencyMarkerInfoNV
  { -- No documentation found for Nested "VkSetLatencyMarkerInfoNV" "presentID"
    SetLatencyMarkerInfoNV -> Word64
presentID :: Word64
  , -- | @marker@ is the type of timestamp to be recorded.
    --
    -- #VUID-VkSetLatencyMarkerInfoNV-marker-parameter# @marker@ /must/ be a
    -- valid 'LatencyMarkerNV' value
    SetLatencyMarkerInfoNV -> LatencyMarkerNV
marker :: LatencyMarkerNV
  }
  deriving (Typeable, SetLatencyMarkerInfoNV -> SetLatencyMarkerInfoNV -> Bool
(SetLatencyMarkerInfoNV -> SetLatencyMarkerInfoNV -> Bool)
-> (SetLatencyMarkerInfoNV -> SetLatencyMarkerInfoNV -> Bool)
-> Eq SetLatencyMarkerInfoNV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SetLatencyMarkerInfoNV -> SetLatencyMarkerInfoNV -> Bool
== :: SetLatencyMarkerInfoNV -> SetLatencyMarkerInfoNV -> Bool
$c/= :: SetLatencyMarkerInfoNV -> SetLatencyMarkerInfoNV -> Bool
/= :: SetLatencyMarkerInfoNV -> SetLatencyMarkerInfoNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SetLatencyMarkerInfoNV)
#endif
deriving instance Show SetLatencyMarkerInfoNV

instance ToCStruct SetLatencyMarkerInfoNV where
  withCStruct :: forall b.
SetLatencyMarkerInfoNV
-> (Ptr SetLatencyMarkerInfoNV -> IO b) -> IO b
withCStruct SetLatencyMarkerInfoNV
x Ptr SetLatencyMarkerInfoNV -> IO b
f = Int -> (Ptr SetLatencyMarkerInfoNV -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((Ptr SetLatencyMarkerInfoNV -> IO b) -> IO b)
-> (Ptr SetLatencyMarkerInfoNV -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr SetLatencyMarkerInfoNV
p -> Ptr SetLatencyMarkerInfoNV
-> SetLatencyMarkerInfoNV -> IO b -> IO b
forall b.
Ptr SetLatencyMarkerInfoNV
-> SetLatencyMarkerInfoNV -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SetLatencyMarkerInfoNV
p SetLatencyMarkerInfoNV
x (Ptr SetLatencyMarkerInfoNV -> IO b
f Ptr SetLatencyMarkerInfoNV
p)
  pokeCStruct :: forall b.
Ptr SetLatencyMarkerInfoNV
-> SetLatencyMarkerInfoNV -> IO b -> IO b
pokeCStruct Ptr SetLatencyMarkerInfoNV
p SetLatencyMarkerInfoNV{Word64
LatencyMarkerNV
$sel:presentID:SetLatencyMarkerInfoNV :: SetLatencyMarkerInfoNV -> Word64
$sel:marker:SetLatencyMarkerInfoNV :: SetLatencyMarkerInfoNV -> LatencyMarkerNV
presentID :: Word64
marker :: LatencyMarkerNV
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SetLatencyMarkerInfoNV
p Ptr SetLatencyMarkerInfoNV -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SET_LATENCY_MARKER_INFO_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SetLatencyMarkerInfoNV
p Ptr SetLatencyMarkerInfoNV -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SetLatencyMarkerInfoNV
p Ptr SetLatencyMarkerInfoNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word64)) (Word64
presentID)
    Ptr LatencyMarkerNV -> LatencyMarkerNV -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SetLatencyMarkerInfoNV
p Ptr SetLatencyMarkerInfoNV -> Int -> Ptr LatencyMarkerNV
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr LatencyMarkerNV)) (LatencyMarkerNV
marker)
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr SetLatencyMarkerInfoNV -> IO b -> IO b
pokeZeroCStruct Ptr SetLatencyMarkerInfoNV
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SetLatencyMarkerInfoNV
p Ptr SetLatencyMarkerInfoNV -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SET_LATENCY_MARKER_INFO_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SetLatencyMarkerInfoNV
p Ptr SetLatencyMarkerInfoNV -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SetLatencyMarkerInfoNV
p Ptr SetLatencyMarkerInfoNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word64)) (Word64
forall a. Zero a => a
zero)
    Ptr LatencyMarkerNV -> LatencyMarkerNV -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SetLatencyMarkerInfoNV
p Ptr SetLatencyMarkerInfoNV -> Int -> Ptr LatencyMarkerNV
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr LatencyMarkerNV)) (LatencyMarkerNV
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct SetLatencyMarkerInfoNV where
  peekCStruct :: Ptr SetLatencyMarkerInfoNV -> IO SetLatencyMarkerInfoNV
peekCStruct Ptr SetLatencyMarkerInfoNV
p = do
    Word64
presentID <- forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr SetLatencyMarkerInfoNV
p Ptr SetLatencyMarkerInfoNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word64))
    LatencyMarkerNV
marker <- forall a. Storable a => Ptr a -> IO a
peek @LatencyMarkerNV ((Ptr SetLatencyMarkerInfoNV
p Ptr SetLatencyMarkerInfoNV -> Int -> Ptr LatencyMarkerNV
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr LatencyMarkerNV))
    SetLatencyMarkerInfoNV -> IO SetLatencyMarkerInfoNV
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SetLatencyMarkerInfoNV -> IO SetLatencyMarkerInfoNV)
-> SetLatencyMarkerInfoNV -> IO SetLatencyMarkerInfoNV
forall a b. (a -> b) -> a -> b
$ Word64 -> LatencyMarkerNV -> SetLatencyMarkerInfoNV
SetLatencyMarkerInfoNV
             Word64
presentID LatencyMarkerNV
marker

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

instance Zero SetLatencyMarkerInfoNV where
  zero :: SetLatencyMarkerInfoNV
zero = Word64 -> LatencyMarkerNV -> SetLatencyMarkerInfoNV
SetLatencyMarkerInfoNV
           Word64
forall a. Zero a => a
zero
           LatencyMarkerNV
forall a. Zero a => a
zero


-- | VkGetLatencyMarkerInfoNV - Structure specifying the parameters of
-- vkGetLatencyTimingsNV
--
-- = Description
--
-- The elements of @pTimings@ are arranged in the order they were requested
-- in, with the oldest data in the first entry.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_low_latency2 VK_NV_low_latency2>,
-- 'LatencyTimingsFrameReportNV',
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'getLatencyTimingsNV'
data GetLatencyMarkerInfoNV = GetLatencyMarkerInfoNV
  { -- | @pTimings@ is either @NULL@ or a pointer to an array of
    -- 'LatencyTimingsFrameReportNV' structures.
    --
    -- #VUID-VkGetLatencyMarkerInfoNV-pTimings-parameter# @pTimings@ /must/ be
    -- a valid pointer to a 'LatencyTimingsFrameReportNV' structure
    GetLatencyMarkerInfoNV -> Ptr LatencyTimingsFrameReportNV
timings :: Ptr LatencyTimingsFrameReportNV }
  deriving (Typeable, GetLatencyMarkerInfoNV -> GetLatencyMarkerInfoNV -> Bool
(GetLatencyMarkerInfoNV -> GetLatencyMarkerInfoNV -> Bool)
-> (GetLatencyMarkerInfoNV -> GetLatencyMarkerInfoNV -> Bool)
-> Eq GetLatencyMarkerInfoNV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetLatencyMarkerInfoNV -> GetLatencyMarkerInfoNV -> Bool
== :: GetLatencyMarkerInfoNV -> GetLatencyMarkerInfoNV -> Bool
$c/= :: GetLatencyMarkerInfoNV -> GetLatencyMarkerInfoNV -> Bool
/= :: GetLatencyMarkerInfoNV -> GetLatencyMarkerInfoNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (GetLatencyMarkerInfoNV)
#endif
deriving instance Show GetLatencyMarkerInfoNV

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

instance FromCStruct GetLatencyMarkerInfoNV where
  peekCStruct :: Ptr GetLatencyMarkerInfoNV -> IO GetLatencyMarkerInfoNV
peekCStruct Ptr GetLatencyMarkerInfoNV
p = do
    Ptr LatencyTimingsFrameReportNV
pTimings <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr LatencyTimingsFrameReportNV) ((Ptr GetLatencyMarkerInfoNV
p Ptr GetLatencyMarkerInfoNV
-> Int -> Ptr (Ptr LatencyTimingsFrameReportNV)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (Ptr LatencyTimingsFrameReportNV)))
    GetLatencyMarkerInfoNV -> IO GetLatencyMarkerInfoNV
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GetLatencyMarkerInfoNV -> IO GetLatencyMarkerInfoNV)
-> GetLatencyMarkerInfoNV -> IO GetLatencyMarkerInfoNV
forall a b. (a -> b) -> a -> b
$ Ptr LatencyTimingsFrameReportNV -> GetLatencyMarkerInfoNV
GetLatencyMarkerInfoNV
             Ptr LatencyTimingsFrameReportNV
pTimings

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

instance Zero GetLatencyMarkerInfoNV where
  zero :: GetLatencyMarkerInfoNV
zero = Ptr LatencyTimingsFrameReportNV -> GetLatencyMarkerInfoNV
GetLatencyMarkerInfoNV
           Ptr LatencyTimingsFrameReportNV
forall a. Zero a => a
zero


-- | VkLatencyTimingsFrameReportNV - Structure containing latency data
--
-- = Members
--
-- The members of the 'LatencyTimingsFrameReportNV' structure describe the
-- following:
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_low_latency2 VK_NV_low_latency2>,
-- 'GetLatencyMarkerInfoNV',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data LatencyTimingsFrameReportNV = LatencyTimingsFrameReportNV
  { -- No documentation found for Nested "VkLatencyTimingsFrameReportNV" "presentID"
    LatencyTimingsFrameReportNV -> Word64
presentID :: Word64
  , -- No documentation found for Nested "VkLatencyTimingsFrameReportNV" "inputSampleTimeUs"
    LatencyTimingsFrameReportNV -> Word64
inputSampleTimeUs :: Word64
  , -- | @simStartTimeUs@ is the timestamp written when 'setLatencyMarkerNV' is
    -- called with the 'LatencyMarkerNV' enum
    -- 'LATENCY_MARKER_SIMULATION_START_NV'.
    LatencyTimingsFrameReportNV -> Word64
simStartTimeUs :: Word64
  , -- | @simEndTimeUs@ is the timestamp written when 'setLatencyMarkerNV' is
    -- called with the 'LatencyMarkerNV' enum
    -- 'LATENCY_MARKER_SIMULATION_END_NV'
    LatencyTimingsFrameReportNV -> Word64
simEndTimeUs :: Word64
  , -- No documentation found for Nested "VkLatencyTimingsFrameReportNV" "renderSubmitStartTimeUs"
    LatencyTimingsFrameReportNV -> Word64
renderSubmitStartTimeUs :: Word64
  , -- No documentation found for Nested "VkLatencyTimingsFrameReportNV" "renderSubmitEndTimeUs"
    LatencyTimingsFrameReportNV -> Word64
renderSubmitEndTimeUs :: Word64
  , -- | @presentStartTimeUs@ is the timestamp written when 'setLatencyMarkerNV'
    -- is called with the 'LatencyMarkerNV' enum
    -- 'LATENCY_MARKER_PRESENT_START_NV'.
    LatencyTimingsFrameReportNV -> Word64
presentStartTimeUs :: Word64
  , -- | @presentEndTimeUs@ is the timestamp written when 'setLatencyMarkerNV' is
    -- called with the 'LatencyMarkerNV' enum 'LATENCY_MARKER_PRESENT_END_NV'.
    LatencyTimingsFrameReportNV -> Word64
presentEndTimeUs :: Word64
  , -- | @driverStartTimeUs@ is the timestamp written when the first
    -- 'Vulkan.Core10.Queue.queueSubmit' for the frame is called.
    LatencyTimingsFrameReportNV -> Word64
driverStartTimeUs :: Word64
  , -- | @driverEndTimeUs@ is the timestamp written when the final
    -- 'Vulkan.Core10.Queue.queueSubmit' hands off from the Vulkan Driver.
    LatencyTimingsFrameReportNV -> Word64
driverEndTimeUs :: Word64
  , -- | @osRenderQueueStartTimeUs@ is the timestamp written when the final
    -- 'Vulkan.Core10.Queue.queueSubmit' hands off from the Vulkan Driver.
    LatencyTimingsFrameReportNV -> Word64
osRenderQueueStartTimeUs :: Word64
  , -- | @osRenderQueueEndTimeUs@ is the timestamp written when the first
    -- submission reaches the GPU.
    LatencyTimingsFrameReportNV -> Word64
osRenderQueueEndTimeUs :: Word64
  , -- | @gpuRenderStartTimeUs@ is the timestamp written when the first
    -- submission reaches the GPU.
    LatencyTimingsFrameReportNV -> Word64
gpuRenderStartTimeUs :: Word64
  , -- | @gpuRenderEndTimeUs@ is the timestamp written when the final submission
    -- finishes on the GPU for the frame.
    LatencyTimingsFrameReportNV -> Word64
gpuRenderEndTimeUs :: Word64
  }
  deriving (Typeable, LatencyTimingsFrameReportNV -> LatencyTimingsFrameReportNV -> Bool
(LatencyTimingsFrameReportNV
 -> LatencyTimingsFrameReportNV -> Bool)
-> (LatencyTimingsFrameReportNV
    -> LatencyTimingsFrameReportNV -> Bool)
-> Eq LatencyTimingsFrameReportNV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LatencyTimingsFrameReportNV -> LatencyTimingsFrameReportNV -> Bool
== :: LatencyTimingsFrameReportNV -> LatencyTimingsFrameReportNV -> Bool
$c/= :: LatencyTimingsFrameReportNV -> LatencyTimingsFrameReportNV -> Bool
/= :: LatencyTimingsFrameReportNV -> LatencyTimingsFrameReportNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (LatencyTimingsFrameReportNV)
#endif
deriving instance Show LatencyTimingsFrameReportNV

instance ToCStruct LatencyTimingsFrameReportNV where
  withCStruct :: forall b.
LatencyTimingsFrameReportNV
-> (Ptr LatencyTimingsFrameReportNV -> IO b) -> IO b
withCStruct LatencyTimingsFrameReportNV
x Ptr LatencyTimingsFrameReportNV -> IO b
f = Int -> (Ptr LatencyTimingsFrameReportNV -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
128 ((Ptr LatencyTimingsFrameReportNV -> IO b) -> IO b)
-> (Ptr LatencyTimingsFrameReportNV -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr LatencyTimingsFrameReportNV
p -> Ptr LatencyTimingsFrameReportNV
-> LatencyTimingsFrameReportNV -> IO b -> IO b
forall b.
Ptr LatencyTimingsFrameReportNV
-> LatencyTimingsFrameReportNV -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr LatencyTimingsFrameReportNV
p LatencyTimingsFrameReportNV
x (Ptr LatencyTimingsFrameReportNV -> IO b
f Ptr LatencyTimingsFrameReportNV
p)
  pokeCStruct :: forall b.
Ptr LatencyTimingsFrameReportNV
-> LatencyTimingsFrameReportNV -> IO b -> IO b
pokeCStruct Ptr LatencyTimingsFrameReportNV
p LatencyTimingsFrameReportNV{Word64
$sel:presentID:LatencyTimingsFrameReportNV :: LatencyTimingsFrameReportNV -> Word64
$sel:inputSampleTimeUs:LatencyTimingsFrameReportNV :: LatencyTimingsFrameReportNV -> Word64
$sel:simStartTimeUs:LatencyTimingsFrameReportNV :: LatencyTimingsFrameReportNV -> Word64
$sel:simEndTimeUs:LatencyTimingsFrameReportNV :: LatencyTimingsFrameReportNV -> Word64
$sel:renderSubmitStartTimeUs:LatencyTimingsFrameReportNV :: LatencyTimingsFrameReportNV -> Word64
$sel:renderSubmitEndTimeUs:LatencyTimingsFrameReportNV :: LatencyTimingsFrameReportNV -> Word64
$sel:presentStartTimeUs:LatencyTimingsFrameReportNV :: LatencyTimingsFrameReportNV -> Word64
$sel:presentEndTimeUs:LatencyTimingsFrameReportNV :: LatencyTimingsFrameReportNV -> Word64
$sel:driverStartTimeUs:LatencyTimingsFrameReportNV :: LatencyTimingsFrameReportNV -> Word64
$sel:driverEndTimeUs:LatencyTimingsFrameReportNV :: LatencyTimingsFrameReportNV -> Word64
$sel:osRenderQueueStartTimeUs:LatencyTimingsFrameReportNV :: LatencyTimingsFrameReportNV -> Word64
$sel:osRenderQueueEndTimeUs:LatencyTimingsFrameReportNV :: LatencyTimingsFrameReportNV -> Word64
$sel:gpuRenderStartTimeUs:LatencyTimingsFrameReportNV :: LatencyTimingsFrameReportNV -> Word64
$sel:gpuRenderEndTimeUs:LatencyTimingsFrameReportNV :: LatencyTimingsFrameReportNV -> Word64
presentID :: Word64
inputSampleTimeUs :: Word64
simStartTimeUs :: Word64
simEndTimeUs :: Word64
renderSubmitStartTimeUs :: Word64
renderSubmitEndTimeUs :: Word64
presentStartTimeUs :: Word64
presentEndTimeUs :: Word64
driverStartTimeUs :: Word64
driverEndTimeUs :: Word64
osRenderQueueStartTimeUs :: Word64
osRenderQueueEndTimeUs :: Word64
gpuRenderStartTimeUs :: Word64
gpuRenderEndTimeUs :: Word64
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_LATENCY_TIMINGS_FRAME_REPORT_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word64)) (Word64
presentID)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word64)) (Word64
inputSampleTimeUs)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word64)) (Word64
simStartTimeUs)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word64)) (Word64
simEndTimeUs)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Word64)) (Word64
renderSubmitStartTimeUs)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr Word64)) (Word64
renderSubmitEndTimeUs)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr Word64)) (Word64
presentStartTimeUs)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr Word64)) (Word64
presentEndTimeUs)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80 :: Ptr Word64)) (Word64
driverStartTimeUs)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
88 :: Ptr Word64)) (Word64
driverEndTimeUs)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
96 :: Ptr Word64)) (Word64
osRenderQueueStartTimeUs)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
104 :: Ptr Word64)) (Word64
osRenderQueueEndTimeUs)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
112 :: Ptr Word64)) (Word64
gpuRenderStartTimeUs)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
120 :: Ptr Word64)) (Word64
gpuRenderEndTimeUs)
    IO b
f
  cStructSize :: Int
cStructSize = Int
128
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr LatencyTimingsFrameReportNV -> IO b -> IO b
pokeZeroCStruct Ptr LatencyTimingsFrameReportNV
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_LATENCY_TIMINGS_FRAME_REPORT_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word64)) (Word64
forall a. Zero a => a
zero)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word64)) (Word64
forall a. Zero a => a
zero)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word64)) (Word64
forall a. Zero a => a
zero)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word64)) (Word64
forall a. Zero a => a
zero)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Word64)) (Word64
forall a. Zero a => a
zero)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr Word64)) (Word64
forall a. Zero a => a
zero)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr Word64)) (Word64
forall a. Zero a => a
zero)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr Word64)) (Word64
forall a. Zero a => a
zero)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80 :: Ptr Word64)) (Word64
forall a. Zero a => a
zero)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
88 :: Ptr Word64)) (Word64
forall a. Zero a => a
zero)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
96 :: Ptr Word64)) (Word64
forall a. Zero a => a
zero)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
104 :: Ptr Word64)) (Word64
forall a. Zero a => a
zero)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
112 :: Ptr Word64)) (Word64
forall a. Zero a => a
zero)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
120 :: Ptr Word64)) (Word64
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct LatencyTimingsFrameReportNV where
  peekCStruct :: Ptr LatencyTimingsFrameReportNV -> IO LatencyTimingsFrameReportNV
peekCStruct Ptr LatencyTimingsFrameReportNV
p = do
    Word64
presentID <- forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word64))
    Word64
inputSampleTimeUs <- forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word64))
    Word64
simStartTimeUs <- forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word64))
    Word64
simEndTimeUs <- forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word64))
    Word64
renderSubmitStartTimeUs <- forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Word64))
    Word64
renderSubmitEndTimeUs <- forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr Word64))
    Word64
presentStartTimeUs <- forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr Word64))
    Word64
presentEndTimeUs <- forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr Word64))
    Word64
driverStartTimeUs <- forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80 :: Ptr Word64))
    Word64
driverEndTimeUs <- forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
88 :: Ptr Word64))
    Word64
osRenderQueueStartTimeUs <- forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
96 :: Ptr Word64))
    Word64
osRenderQueueEndTimeUs <- forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
104 :: Ptr Word64))
    Word64
gpuRenderStartTimeUs <- forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
112 :: Ptr Word64))
    Word64
gpuRenderEndTimeUs <- forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr LatencyTimingsFrameReportNV
p Ptr LatencyTimingsFrameReportNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
120 :: Ptr Word64))
    LatencyTimingsFrameReportNV -> IO LatencyTimingsFrameReportNV
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LatencyTimingsFrameReportNV -> IO LatencyTimingsFrameReportNV)
-> LatencyTimingsFrameReportNV -> IO LatencyTimingsFrameReportNV
forall a b. (a -> b) -> a -> b
$ Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> LatencyTimingsFrameReportNV
LatencyTimingsFrameReportNV
             Word64
presentID
             Word64
inputSampleTimeUs
             Word64
simStartTimeUs
             Word64
simEndTimeUs
             Word64
renderSubmitStartTimeUs
             Word64
renderSubmitEndTimeUs
             Word64
presentStartTimeUs
             Word64
presentEndTimeUs
             Word64
driverStartTimeUs
             Word64
driverEndTimeUs
             Word64
osRenderQueueStartTimeUs
             Word64
osRenderQueueEndTimeUs
             Word64
gpuRenderStartTimeUs
             Word64
gpuRenderEndTimeUs

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

instance Zero LatencyTimingsFrameReportNV where
  zero :: LatencyTimingsFrameReportNV
zero = Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> LatencyTimingsFrameReportNV
LatencyTimingsFrameReportNV
           Word64
forall a. Zero a => a
zero
           Word64
forall a. Zero a => a
zero
           Word64
forall a. Zero a => a
zero
           Word64
forall a. Zero a => a
zero
           Word64
forall a. Zero a => a
zero
           Word64
forall a. Zero a => a
zero
           Word64
forall a. Zero a => a
zero
           Word64
forall a. Zero a => a
zero
           Word64
forall a. Zero a => a
zero
           Word64
forall a. Zero a => a
zero
           Word64
forall a. Zero a => a
zero
           Word64
forall a. Zero a => a
zero
           Word64
forall a. Zero a => a
zero
           Word64
forall a. Zero a => a
zero


-- | VkOutOfBandQueueTypeInfoNV - Structure used to describe the queue that
-- is being marked as Out of Band
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_low_latency2 VK_NV_low_latency2>,
-- 'OutOfBandQueueTypeNV',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'queueNotifyOutOfBandNV'
data OutOfBandQueueTypeInfoNV = OutOfBandQueueTypeInfoNV
  { -- | @queueType@ describes the usage of the queue to be marked as out of
    -- band.
    --
    -- #VUID-VkOutOfBandQueueTypeInfoNV-queueType-parameter# @queueType@ /must/
    -- be a valid 'OutOfBandQueueTypeNV' value
    OutOfBandQueueTypeInfoNV -> OutOfBandQueueTypeNV
queueType :: OutOfBandQueueTypeNV }
  deriving (Typeable, OutOfBandQueueTypeInfoNV -> OutOfBandQueueTypeInfoNV -> Bool
(OutOfBandQueueTypeInfoNV -> OutOfBandQueueTypeInfoNV -> Bool)
-> (OutOfBandQueueTypeInfoNV -> OutOfBandQueueTypeInfoNV -> Bool)
-> Eq OutOfBandQueueTypeInfoNV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OutOfBandQueueTypeInfoNV -> OutOfBandQueueTypeInfoNV -> Bool
== :: OutOfBandQueueTypeInfoNV -> OutOfBandQueueTypeInfoNV -> Bool
$c/= :: OutOfBandQueueTypeInfoNV -> OutOfBandQueueTypeInfoNV -> Bool
/= :: OutOfBandQueueTypeInfoNV -> OutOfBandQueueTypeInfoNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (OutOfBandQueueTypeInfoNV)
#endif
deriving instance Show OutOfBandQueueTypeInfoNV

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

instance FromCStruct OutOfBandQueueTypeInfoNV where
  peekCStruct :: Ptr OutOfBandQueueTypeInfoNV -> IO OutOfBandQueueTypeInfoNV
peekCStruct Ptr OutOfBandQueueTypeInfoNV
p = do
    OutOfBandQueueTypeNV
queueType <- forall a. Storable a => Ptr a -> IO a
peek @OutOfBandQueueTypeNV ((Ptr OutOfBandQueueTypeInfoNV
p Ptr OutOfBandQueueTypeInfoNV -> Int -> Ptr OutOfBandQueueTypeNV
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr OutOfBandQueueTypeNV))
    OutOfBandQueueTypeInfoNV -> IO OutOfBandQueueTypeInfoNV
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OutOfBandQueueTypeInfoNV -> IO OutOfBandQueueTypeInfoNV)
-> OutOfBandQueueTypeInfoNV -> IO OutOfBandQueueTypeInfoNV
forall a b. (a -> b) -> a -> b
$ OutOfBandQueueTypeNV -> OutOfBandQueueTypeInfoNV
OutOfBandQueueTypeInfoNV
             OutOfBandQueueTypeNV
queueType

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

instance Zero OutOfBandQueueTypeInfoNV where
  zero :: OutOfBandQueueTypeInfoNV
zero = OutOfBandQueueTypeNV -> OutOfBandQueueTypeInfoNV
OutOfBandQueueTypeInfoNV
           OutOfBandQueueTypeNV
forall a. Zero a => a
zero


-- | VkLatencySubmissionPresentIdNV - Structure used to associate a
-- queueSubmit with a presentId
--
-- = Description
--
-- For any submission to be tracked with low latency mode pacing, it needs
-- to be associated with other submissions in a given present. Applications
-- :must include the VkLatencySubmissionPresentIdNV in the pNext chain of
-- 'Vulkan.Core10.Queue.queueSubmit' to associate that submission with the
-- @presentId@ present for low latency mode.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_low_latency2 VK_NV_low_latency2>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data LatencySubmissionPresentIdNV = LatencySubmissionPresentIdNV
  { -- No documentation found for Nested "VkLatencySubmissionPresentIdNV" "presentID"
    LatencySubmissionPresentIdNV -> Word64
presentID :: Word64 }
  deriving (Typeable, LatencySubmissionPresentIdNV
-> LatencySubmissionPresentIdNV -> Bool
(LatencySubmissionPresentIdNV
 -> LatencySubmissionPresentIdNV -> Bool)
-> (LatencySubmissionPresentIdNV
    -> LatencySubmissionPresentIdNV -> Bool)
-> Eq LatencySubmissionPresentIdNV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LatencySubmissionPresentIdNV
-> LatencySubmissionPresentIdNV -> Bool
== :: LatencySubmissionPresentIdNV
-> LatencySubmissionPresentIdNV -> Bool
$c/= :: LatencySubmissionPresentIdNV
-> LatencySubmissionPresentIdNV -> Bool
/= :: LatencySubmissionPresentIdNV
-> LatencySubmissionPresentIdNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (LatencySubmissionPresentIdNV)
#endif
deriving instance Show LatencySubmissionPresentIdNV

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

instance FromCStruct LatencySubmissionPresentIdNV where
  peekCStruct :: Ptr LatencySubmissionPresentIdNV -> IO LatencySubmissionPresentIdNV
peekCStruct Ptr LatencySubmissionPresentIdNV
p = do
    Word64
presentID <- forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr LatencySubmissionPresentIdNV
p Ptr LatencySubmissionPresentIdNV -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word64))
    LatencySubmissionPresentIdNV -> IO LatencySubmissionPresentIdNV
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LatencySubmissionPresentIdNV -> IO LatencySubmissionPresentIdNV)
-> LatencySubmissionPresentIdNV -> IO LatencySubmissionPresentIdNV
forall a b. (a -> b) -> a -> b
$ Word64 -> LatencySubmissionPresentIdNV
LatencySubmissionPresentIdNV
             Word64
presentID

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

instance Zero LatencySubmissionPresentIdNV where
  zero :: LatencySubmissionPresentIdNV
zero = Word64 -> LatencySubmissionPresentIdNV
LatencySubmissionPresentIdNV
           Word64
forall a. Zero a => a
zero


-- | VkSwapchainLatencyCreateInfoNV - Specify that a swapchain will use low
-- latency mode
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_low_latency2 VK_NV_low_latency2>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data SwapchainLatencyCreateInfoNV = SwapchainLatencyCreateInfoNV
  { -- No documentation found for Nested "VkSwapchainLatencyCreateInfoNV" "latencyModeEnable"
    SwapchainLatencyCreateInfoNV -> Bool
latencyModeEnable :: Bool }
  deriving (Typeable, SwapchainLatencyCreateInfoNV
-> SwapchainLatencyCreateInfoNV -> Bool
(SwapchainLatencyCreateInfoNV
 -> SwapchainLatencyCreateInfoNV -> Bool)
-> (SwapchainLatencyCreateInfoNV
    -> SwapchainLatencyCreateInfoNV -> Bool)
-> Eq SwapchainLatencyCreateInfoNV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SwapchainLatencyCreateInfoNV
-> SwapchainLatencyCreateInfoNV -> Bool
== :: SwapchainLatencyCreateInfoNV
-> SwapchainLatencyCreateInfoNV -> Bool
$c/= :: SwapchainLatencyCreateInfoNV
-> SwapchainLatencyCreateInfoNV -> Bool
/= :: SwapchainLatencyCreateInfoNV
-> SwapchainLatencyCreateInfoNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SwapchainLatencyCreateInfoNV)
#endif
deriving instance Show SwapchainLatencyCreateInfoNV

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

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

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


-- | VkLatencySurfaceCapabilitiesNV - Structure describing surface optimized
-- presentation modes for use with low latency mode
--
-- = Description
--
-- If @pPresentModes@ is @NULL@, then the number of present modes that are
-- optimized for use with low latency mode returned in @presentModeCount@.
-- Otherwise, @presentModeCount@ must be set by the user to the number of
-- elements in the @pPresentModes@ array, and on return the variable is
-- overwritten with the number of values actually written to
-- @pPresentModes@. If the value of @presentModeCount@ is less than the
-- number of optimized present modes, at most @presentModeCount@ values
-- will be written to @pPresentModes@.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkLatencySurfaceCapabilitiesNV-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_LATENCY_SURFACE_CAPABILITIES_NV'
--
-- -   #VUID-VkLatencySurfaceCapabilitiesNV-pPresentModes-parameter# If
--     @presentModeCount@ is not @0@, and @pPresentModes@ is not @NULL@,
--     @pPresentModes@ /must/ be a valid pointer to an array of
--     @presentModeCount@ 'Vulkan.Extensions.VK_KHR_surface.PresentModeKHR'
--     values
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_low_latency2 VK_NV_low_latency2>,
-- 'Vulkan.Extensions.VK_KHR_surface.PresentModeKHR',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data LatencySurfaceCapabilitiesNV = LatencySurfaceCapabilitiesNV
  { -- | @presentModeCount@ is the number of presentation modes provided.
    LatencySurfaceCapabilitiesNV -> "timingCount" ::: Word32
presentModeCount :: Word32
  , -- | @pPresentModes@ is list of presentation modes optimized for use with low
    -- latency mode with @presentModeCount@ entries.
    LatencySurfaceCapabilitiesNV -> Ptr PresentModeKHR
presentModes :: Ptr PresentModeKHR
  }
  deriving (Typeable, LatencySurfaceCapabilitiesNV
-> LatencySurfaceCapabilitiesNV -> Bool
(LatencySurfaceCapabilitiesNV
 -> LatencySurfaceCapabilitiesNV -> Bool)
-> (LatencySurfaceCapabilitiesNV
    -> LatencySurfaceCapabilitiesNV -> Bool)
-> Eq LatencySurfaceCapabilitiesNV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LatencySurfaceCapabilitiesNV
-> LatencySurfaceCapabilitiesNV -> Bool
== :: LatencySurfaceCapabilitiesNV
-> LatencySurfaceCapabilitiesNV -> Bool
$c/= :: LatencySurfaceCapabilitiesNV
-> LatencySurfaceCapabilitiesNV -> Bool
/= :: LatencySurfaceCapabilitiesNV
-> LatencySurfaceCapabilitiesNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (LatencySurfaceCapabilitiesNV)
#endif
deriving instance Show LatencySurfaceCapabilitiesNV

instance ToCStruct LatencySurfaceCapabilitiesNV where
  withCStruct :: forall b.
LatencySurfaceCapabilitiesNV
-> (Ptr LatencySurfaceCapabilitiesNV -> IO b) -> IO b
withCStruct LatencySurfaceCapabilitiesNV
x Ptr LatencySurfaceCapabilitiesNV -> IO b
f = Int -> (Ptr LatencySurfaceCapabilitiesNV -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((Ptr LatencySurfaceCapabilitiesNV -> IO b) -> IO b)
-> (Ptr LatencySurfaceCapabilitiesNV -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr LatencySurfaceCapabilitiesNV
p -> Ptr LatencySurfaceCapabilitiesNV
-> LatencySurfaceCapabilitiesNV -> IO b -> IO b
forall b.
Ptr LatencySurfaceCapabilitiesNV
-> LatencySurfaceCapabilitiesNV -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr LatencySurfaceCapabilitiesNV
p LatencySurfaceCapabilitiesNV
x (Ptr LatencySurfaceCapabilitiesNV -> IO b
f Ptr LatencySurfaceCapabilitiesNV
p)
  pokeCStruct :: forall b.
Ptr LatencySurfaceCapabilitiesNV
-> LatencySurfaceCapabilitiesNV -> IO b -> IO b
pokeCStruct Ptr LatencySurfaceCapabilitiesNV
p LatencySurfaceCapabilitiesNV{"timingCount" ::: Word32
Ptr PresentModeKHR
$sel:presentModeCount:LatencySurfaceCapabilitiesNV :: LatencySurfaceCapabilitiesNV -> "timingCount" ::: Word32
$sel:presentModes:LatencySurfaceCapabilitiesNV :: LatencySurfaceCapabilitiesNV -> Ptr PresentModeKHR
presentModeCount :: "timingCount" ::: Word32
presentModes :: Ptr PresentModeKHR
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencySurfaceCapabilitiesNV
p Ptr LatencySurfaceCapabilitiesNV -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_LATENCY_SURFACE_CAPABILITIES_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencySurfaceCapabilitiesNV
p Ptr LatencySurfaceCapabilitiesNV -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ("timingCount" ::: Word32)
-> ("timingCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencySurfaceCapabilitiesNV
p Ptr LatencySurfaceCapabilitiesNV
-> Int -> Ptr ("timingCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) ("timingCount" ::: Word32
presentModeCount)
    Ptr (Ptr PresentModeKHR) -> Ptr PresentModeKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencySurfaceCapabilitiesNV
p Ptr LatencySurfaceCapabilitiesNV -> Int -> Ptr (Ptr PresentModeKHR)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr PresentModeKHR))) (Ptr PresentModeKHR
presentModes)
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr LatencySurfaceCapabilitiesNV -> IO b -> IO b
pokeZeroCStruct Ptr LatencySurfaceCapabilitiesNV
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencySurfaceCapabilitiesNV
p Ptr LatencySurfaceCapabilitiesNV -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_LATENCY_SURFACE_CAPABILITIES_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr LatencySurfaceCapabilitiesNV
p Ptr LatencySurfaceCapabilitiesNV -> 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 LatencySurfaceCapabilitiesNV where
  peekCStruct :: Ptr LatencySurfaceCapabilitiesNV -> IO LatencySurfaceCapabilitiesNV
peekCStruct Ptr LatencySurfaceCapabilitiesNV
p = do
    "timingCount" ::: Word32
presentModeCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr LatencySurfaceCapabilitiesNV
p Ptr LatencySurfaceCapabilitiesNV
-> Int -> Ptr ("timingCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    Ptr PresentModeKHR
pPresentModes <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr PresentModeKHR) ((Ptr LatencySurfaceCapabilitiesNV
p Ptr LatencySurfaceCapabilitiesNV -> Int -> Ptr (Ptr PresentModeKHR)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr PresentModeKHR)))
    LatencySurfaceCapabilitiesNV -> IO LatencySurfaceCapabilitiesNV
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LatencySurfaceCapabilitiesNV -> IO LatencySurfaceCapabilitiesNV)
-> LatencySurfaceCapabilitiesNV -> IO LatencySurfaceCapabilitiesNV
forall a b. (a -> b) -> a -> b
$ ("timingCount" ::: Word32)
-> Ptr PresentModeKHR -> LatencySurfaceCapabilitiesNV
LatencySurfaceCapabilitiesNV
             "timingCount" ::: Word32
presentModeCount Ptr PresentModeKHR
pPresentModes

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

instance Zero LatencySurfaceCapabilitiesNV where
  zero :: LatencySurfaceCapabilitiesNV
zero = ("timingCount" ::: Word32)
-> Ptr PresentModeKHR -> LatencySurfaceCapabilitiesNV
LatencySurfaceCapabilitiesNV
           "timingCount" ::: Word32
forall a. Zero a => a
zero
           Ptr PresentModeKHR
forall a. Zero a => a
zero


-- | VkLatencyMarkerNV - Structure used to mark different points in latency
--
-- = Description
--
-- The members of the 'LatencyMarkerNV' are used as arguments for
-- 'setLatencyMarkerNV' in the use cases described below:
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_low_latency2 VK_NV_low_latency2>,
-- 'SetLatencyMarkerInfoNV'
newtype LatencyMarkerNV = LatencyMarkerNV Int32
  deriving newtype (LatencyMarkerNV -> LatencyMarkerNV -> Bool
(LatencyMarkerNV -> LatencyMarkerNV -> Bool)
-> (LatencyMarkerNV -> LatencyMarkerNV -> Bool)
-> Eq LatencyMarkerNV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LatencyMarkerNV -> LatencyMarkerNV -> Bool
== :: LatencyMarkerNV -> LatencyMarkerNV -> Bool
$c/= :: LatencyMarkerNV -> LatencyMarkerNV -> Bool
/= :: LatencyMarkerNV -> LatencyMarkerNV -> Bool
Eq, Eq LatencyMarkerNV
Eq LatencyMarkerNV =>
(LatencyMarkerNV -> LatencyMarkerNV -> Ordering)
-> (LatencyMarkerNV -> LatencyMarkerNV -> Bool)
-> (LatencyMarkerNV -> LatencyMarkerNV -> Bool)
-> (LatencyMarkerNV -> LatencyMarkerNV -> Bool)
-> (LatencyMarkerNV -> LatencyMarkerNV -> Bool)
-> (LatencyMarkerNV -> LatencyMarkerNV -> LatencyMarkerNV)
-> (LatencyMarkerNV -> LatencyMarkerNV -> LatencyMarkerNV)
-> Ord LatencyMarkerNV
LatencyMarkerNV -> LatencyMarkerNV -> Bool
LatencyMarkerNV -> LatencyMarkerNV -> Ordering
LatencyMarkerNV -> LatencyMarkerNV -> LatencyMarkerNV
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
$ccompare :: LatencyMarkerNV -> LatencyMarkerNV -> Ordering
compare :: LatencyMarkerNV -> LatencyMarkerNV -> Ordering
$c< :: LatencyMarkerNV -> LatencyMarkerNV -> Bool
< :: LatencyMarkerNV -> LatencyMarkerNV -> Bool
$c<= :: LatencyMarkerNV -> LatencyMarkerNV -> Bool
<= :: LatencyMarkerNV -> LatencyMarkerNV -> Bool
$c> :: LatencyMarkerNV -> LatencyMarkerNV -> Bool
> :: LatencyMarkerNV -> LatencyMarkerNV -> Bool
$c>= :: LatencyMarkerNV -> LatencyMarkerNV -> Bool
>= :: LatencyMarkerNV -> LatencyMarkerNV -> Bool
$cmax :: LatencyMarkerNV -> LatencyMarkerNV -> LatencyMarkerNV
max :: LatencyMarkerNV -> LatencyMarkerNV -> LatencyMarkerNV
$cmin :: LatencyMarkerNV -> LatencyMarkerNV -> LatencyMarkerNV
min :: LatencyMarkerNV -> LatencyMarkerNV -> LatencyMarkerNV
Ord, Ptr LatencyMarkerNV -> IO LatencyMarkerNV
Ptr LatencyMarkerNV -> Int -> IO LatencyMarkerNV
Ptr LatencyMarkerNV -> Int -> LatencyMarkerNV -> IO ()
Ptr LatencyMarkerNV -> LatencyMarkerNV -> IO ()
LatencyMarkerNV -> Int
(LatencyMarkerNV -> Int)
-> (LatencyMarkerNV -> Int)
-> (Ptr LatencyMarkerNV -> Int -> IO LatencyMarkerNV)
-> (Ptr LatencyMarkerNV -> Int -> LatencyMarkerNV -> IO ())
-> (forall b. Ptr b -> Int -> IO LatencyMarkerNV)
-> (forall b. Ptr b -> Int -> LatencyMarkerNV -> IO ())
-> (Ptr LatencyMarkerNV -> IO LatencyMarkerNV)
-> (Ptr LatencyMarkerNV -> LatencyMarkerNV -> IO ())
-> Storable LatencyMarkerNV
forall b. Ptr b -> Int -> IO LatencyMarkerNV
forall b. Ptr b -> Int -> LatencyMarkerNV -> 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
$csizeOf :: LatencyMarkerNV -> Int
sizeOf :: LatencyMarkerNV -> Int
$calignment :: LatencyMarkerNV -> Int
alignment :: LatencyMarkerNV -> Int
$cpeekElemOff :: Ptr LatencyMarkerNV -> Int -> IO LatencyMarkerNV
peekElemOff :: Ptr LatencyMarkerNV -> Int -> IO LatencyMarkerNV
$cpokeElemOff :: Ptr LatencyMarkerNV -> Int -> LatencyMarkerNV -> IO ()
pokeElemOff :: Ptr LatencyMarkerNV -> Int -> LatencyMarkerNV -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO LatencyMarkerNV
peekByteOff :: forall b. Ptr b -> Int -> IO LatencyMarkerNV
$cpokeByteOff :: forall b. Ptr b -> Int -> LatencyMarkerNV -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> LatencyMarkerNV -> IO ()
$cpeek :: Ptr LatencyMarkerNV -> IO LatencyMarkerNV
peek :: Ptr LatencyMarkerNV -> IO LatencyMarkerNV
$cpoke :: Ptr LatencyMarkerNV -> LatencyMarkerNV -> IO ()
poke :: Ptr LatencyMarkerNV -> LatencyMarkerNV -> IO ()
Storable, LatencyMarkerNV
LatencyMarkerNV -> Zero LatencyMarkerNV
forall a. a -> Zero a
$czero :: LatencyMarkerNV
zero :: LatencyMarkerNV
Zero)

-- | 'LATENCY_MARKER_SIMULATION_START_NV' /should/ be called at the start of
-- the simulation execution each frame, but after the call to
-- 'latencySleepNV'.
pattern $mLATENCY_MARKER_SIMULATION_START_NV :: forall {r}. LatencyMarkerNV -> ((# #) -> r) -> ((# #) -> r) -> r
$bLATENCY_MARKER_SIMULATION_START_NV :: LatencyMarkerNV
LATENCY_MARKER_SIMULATION_START_NV = LatencyMarkerNV 0

-- | 'LATENCY_MARKER_SIMULATION_END_NV' /should/ be called at the end of the
-- simulation execution each frame.
pattern $mLATENCY_MARKER_SIMULATION_END_NV :: forall {r}. LatencyMarkerNV -> ((# #) -> r) -> ((# #) -> r) -> r
$bLATENCY_MARKER_SIMULATION_END_NV :: LatencyMarkerNV
LATENCY_MARKER_SIMULATION_END_NV = LatencyMarkerNV 1

-- | 'LATENCY_MARKER_RENDERSUBMIT_START_NV' /should/ be called at the
-- beginning of the render submission execution each frame. This /should/
-- be wherever Vulkan API calls are made and /must/ not span into
-- asynchronous rendering.
pattern $mLATENCY_MARKER_RENDERSUBMIT_START_NV :: forall {r}. LatencyMarkerNV -> ((# #) -> r) -> ((# #) -> r) -> r
$bLATENCY_MARKER_RENDERSUBMIT_START_NV :: LatencyMarkerNV
LATENCY_MARKER_RENDERSUBMIT_START_NV = LatencyMarkerNV 2

-- | 'LATENCY_MARKER_RENDERSUBMIT_END_NV' /should/ be called at the end of
-- the render submission execution each frame.
pattern $mLATENCY_MARKER_RENDERSUBMIT_END_NV :: forall {r}. LatencyMarkerNV -> ((# #) -> r) -> ((# #) -> r) -> r
$bLATENCY_MARKER_RENDERSUBMIT_END_NV :: LatencyMarkerNV
LATENCY_MARKER_RENDERSUBMIT_END_NV = LatencyMarkerNV 3

-- | 'LATENCY_MARKER_PRESENT_START_NV' /should/ be called just before
-- 'Vulkan.Extensions.VK_KHR_swapchain.queuePresentKHR'.
pattern $mLATENCY_MARKER_PRESENT_START_NV :: forall {r}. LatencyMarkerNV -> ((# #) -> r) -> ((# #) -> r) -> r
$bLATENCY_MARKER_PRESENT_START_NV :: LatencyMarkerNV
LATENCY_MARKER_PRESENT_START_NV = LatencyMarkerNV 4

-- | 'LATENCY_MARKER_PRESENT_END_NV' /should/ be called when
-- 'Vulkan.Extensions.VK_KHR_swapchain.queuePresentKHR' returns.
pattern $mLATENCY_MARKER_PRESENT_END_NV :: forall {r}. LatencyMarkerNV -> ((# #) -> r) -> ((# #) -> r) -> r
$bLATENCY_MARKER_PRESENT_END_NV :: LatencyMarkerNV
LATENCY_MARKER_PRESENT_END_NV = LatencyMarkerNV 5

-- | 'LATENCY_MARKER_INPUT_SAMPLE_NV' /should/ be called just before the
-- application gathers input data.
pattern $mLATENCY_MARKER_INPUT_SAMPLE_NV :: forall {r}. LatencyMarkerNV -> ((# #) -> r) -> ((# #) -> r) -> r
$bLATENCY_MARKER_INPUT_SAMPLE_NV :: LatencyMarkerNV
LATENCY_MARKER_INPUT_SAMPLE_NV = LatencyMarkerNV 6

-- | 'LATENCY_MARKER_TRIGGER_FLASH_NV' /should/ be called anywhere between
-- 'LATENCY_MARKER_SIMULATION_START_NV' and
-- 'LATENCY_MARKER_SIMULATION_END_NV' whenever a left mouse click occurs.
pattern $mLATENCY_MARKER_TRIGGER_FLASH_NV :: forall {r}. LatencyMarkerNV -> ((# #) -> r) -> ((# #) -> r) -> r
$bLATENCY_MARKER_TRIGGER_FLASH_NV :: LatencyMarkerNV
LATENCY_MARKER_TRIGGER_FLASH_NV = LatencyMarkerNV 7

-- No documentation found for Nested "VkLatencyMarkerNV" "VK_LATENCY_MARKER_OUT_OF_BAND_RENDERSUBMIT_START_NV"
pattern $mLATENCY_MARKER_OUT_OF_BAND_RENDERSUBMIT_START_NV :: forall {r}. LatencyMarkerNV -> ((# #) -> r) -> ((# #) -> r) -> r
$bLATENCY_MARKER_OUT_OF_BAND_RENDERSUBMIT_START_NV :: LatencyMarkerNV
LATENCY_MARKER_OUT_OF_BAND_RENDERSUBMIT_START_NV = LatencyMarkerNV 8

-- No documentation found for Nested "VkLatencyMarkerNV" "VK_LATENCY_MARKER_OUT_OF_BAND_RENDERSUBMIT_END_NV"
pattern $mLATENCY_MARKER_OUT_OF_BAND_RENDERSUBMIT_END_NV :: forall {r}. LatencyMarkerNV -> ((# #) -> r) -> ((# #) -> r) -> r
$bLATENCY_MARKER_OUT_OF_BAND_RENDERSUBMIT_END_NV :: LatencyMarkerNV
LATENCY_MARKER_OUT_OF_BAND_RENDERSUBMIT_END_NV = LatencyMarkerNV 9

-- No documentation found for Nested "VkLatencyMarkerNV" "VK_LATENCY_MARKER_OUT_OF_BAND_PRESENT_START_NV"
pattern $mLATENCY_MARKER_OUT_OF_BAND_PRESENT_START_NV :: forall {r}. LatencyMarkerNV -> ((# #) -> r) -> ((# #) -> r) -> r
$bLATENCY_MARKER_OUT_OF_BAND_PRESENT_START_NV :: LatencyMarkerNV
LATENCY_MARKER_OUT_OF_BAND_PRESENT_START_NV = LatencyMarkerNV 10

-- No documentation found for Nested "VkLatencyMarkerNV" "VK_LATENCY_MARKER_OUT_OF_BAND_PRESENT_END_NV"
pattern $mLATENCY_MARKER_OUT_OF_BAND_PRESENT_END_NV :: forall {r}. LatencyMarkerNV -> ((# #) -> r) -> ((# #) -> r) -> r
$bLATENCY_MARKER_OUT_OF_BAND_PRESENT_END_NV :: LatencyMarkerNV
LATENCY_MARKER_OUT_OF_BAND_PRESENT_END_NV = LatencyMarkerNV 11

{-# COMPLETE
  LATENCY_MARKER_SIMULATION_START_NV
  , LATENCY_MARKER_SIMULATION_END_NV
  , LATENCY_MARKER_RENDERSUBMIT_START_NV
  , LATENCY_MARKER_RENDERSUBMIT_END_NV
  , LATENCY_MARKER_PRESENT_START_NV
  , LATENCY_MARKER_PRESENT_END_NV
  , LATENCY_MARKER_INPUT_SAMPLE_NV
  , LATENCY_MARKER_TRIGGER_FLASH_NV
  , LATENCY_MARKER_OUT_OF_BAND_RENDERSUBMIT_START_NV
  , LATENCY_MARKER_OUT_OF_BAND_RENDERSUBMIT_END_NV
  , LATENCY_MARKER_OUT_OF_BAND_PRESENT_START_NV
  , LATENCY_MARKER_OUT_OF_BAND_PRESENT_END_NV ::
    LatencyMarkerNV
  #-}

conNameLatencyMarkerNV :: String
conNameLatencyMarkerNV :: String
conNameLatencyMarkerNV = String
"LatencyMarkerNV"

enumPrefixLatencyMarkerNV :: String
enumPrefixLatencyMarkerNV :: String
enumPrefixLatencyMarkerNV = String
"LATENCY_MARKER_"

showTableLatencyMarkerNV :: [(LatencyMarkerNV, String)]
showTableLatencyMarkerNV :: [(LatencyMarkerNV, String)]
showTableLatencyMarkerNV =
  [
    ( LatencyMarkerNV
LATENCY_MARKER_SIMULATION_START_NV
    , String
"SIMULATION_START_NV"
    )
  ,
    ( LatencyMarkerNV
LATENCY_MARKER_SIMULATION_END_NV
    , String
"SIMULATION_END_NV"
    )
  ,
    ( LatencyMarkerNV
LATENCY_MARKER_RENDERSUBMIT_START_NV
    , String
"RENDERSUBMIT_START_NV"
    )
  ,
    ( LatencyMarkerNV
LATENCY_MARKER_RENDERSUBMIT_END_NV
    , String
"RENDERSUBMIT_END_NV"
    )
  ,
    ( LatencyMarkerNV
LATENCY_MARKER_PRESENT_START_NV
    , String
"PRESENT_START_NV"
    )
  , (LatencyMarkerNV
LATENCY_MARKER_PRESENT_END_NV, String
"PRESENT_END_NV")
  , (LatencyMarkerNV
LATENCY_MARKER_INPUT_SAMPLE_NV, String
"INPUT_SAMPLE_NV")
  ,
    ( LatencyMarkerNV
LATENCY_MARKER_TRIGGER_FLASH_NV
    , String
"TRIGGER_FLASH_NV"
    )
  ,
    ( LatencyMarkerNV
LATENCY_MARKER_OUT_OF_BAND_RENDERSUBMIT_START_NV
    , String
"OUT_OF_BAND_RENDERSUBMIT_START_NV"
    )
  ,
    ( LatencyMarkerNV
LATENCY_MARKER_OUT_OF_BAND_RENDERSUBMIT_END_NV
    , String
"OUT_OF_BAND_RENDERSUBMIT_END_NV"
    )
  ,
    ( LatencyMarkerNV
LATENCY_MARKER_OUT_OF_BAND_PRESENT_START_NV
    , String
"OUT_OF_BAND_PRESENT_START_NV"
    )
  ,
    ( LatencyMarkerNV
LATENCY_MARKER_OUT_OF_BAND_PRESENT_END_NV
    , String
"OUT_OF_BAND_PRESENT_END_NV"
    )
  ]

instance Show LatencyMarkerNV where
  showsPrec :: Int -> LatencyMarkerNV -> ShowS
showsPrec =
    String
-> [(LatencyMarkerNV, String)]
-> String
-> (LatencyMarkerNV -> Int32)
-> (Int32 -> ShowS)
-> Int
-> LatencyMarkerNV
-> ShowS
forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
      String
enumPrefixLatencyMarkerNV
      [(LatencyMarkerNV, String)]
showTableLatencyMarkerNV
      String
conNameLatencyMarkerNV
      (\(LatencyMarkerNV Int32
x) -> Int32
x)
      (Int -> Int32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11)

instance Read LatencyMarkerNV where
  readPrec :: ReadPrec LatencyMarkerNV
readPrec =
    String
-> [(LatencyMarkerNV, String)]
-> String
-> (Int32 -> LatencyMarkerNV)
-> ReadPrec LatencyMarkerNV
forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
      String
enumPrefixLatencyMarkerNV
      [(LatencyMarkerNV, String)]
showTableLatencyMarkerNV
      String
conNameLatencyMarkerNV
      Int32 -> LatencyMarkerNV
LatencyMarkerNV

-- | VkOutOfBandQueueTypeNV - Type of out of band queue
--
-- = Description
--
-- The members of the 'OutOfBandQueueTypeNV' are used to describe the queue
-- type in 'OutOfBandQueueTypeInfoNV' as described below:
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_low_latency2 VK_NV_low_latency2>,
-- 'OutOfBandQueueTypeInfoNV'
newtype OutOfBandQueueTypeNV = OutOfBandQueueTypeNV Int32
  deriving newtype (OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> Bool
(OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> Bool)
-> (OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> Bool)
-> Eq OutOfBandQueueTypeNV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> Bool
== :: OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> Bool
$c/= :: OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> Bool
/= :: OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> Bool
Eq, Eq OutOfBandQueueTypeNV
Eq OutOfBandQueueTypeNV =>
(OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> Ordering)
-> (OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> Bool)
-> (OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> Bool)
-> (OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> Bool)
-> (OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> Bool)
-> (OutOfBandQueueTypeNV
    -> OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV)
-> (OutOfBandQueueTypeNV
    -> OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV)
-> Ord OutOfBandQueueTypeNV
OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> Bool
OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> Ordering
OutOfBandQueueTypeNV
-> OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV
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
$ccompare :: OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> Ordering
compare :: OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> Ordering
$c< :: OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> Bool
< :: OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> Bool
$c<= :: OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> Bool
<= :: OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> Bool
$c> :: OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> Bool
> :: OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> Bool
$c>= :: OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> Bool
>= :: OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> Bool
$cmax :: OutOfBandQueueTypeNV
-> OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV
max :: OutOfBandQueueTypeNV
-> OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV
$cmin :: OutOfBandQueueTypeNV
-> OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV
min :: OutOfBandQueueTypeNV
-> OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV
Ord, Ptr OutOfBandQueueTypeNV -> IO OutOfBandQueueTypeNV
Ptr OutOfBandQueueTypeNV -> Int -> IO OutOfBandQueueTypeNV
Ptr OutOfBandQueueTypeNV -> Int -> OutOfBandQueueTypeNV -> IO ()
Ptr OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> IO ()
OutOfBandQueueTypeNV -> Int
(OutOfBandQueueTypeNV -> Int)
-> (OutOfBandQueueTypeNV -> Int)
-> (Ptr OutOfBandQueueTypeNV -> Int -> IO OutOfBandQueueTypeNV)
-> (Ptr OutOfBandQueueTypeNV
    -> Int -> OutOfBandQueueTypeNV -> IO ())
-> (forall b. Ptr b -> Int -> IO OutOfBandQueueTypeNV)
-> (forall b. Ptr b -> Int -> OutOfBandQueueTypeNV -> IO ())
-> (Ptr OutOfBandQueueTypeNV -> IO OutOfBandQueueTypeNV)
-> (Ptr OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> IO ())
-> Storable OutOfBandQueueTypeNV
forall b. Ptr b -> Int -> IO OutOfBandQueueTypeNV
forall b. Ptr b -> Int -> OutOfBandQueueTypeNV -> 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
$csizeOf :: OutOfBandQueueTypeNV -> Int
sizeOf :: OutOfBandQueueTypeNV -> Int
$calignment :: OutOfBandQueueTypeNV -> Int
alignment :: OutOfBandQueueTypeNV -> Int
$cpeekElemOff :: Ptr OutOfBandQueueTypeNV -> Int -> IO OutOfBandQueueTypeNV
peekElemOff :: Ptr OutOfBandQueueTypeNV -> Int -> IO OutOfBandQueueTypeNV
$cpokeElemOff :: Ptr OutOfBandQueueTypeNV -> Int -> OutOfBandQueueTypeNV -> IO ()
pokeElemOff :: Ptr OutOfBandQueueTypeNV -> Int -> OutOfBandQueueTypeNV -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO OutOfBandQueueTypeNV
peekByteOff :: forall b. Ptr b -> Int -> IO OutOfBandQueueTypeNV
$cpokeByteOff :: forall b. Ptr b -> Int -> OutOfBandQueueTypeNV -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> OutOfBandQueueTypeNV -> IO ()
$cpeek :: Ptr OutOfBandQueueTypeNV -> IO OutOfBandQueueTypeNV
peek :: Ptr OutOfBandQueueTypeNV -> IO OutOfBandQueueTypeNV
$cpoke :: Ptr OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> IO ()
poke :: Ptr OutOfBandQueueTypeNV -> OutOfBandQueueTypeNV -> IO ()
Storable, OutOfBandQueueTypeNV
OutOfBandQueueTypeNV -> Zero OutOfBandQueueTypeNV
forall a. a -> Zero a
$czero :: OutOfBandQueueTypeNV
zero :: OutOfBandQueueTypeNV
Zero)

-- | 'OUT_OF_BAND_QUEUE_TYPE_RENDER_NV' indicates that work will be submitted
-- to this queue.
pattern $mOUT_OF_BAND_QUEUE_TYPE_RENDER_NV :: forall {r}.
OutOfBandQueueTypeNV -> ((# #) -> r) -> ((# #) -> r) -> r
$bOUT_OF_BAND_QUEUE_TYPE_RENDER_NV :: OutOfBandQueueTypeNV
OUT_OF_BAND_QUEUE_TYPE_RENDER_NV = OutOfBandQueueTypeNV 0

-- | 'OUT_OF_BAND_QUEUE_TYPE_PRESENT_NV' indicates that this queue will be
-- presented from.
pattern $mOUT_OF_BAND_QUEUE_TYPE_PRESENT_NV :: forall {r}.
OutOfBandQueueTypeNV -> ((# #) -> r) -> ((# #) -> r) -> r
$bOUT_OF_BAND_QUEUE_TYPE_PRESENT_NV :: OutOfBandQueueTypeNV
OUT_OF_BAND_QUEUE_TYPE_PRESENT_NV = OutOfBandQueueTypeNV 1

{-# COMPLETE
  OUT_OF_BAND_QUEUE_TYPE_RENDER_NV
  , OUT_OF_BAND_QUEUE_TYPE_PRESENT_NV ::
    OutOfBandQueueTypeNV
  #-}

conNameOutOfBandQueueTypeNV :: String
conNameOutOfBandQueueTypeNV :: String
conNameOutOfBandQueueTypeNV = String
"OutOfBandQueueTypeNV"

enumPrefixOutOfBandQueueTypeNV :: String
enumPrefixOutOfBandQueueTypeNV :: String
enumPrefixOutOfBandQueueTypeNV = String
"OUT_OF_BAND_QUEUE_TYPE_"

showTableOutOfBandQueueTypeNV :: [(OutOfBandQueueTypeNV, String)]
showTableOutOfBandQueueTypeNV :: [(OutOfBandQueueTypeNV, String)]
showTableOutOfBandQueueTypeNV =
  [
    ( OutOfBandQueueTypeNV
OUT_OF_BAND_QUEUE_TYPE_RENDER_NV
    , String
"RENDER_NV"
    )
  ,
    ( OutOfBandQueueTypeNV
OUT_OF_BAND_QUEUE_TYPE_PRESENT_NV
    , String
"PRESENT_NV"
    )
  ]

instance Show OutOfBandQueueTypeNV where
  showsPrec :: Int -> OutOfBandQueueTypeNV -> ShowS
showsPrec =
    String
-> [(OutOfBandQueueTypeNV, String)]
-> String
-> (OutOfBandQueueTypeNV -> Int32)
-> (Int32 -> ShowS)
-> Int
-> OutOfBandQueueTypeNV
-> ShowS
forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
      String
enumPrefixOutOfBandQueueTypeNV
      [(OutOfBandQueueTypeNV, String)]
showTableOutOfBandQueueTypeNV
      String
conNameOutOfBandQueueTypeNV
      (\(OutOfBandQueueTypeNV Int32
x) -> Int32
x)
      (Int -> Int32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11)

instance Read OutOfBandQueueTypeNV where
  readPrec :: ReadPrec OutOfBandQueueTypeNV
readPrec =
    String
-> [(OutOfBandQueueTypeNV, String)]
-> String
-> (Int32 -> OutOfBandQueueTypeNV)
-> ReadPrec OutOfBandQueueTypeNV
forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
      String
enumPrefixOutOfBandQueueTypeNV
      [(OutOfBandQueueTypeNV, String)]
showTableOutOfBandQueueTypeNV
      String
conNameOutOfBandQueueTypeNV
      Int32 -> OutOfBandQueueTypeNV
OutOfBandQueueTypeNV

type NV_LOW_LATENCY_2_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_NV_LOW_LATENCY_2_SPEC_VERSION"
pattern NV_LOW_LATENCY_2_SPEC_VERSION :: forall a . Integral a => a
pattern $mNV_LOW_LATENCY_2_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bNV_LOW_LATENCY_2_SPEC_VERSION :: forall a. Integral a => a
NV_LOW_LATENCY_2_SPEC_VERSION = 1


type NV_LOW_LATENCY_2_EXTENSION_NAME = "VK_NV_low_latency2"

-- No documentation found for TopLevel "VK_NV_LOW_LATENCY_2_EXTENSION_NAME"
pattern NV_LOW_LATENCY_2_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $mNV_LOW_LATENCY_2_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bNV_LOW_LATENCY_2_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
NV_LOW_LATENCY_2_EXTENSION_NAME = "VK_NV_low_latency2"