{-# language CPP #-}
-- | = Name
--
-- VK_GOOGLE_display_timing - device extension
--
-- == VK_GOOGLE_display_timing
--
-- [__Name String__]
--     @VK_GOOGLE_display_timing@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     93
--
-- [__Revision__]
--     1
--
-- [__Extension and Version Dependencies__]
--
--     -   Requires support for Vulkan 1.0
--
--     -   Requires @VK_KHR_swapchain@ to be enabled for any device-level
--         functionality
--
-- [__Contact__]
--
--     -   Ian Elliott
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_GOOGLE_display_timing] @ianelliottus%0A*Here describe the issue or question you have about the VK_GOOGLE_display_timing extension* >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2017-02-14
--
-- [__IP Status__]
--     No known IP claims.
--
-- [__Contributors__]
--
--     -   Ian Elliott, Google
--
--     -   Jesse Hall, Google
--
-- == Description
--
-- This device extension allows an application that uses the
-- @VK_KHR_swapchain@ extension to obtain information about the
-- presentation engine’s display, to obtain timing information about each
-- present, and to schedule a present to happen no earlier than a desired
-- time. An application can use this to minimize various visual anomalies
-- (e.g. stuttering).
--
-- Traditional game and real-time animation applications need to correctly
-- position their geometry for when the presentable image will be presented
-- to the user. To accomplish this, applications need various timing
-- information about the presentation engine’s display. They need to know
-- when presentable images were actually presented, and when they could
-- have been presented. Applications also need to tell the presentation
-- engine to display an image no sooner than a given time. This allows the
-- application to avoid stuttering, so the animation looks smooth to the
-- user.
--
-- This extension treats variable-refresh-rate (VRR) displays as if they
-- are fixed-refresh-rate (FRR) displays.
--
-- == New Commands
--
-- -   'getPastPresentationTimingGOOGLE'
--
-- -   'getRefreshCycleDurationGOOGLE'
--
-- == New Structures
--
-- -   'PastPresentationTimingGOOGLE'
--
-- -   'PresentTimeGOOGLE'
--
-- -   'RefreshCycleDurationGOOGLE'
--
-- -   Extending 'Vulkan.Extensions.VK_KHR_swapchain.PresentInfoKHR':
--
--     -   'PresentTimesInfoGOOGLE'
--
-- == New Enum Constants
--
-- -   'GOOGLE_DISPLAY_TIMING_EXTENSION_NAME'
--
-- -   'GOOGLE_DISPLAY_TIMING_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PRESENT_TIMES_INFO_GOOGLE'
--
-- == Examples
--
-- Note
--
-- The example code for the this extension (like the @VK_KHR_surface@ and
-- @VK_GOOGLE_display_timing@ extensions) is contained in the cube demo
-- that is shipped with the official Khronos SDK, and is being kept
-- up-to-date in that location (see:
-- <https://github.com/KhronosGroup/Vulkan-Tools/blob/master/cube/cube.c>
-- ).
--
-- == Version History
--
-- -   Revision 1, 2017-02-14 (Ian Elliott)
--
--     -   Internal revisions
--
-- == See Also
--
-- 'PastPresentationTimingGOOGLE', 'PresentTimeGOOGLE',
-- 'PresentTimesInfoGOOGLE', 'RefreshCycleDurationGOOGLE',
-- 'getPastPresentationTimingGOOGLE', 'getRefreshCycleDurationGOOGLE'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_GOOGLE_display_timing Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_GOOGLE_display_timing  ( getRefreshCycleDurationGOOGLE
                                                   , getPastPresentationTimingGOOGLE
                                                   , RefreshCycleDurationGOOGLE(..)
                                                   , PastPresentationTimingGOOGLE(..)
                                                   , PresentTimesInfoGOOGLE(..)
                                                   , PresentTimeGOOGLE(..)
                                                   , GOOGLE_DISPLAY_TIMING_SPEC_VERSION
                                                   , pattern GOOGLE_DISPLAY_TIMING_SPEC_VERSION
                                                   , GOOGLE_DISPLAY_TIMING_EXTENSION_NAME
                                                   , pattern GOOGLE_DISPLAY_TIMING_EXTENSION_NAME
                                                   , SwapchainKHR(..)
                                                   ) where

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 Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import qualified Data.Vector (null)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Word (Word64)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import Vulkan.CStruct.Utils (advancePtrBytes)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkGetPastPresentationTimingGOOGLE))
import Vulkan.Dynamic (DeviceCmds(pVkGetRefreshCycleDurationGOOGLE))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Extensions.Handles (SwapchainKHR)
import Vulkan.Extensions.Handles (SwapchainKHR(..))
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PRESENT_TIMES_INFO_GOOGLE))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Extensions.Handles (SwapchainKHR(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetRefreshCycleDurationGOOGLE
  :: FunPtr (Ptr Device_T -> SwapchainKHR -> Ptr RefreshCycleDurationGOOGLE -> IO Result) -> Ptr Device_T -> SwapchainKHR -> Ptr RefreshCycleDurationGOOGLE -> IO Result

-- | vkGetRefreshCycleDurationGOOGLE - Obtain the RC duration of the PE’s
-- display
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkGetRefreshCycleDurationGOOGLE-device-parameter# @device@
--     /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkGetRefreshCycleDurationGOOGLE-swapchain-parameter#
--     @swapchain@ /must/ be a valid
--     'Vulkan.Extensions.Handles.SwapchainKHR' handle
--
-- -   #VUID-vkGetRefreshCycleDurationGOOGLE-pDisplayTimingProperties-parameter#
--     @pDisplayTimingProperties@ /must/ be a valid pointer to a
--     'RefreshCycleDurationGOOGLE' structure
--
-- -   #VUID-vkGetRefreshCycleDurationGOOGLE-swapchain-parent# @swapchain@
--     /must/ have been created, allocated, or retrieved from @device@
--
-- == Host Synchronization
--
-- -   Host access to @swapchain@ /must/ be externally synchronized
--
-- == 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_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_DEVICE_LOST'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_SURFACE_LOST_KHR'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_GOOGLE_display_timing VK_GOOGLE_display_timing>,
-- 'Vulkan.Core10.Handles.Device', 'RefreshCycleDurationGOOGLE',
-- 'Vulkan.Extensions.Handles.SwapchainKHR'
getRefreshCycleDurationGOOGLE :: forall io
                               . (MonadIO io)
                              => -- | @device@ is the device associated with @swapchain@.
                                 Device
                              -> -- | @swapchain@ is the swapchain to obtain the refresh duration for.
                                 SwapchainKHR
                              -> io (("displayTimingProperties" ::: RefreshCycleDurationGOOGLE))
getRefreshCycleDurationGOOGLE :: forall (io :: * -> *).
MonadIO io =>
Device -> SwapchainKHR -> io RefreshCycleDurationGOOGLE
getRefreshCycleDurationGOOGLE Device
device SwapchainKHR
swapchain = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
  let vkGetRefreshCycleDurationGOOGLEPtr :: FunPtr
  (Ptr Device_T
   -> SwapchainKHR
   -> ("pDisplayTimingProperties" ::: Ptr RefreshCycleDurationGOOGLE)
   -> IO Result)
vkGetRefreshCycleDurationGOOGLEPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> SwapchainKHR
      -> ("pDisplayTimingProperties" ::: Ptr RefreshCycleDurationGOOGLE)
      -> IO Result)
pVkGetRefreshCycleDurationGOOGLE (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> SwapchainKHR
   -> ("pDisplayTimingProperties" ::: Ptr RefreshCycleDurationGOOGLE)
   -> IO Result)
vkGetRefreshCycleDurationGOOGLEPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetRefreshCycleDurationGOOGLE is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkGetRefreshCycleDurationGOOGLE' :: Ptr Device_T
-> SwapchainKHR
-> ("pDisplayTimingProperties" ::: Ptr RefreshCycleDurationGOOGLE)
-> IO Result
vkGetRefreshCycleDurationGOOGLE' = FunPtr
  (Ptr Device_T
   -> SwapchainKHR
   -> ("pDisplayTimingProperties" ::: Ptr RefreshCycleDurationGOOGLE)
   -> IO Result)
-> Ptr Device_T
-> SwapchainKHR
-> ("pDisplayTimingProperties" ::: Ptr RefreshCycleDurationGOOGLE)
-> IO Result
mkVkGetRefreshCycleDurationGOOGLE FunPtr
  (Ptr Device_T
   -> SwapchainKHR
   -> ("pDisplayTimingProperties" ::: Ptr RefreshCycleDurationGOOGLE)
   -> IO Result)
vkGetRefreshCycleDurationGOOGLEPtr
  "pDisplayTimingProperties" ::: Ptr RefreshCycleDurationGOOGLE
pPDisplayTimingProperties <- 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 @RefreshCycleDurationGOOGLE)
  Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetRefreshCycleDurationGOOGLE" (Ptr Device_T
-> SwapchainKHR
-> ("pDisplayTimingProperties" ::: Ptr RefreshCycleDurationGOOGLE)
-> IO Result
vkGetRefreshCycleDurationGOOGLE'
                                                                    (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                                    (SwapchainKHR
swapchain)
                                                                    ("pDisplayTimingProperties" ::: Ptr RefreshCycleDurationGOOGLE
pPDisplayTimingProperties))
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  RefreshCycleDurationGOOGLE
pDisplayTimingProperties <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @RefreshCycleDurationGOOGLE "pDisplayTimingProperties" ::: Ptr RefreshCycleDurationGOOGLE
pPDisplayTimingProperties
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (RefreshCycleDurationGOOGLE
pDisplayTimingProperties)


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

-- | vkGetPastPresentationTimingGOOGLE - Obtain timing of a
-- previously-presented image
--
-- = Description
--
-- If @pPresentationTimings@ is @NULL@, then the number of newly-available
-- timing records for the given @swapchain@ is returned in
-- @pPresentationTimingCount@. Otherwise, @pPresentationTimingCount@ /must/
-- point to a variable set by the user to the number of elements in the
-- @pPresentationTimings@ array, and on return the variable is overwritten
-- with the number of structures actually written to
-- @pPresentationTimings@. If the value of @pPresentationTimingCount@ is
-- less than the number of newly-available timing records, at most
-- @pPresentationTimingCount@ structures will be written, and
-- 'Vulkan.Core10.Enums.Result.INCOMPLETE' will be returned instead of
-- 'Vulkan.Core10.Enums.Result.SUCCESS', to indicate that not all the
-- available timing records were returned.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkGetPastPresentationTimingGOOGLE-device-parameter# @device@
--     /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkGetPastPresentationTimingGOOGLE-swapchain-parameter#
--     @swapchain@ /must/ be a valid
--     'Vulkan.Extensions.Handles.SwapchainKHR' handle
--
-- -   #VUID-vkGetPastPresentationTimingGOOGLE-pPresentationTimingCount-parameter#
--     @pPresentationTimingCount@ /must/ be a valid pointer to a @uint32_t@
--     value
--
-- -   #VUID-vkGetPastPresentationTimingGOOGLE-pPresentationTimings-parameter#
--     If the value referenced by @pPresentationTimingCount@ is not @0@,
--     and @pPresentationTimings@ is not @NULL@, @pPresentationTimings@
--     /must/ be a valid pointer to an array of @pPresentationTimingCount@
--     'PastPresentationTimingGOOGLE' structures
--
-- -   #VUID-vkGetPastPresentationTimingGOOGLE-swapchain-parent#
--     @swapchain@ /must/ have been created, allocated, or retrieved from
--     @device@
--
-- == Host Synchronization
--
-- -   Host access to @swapchain@ /must/ be externally synchronized
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
--     -   'Vulkan.Core10.Enums.Result.INCOMPLETE'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_DEVICE_LOST'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DATE_KHR'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_SURFACE_LOST_KHR'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_GOOGLE_display_timing VK_GOOGLE_display_timing>,
-- 'Vulkan.Core10.Handles.Device', 'PastPresentationTimingGOOGLE',
-- 'Vulkan.Extensions.Handles.SwapchainKHR'
getPastPresentationTimingGOOGLE :: forall io
                                 . (MonadIO io)
                                => -- | @device@ is the device associated with @swapchain@.
                                   Device
                                -> -- | @swapchain@ is the swapchain to obtain presentation timing information
                                   -- duration for.
                                   SwapchainKHR
                                -> io (Result, ("presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
getPastPresentationTimingGOOGLE :: forall (io :: * -> *).
MonadIO io =>
Device
-> SwapchainKHR
-> io
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
getPastPresentationTimingGOOGLE Device
device SwapchainKHR
swapchain = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
  let vkGetPastPresentationTimingGOOGLEPtr :: FunPtr
  (Ptr Device_T
   -> SwapchainKHR
   -> ("pPresentationTimingCount" ::: Ptr Word32)
   -> ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
   -> IO Result)
vkGetPastPresentationTimingGOOGLEPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> SwapchainKHR
      -> ("pPresentationTimingCount" ::: Ptr Word32)
      -> ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
      -> IO Result)
pVkGetPastPresentationTimingGOOGLE (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> SwapchainKHR
   -> ("pPresentationTimingCount" ::: Ptr Word32)
   -> ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
   -> IO Result)
vkGetPastPresentationTimingGOOGLEPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetPastPresentationTimingGOOGLE is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkGetPastPresentationTimingGOOGLE' :: Ptr Device_T
-> SwapchainKHR
-> ("pPresentationTimingCount" ::: Ptr Word32)
-> ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> IO Result
vkGetPastPresentationTimingGOOGLE' = FunPtr
  (Ptr Device_T
   -> SwapchainKHR
   -> ("pPresentationTimingCount" ::: Ptr Word32)
   -> ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
   -> IO Result)
-> Ptr Device_T
-> SwapchainKHR
-> ("pPresentationTimingCount" ::: Ptr Word32)
-> ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> IO Result
mkVkGetPastPresentationTimingGOOGLE FunPtr
  (Ptr Device_T
   -> SwapchainKHR
   -> ("pPresentationTimingCount" ::: Ptr Word32)
   -> ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
   -> IO Result)
vkGetPastPresentationTimingGOOGLEPtr
  let device' :: Ptr Device_T
device' = Device -> Ptr Device_T
deviceHandle (Device
device)
  "pPresentationTimingCount" ::: Ptr Word32
pPPresentationTimingCount <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @Word32 Int
4) forall a. Ptr a -> IO ()
free
  Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPastPresentationTimingGOOGLE" (Ptr Device_T
-> SwapchainKHR
-> ("pPresentationTimingCount" ::: Ptr Word32)
-> ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> IO Result
vkGetPastPresentationTimingGOOGLE'
                                                                      Ptr Device_T
device'
                                                                      (SwapchainKHR
swapchain)
                                                                      ("pPresentationTimingCount" ::: Ptr Word32
pPPresentationTimingCount)
                                                                      (forall a. Ptr a
nullPtr))
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  Word32
pPresentationTimingCount <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPresentationTimingCount" ::: Ptr Word32
pPPresentationTimingCount
  "pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
pPPresentationTimings <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @PastPresentationTimingGOOGLE ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPresentationTimingCount)) forall a. Num a => a -> a -> a
* Int
40)) forall a. Ptr a -> IO ()
free
  [()]
_ <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Int
i -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => Ptr a -> IO b -> IO b
pokeZeroCStruct ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
pPPresentationTimings forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i forall a. Num a => a -> a -> a
* Int
40) :: Ptr PastPresentationTimingGOOGLE) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())) [Int
0..(forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPresentationTimingCount)) forall a. Num a => a -> a -> a
- Int
1]
  Result
r' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPastPresentationTimingGOOGLE" (Ptr Device_T
-> SwapchainKHR
-> ("pPresentationTimingCount" ::: Ptr Word32)
-> ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> IO Result
vkGetPastPresentationTimingGOOGLE'
                                                                       Ptr Device_T
device'
                                                                       (SwapchainKHR
swapchain)
                                                                       ("pPresentationTimingCount" ::: Ptr Word32
pPPresentationTimingCount)
                                                                       (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
pPPresentationTimings)))
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r' forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r'))
  Word32
pPresentationTimingCount' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPresentationTimingCount" ::: Ptr Word32
pPPresentationTimingCount
  "presentationTimings" ::: Vector PastPresentationTimingGOOGLE
pPresentationTimings' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPresentationTimingCount')) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PastPresentationTimingGOOGLE ((("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
pPPresentationTimings) forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
40 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr PastPresentationTimingGOOGLE)))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ((Result
r'), "presentationTimings" ::: Vector PastPresentationTimingGOOGLE
pPresentationTimings')


-- | VkRefreshCycleDurationGOOGLE - Structure containing the RC duration of a
-- display
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_GOOGLE_display_timing VK_GOOGLE_display_timing>,
-- 'getRefreshCycleDurationGOOGLE'
data RefreshCycleDurationGOOGLE = RefreshCycleDurationGOOGLE
  { -- | @refreshDuration@ is the number of nanoseconds from the start of one
    -- refresh cycle to the next.
    RefreshCycleDurationGOOGLE -> Word64
refreshDuration :: Word64 }
  deriving (Typeable, RefreshCycleDurationGOOGLE -> RefreshCycleDurationGOOGLE -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RefreshCycleDurationGOOGLE -> RefreshCycleDurationGOOGLE -> Bool
$c/= :: RefreshCycleDurationGOOGLE -> RefreshCycleDurationGOOGLE -> Bool
== :: RefreshCycleDurationGOOGLE -> RefreshCycleDurationGOOGLE -> Bool
$c== :: RefreshCycleDurationGOOGLE -> RefreshCycleDurationGOOGLE -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (RefreshCycleDurationGOOGLE)
#endif
deriving instance Show RefreshCycleDurationGOOGLE

instance ToCStruct RefreshCycleDurationGOOGLE where
  withCStruct :: forall b.
RefreshCycleDurationGOOGLE
-> (("pDisplayTimingProperties" ::: Ptr RefreshCycleDurationGOOGLE)
    -> IO b)
-> IO b
withCStruct RefreshCycleDurationGOOGLE
x ("pDisplayTimingProperties" ::: Ptr RefreshCycleDurationGOOGLE)
-> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
8 forall a b. (a -> b) -> a -> b
$ \"pDisplayTimingProperties" ::: Ptr RefreshCycleDurationGOOGLE
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pDisplayTimingProperties" ::: Ptr RefreshCycleDurationGOOGLE
p RefreshCycleDurationGOOGLE
x (("pDisplayTimingProperties" ::: Ptr RefreshCycleDurationGOOGLE)
-> IO b
f "pDisplayTimingProperties" ::: Ptr RefreshCycleDurationGOOGLE
p)
  pokeCStruct :: forall b.
("pDisplayTimingProperties" ::: Ptr RefreshCycleDurationGOOGLE)
-> RefreshCycleDurationGOOGLE -> IO b -> IO b
pokeCStruct "pDisplayTimingProperties" ::: Ptr RefreshCycleDurationGOOGLE
p RefreshCycleDurationGOOGLE{Word64
refreshDuration :: Word64
$sel:refreshDuration:RefreshCycleDurationGOOGLE :: RefreshCycleDurationGOOGLE -> Word64
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pDisplayTimingProperties" ::: Ptr RefreshCycleDurationGOOGLE
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word64)) (Word64
refreshDuration)
    IO b
f
  cStructSize :: Int
cStructSize = Int
8
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pDisplayTimingProperties" ::: Ptr RefreshCycleDurationGOOGLE)
-> IO b -> IO b
pokeZeroCStruct "pDisplayTimingProperties" ::: Ptr RefreshCycleDurationGOOGLE
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pDisplayTimingProperties" ::: Ptr RefreshCycleDurationGOOGLE
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word64)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct RefreshCycleDurationGOOGLE where
  peekCStruct :: ("pDisplayTimingProperties" ::: Ptr RefreshCycleDurationGOOGLE)
-> IO RefreshCycleDurationGOOGLE
peekCStruct "pDisplayTimingProperties" ::: Ptr RefreshCycleDurationGOOGLE
p = do
    Word64
refreshDuration <- forall a. Storable a => Ptr a -> IO a
peek @Word64 (("pDisplayTimingProperties" ::: Ptr RefreshCycleDurationGOOGLE
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word64))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word64 -> RefreshCycleDurationGOOGLE
RefreshCycleDurationGOOGLE
             Word64
refreshDuration

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

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


-- | VkPastPresentationTimingGOOGLE - Structure containing timing information
-- about a previously-presented image
--
-- = Description
--
-- The results for a given @swapchain@ and @presentID@ are only returned
-- once from 'getPastPresentationTimingGOOGLE'.
--
-- The application /can/ use the 'PastPresentationTimingGOOGLE' values to
-- occasionally adjust its timing. For example, if @actualPresentTime@ is
-- later than expected (e.g. one @refreshDuration@ late), the application
-- may increase its target IPD to a higher multiple of @refreshDuration@
-- (e.g. decrease its frame rate from 60Hz to 30Hz). If @actualPresentTime@
-- and @earliestPresentTime@ are consistently different, and if
-- @presentMargin@ is consistently large enough, the application may
-- decrease its target IPD to a smaller multiple of @refreshDuration@ (e.g.
-- increase its frame rate from 30Hz to 60Hz). If @actualPresentTime@ and
-- @earliestPresentTime@ are same, and if @presentMargin@ is consistently
-- high, the application may delay the start of its input-render-present
-- loop in order to decrease the latency between user input and the
-- corresponding present (always leaving some margin in case a new image
-- takes longer to render than the previous image). An application that
-- desires its target IPD to always be the same as @refreshDuration@, can
-- also adjust features until @actualPresentTime@ is never late and
-- @presentMargin@ is satisfactory.
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_GOOGLE_display_timing VK_GOOGLE_display_timing>,
-- 'getPastPresentationTimingGOOGLE'
data PastPresentationTimingGOOGLE = PastPresentationTimingGOOGLE
  { -- | @presentID@ is an application-provided value that was given to a
    -- previous 'Vulkan.Extensions.VK_KHR_swapchain.queuePresentKHR' command
    -- via 'PresentTimeGOOGLE'::@presentID@ (see below). It /can/ be used to
    -- uniquely identify a previous present with the
    -- 'Vulkan.Extensions.VK_KHR_swapchain.queuePresentKHR' command.
    PastPresentationTimingGOOGLE -> Word32
presentID :: Word32
  , -- | @desiredPresentTime@ is an application-provided value that was given to
    -- a previous 'Vulkan.Extensions.VK_KHR_swapchain.queuePresentKHR' command
    -- via 'PresentTimeGOOGLE'::@desiredPresentTime@. If non-zero, it was used
    -- by the application to indicate that an image not be presented any sooner
    -- than @desiredPresentTime@.
    PastPresentationTimingGOOGLE -> Word64
desiredPresentTime :: Word64
  , -- | @actualPresentTime@ is the time when the image of the @swapchain@ was
    -- actually displayed.
    PastPresentationTimingGOOGLE -> Word64
actualPresentTime :: Word64
  , -- | @earliestPresentTime@ is the time when the image of the @swapchain@
    -- could have been displayed. This /may/ differ from @actualPresentTime@ if
    -- the application requested that the image be presented no sooner than
    -- 'PresentTimeGOOGLE'::@desiredPresentTime@.
    PastPresentationTimingGOOGLE -> Word64
earliestPresentTime :: Word64
  , -- | @presentMargin@ is an indication of how early the
    -- 'Vulkan.Extensions.VK_KHR_swapchain.queuePresentKHR' command was
    -- processed compared to how soon it needed to be processed, and still be
    -- presented at @earliestPresentTime@.
    PastPresentationTimingGOOGLE -> Word64
presentMargin :: Word64
  }
  deriving (Typeable, PastPresentationTimingGOOGLE
-> PastPresentationTimingGOOGLE -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PastPresentationTimingGOOGLE
-> PastPresentationTimingGOOGLE -> Bool
$c/= :: PastPresentationTimingGOOGLE
-> PastPresentationTimingGOOGLE -> Bool
== :: PastPresentationTimingGOOGLE
-> PastPresentationTimingGOOGLE -> Bool
$c== :: PastPresentationTimingGOOGLE
-> PastPresentationTimingGOOGLE -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PastPresentationTimingGOOGLE)
#endif
deriving instance Show PastPresentationTimingGOOGLE

instance ToCStruct PastPresentationTimingGOOGLE where
  withCStruct :: forall b.
PastPresentationTimingGOOGLE
-> (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
    -> IO b)
-> IO b
withCStruct PastPresentationTimingGOOGLE
x ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
40 forall a b. (a -> b) -> a -> b
$ \"pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p PastPresentationTimingGOOGLE
x (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> IO b
f "pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p)
  pokeCStruct :: forall b.
("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> PastPresentationTimingGOOGLE -> IO b -> IO b
pokeCStruct "pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p PastPresentationTimingGOOGLE{Word32
Word64
presentMargin :: Word64
earliestPresentTime :: Word64
actualPresentTime :: Word64
desiredPresentTime :: Word64
presentID :: Word32
$sel:presentMargin:PastPresentationTimingGOOGLE :: PastPresentationTimingGOOGLE -> Word64
$sel:earliestPresentTime:PastPresentationTimingGOOGLE :: PastPresentationTimingGOOGLE -> Word64
$sel:actualPresentTime:PastPresentationTimingGOOGLE :: PastPresentationTimingGOOGLE -> Word64
$sel:desiredPresentTime:PastPresentationTimingGOOGLE :: PastPresentationTimingGOOGLE -> Word64
$sel:presentID:PastPresentationTimingGOOGLE :: PastPresentationTimingGOOGLE -> Word32
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32)) (Word32
presentID)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word64)) (Word64
desiredPresentTime)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word64)) (Word64
actualPresentTime)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word64)) (Word64
earliestPresentTime)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word64)) (Word64
presentMargin)
    IO b
f
  cStructSize :: Int
cStructSize = Int
40
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> IO b -> IO b
pokeZeroCStruct "pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word64)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word64)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word64)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word64)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct PastPresentationTimingGOOGLE where
  peekCStruct :: ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> IO PastPresentationTimingGOOGLE
peekCStruct "pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p = do
    Word32
presentID <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32))
    Word64
desiredPresentTime <- forall a. Storable a => Ptr a -> IO a
peek @Word64 (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word64))
    Word64
actualPresentTime <- forall a. Storable a => Ptr a -> IO a
peek @Word64 (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word64))
    Word64
earliestPresentTime <- forall a. Storable a => Ptr a -> IO a
peek @Word64 (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word64))
    Word64
presentMargin <- forall a. Storable a => Ptr a -> IO a
peek @Word64 (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word64))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word32
-> Word64
-> Word64
-> Word64
-> Word64
-> PastPresentationTimingGOOGLE
PastPresentationTimingGOOGLE
             Word32
presentID
             Word64
desiredPresentTime
             Word64
actualPresentTime
             Word64
earliestPresentTime
             Word64
presentMargin

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

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


-- | VkPresentTimesInfoGOOGLE - The earliest time each image should be
-- presented
--
-- == Valid Usage
--
-- -   #VUID-VkPresentTimesInfoGOOGLE-swapchainCount-01247#
--     @swapchainCount@ /must/ be the same value as
--     'Vulkan.Extensions.VK_KHR_swapchain.PresentInfoKHR'::@swapchainCount@,
--     where 'Vulkan.Extensions.VK_KHR_swapchain.PresentInfoKHR' is
--     included in the @pNext@ chain of this 'PresentTimesInfoGOOGLE'
--     structure
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkPresentTimesInfoGOOGLE-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PRESENT_TIMES_INFO_GOOGLE'
--
-- -   #VUID-VkPresentTimesInfoGOOGLE-pTimes-parameter# If @pTimes@ is not
--     @NULL@, @pTimes@ /must/ be a valid pointer to an array of
--     @swapchainCount@ 'PresentTimeGOOGLE' structures
--
-- -   #VUID-VkPresentTimesInfoGOOGLE-swapchainCount-arraylength#
--     @swapchainCount@ /must/ be greater than @0@
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_GOOGLE_display_timing VK_GOOGLE_display_timing>,
-- 'PresentTimeGOOGLE', 'Vulkan.Core10.Enums.StructureType.StructureType'
data PresentTimesInfoGOOGLE = PresentTimesInfoGOOGLE
  { -- | @swapchainCount@ is the number of swapchains being presented to by this
    -- command.
    PresentTimesInfoGOOGLE -> Word32
swapchainCount :: Word32
  , -- | @pTimes@ is @NULL@ or a pointer to an array of 'PresentTimeGOOGLE'
    -- elements with @swapchainCount@ entries. If not @NULL@, each element of
    -- @pTimes@ contains the earliest time to present the image corresponding
    -- to the entry in the
    -- 'Vulkan.Extensions.VK_KHR_swapchain.PresentInfoKHR'::@pImageIndices@
    -- array.
    PresentTimesInfoGOOGLE -> Vector PresentTimeGOOGLE
times :: Vector PresentTimeGOOGLE
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PresentTimesInfoGOOGLE)
#endif
deriving instance Show PresentTimesInfoGOOGLE

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

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

instance Zero PresentTimesInfoGOOGLE where
  zero :: PresentTimesInfoGOOGLE
zero = Word32 -> Vector PresentTimeGOOGLE -> PresentTimesInfoGOOGLE
PresentTimesInfoGOOGLE
           forall a. Zero a => a
zero
           forall a. Monoid a => a
mempty


-- | VkPresentTimeGOOGLE - The earliest time image should be presented
--
-- = Description
--
-- > but does not need a specific pname:desiredPresentTime.
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_GOOGLE_display_timing VK_GOOGLE_display_timing>,
-- 'PresentTimesInfoGOOGLE'
data PresentTimeGOOGLE = PresentTimeGOOGLE
  { -- | @presentID@ is an application-provided identification value, that /can/
    -- be used with the results of 'getPastPresentationTimingGOOGLE', in order
    -- to uniquely identify this present. In order to be useful to the
    -- application, it /should/ be unique within some period of time that is
    -- meaningful to the application.
    PresentTimeGOOGLE -> Word32
presentID :: Word32
  , -- | @desiredPresentTime@ specifies that the image given /should/ not be
    -- displayed to the user any earlier than this time. @desiredPresentTime@
    -- is a time in nanoseconds, relative to a monotonically-increasing clock
    -- (e.g. @CLOCK_MONOTONIC@ (see clock_gettime(2)) on Android and Linux). A
    -- value of zero specifies that the presentation engine /may/ display the
    -- image at any time. This is useful when the application desires to
    -- provide @presentID@,
    PresentTimeGOOGLE -> Word64
desiredPresentTime :: Word64
  }
  deriving (Typeable, PresentTimeGOOGLE -> PresentTimeGOOGLE -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PresentTimeGOOGLE -> PresentTimeGOOGLE -> Bool
$c/= :: PresentTimeGOOGLE -> PresentTimeGOOGLE -> Bool
== :: PresentTimeGOOGLE -> PresentTimeGOOGLE -> Bool
$c== :: PresentTimeGOOGLE -> PresentTimeGOOGLE -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PresentTimeGOOGLE)
#endif
deriving instance Show PresentTimeGOOGLE

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

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

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

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


type GOOGLE_DISPLAY_TIMING_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_GOOGLE_DISPLAY_TIMING_SPEC_VERSION"
pattern GOOGLE_DISPLAY_TIMING_SPEC_VERSION :: forall a . Integral a => a
pattern $bGOOGLE_DISPLAY_TIMING_SPEC_VERSION :: forall a. Integral a => a
$mGOOGLE_DISPLAY_TIMING_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
GOOGLE_DISPLAY_TIMING_SPEC_VERSION = 1


type GOOGLE_DISPLAY_TIMING_EXTENSION_NAME = "VK_GOOGLE_display_timing"

-- No documentation found for TopLevel "VK_GOOGLE_DISPLAY_TIMING_EXTENSION_NAME"
pattern GOOGLE_DISPLAY_TIMING_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bGOOGLE_DISPLAY_TIMING_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mGOOGLE_DISPLAY_TIMING_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
GOOGLE_DISPLAY_TIMING_EXTENSION_NAME = "VK_GOOGLE_display_timing"