{-# language CPP #-}
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 Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytesAligned)
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 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.Dynamic (DeviceCmds(pVkGetPastPresentationTimingGOOGLE))
import Vulkan.Dynamic (DeviceCmds(pVkGetRefreshCycleDurationGOOGLE))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
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.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Exception (VulkanException(..))
import Vulkan.Zero (Zero(..))
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)
--
-- -   @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   @swapchain@ /must/ be a valid
--     'Vulkan.Extensions.Handles.SwapchainKHR' handle
--
-- -   @pDisplayTimingProperties@ /must/ be a valid pointer to a
--     'RefreshCycleDurationGOOGLE' structure
--
-- -   Both of @device@, and @swapchain@ /must/ have been created,
--     allocated, or retrieved from the same
--     'Vulkan.Core10.Handles.Instance'
--
-- == 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
--
-- '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 :: Device
-> SwapchainKHR
-> io ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
getRefreshCycleDurationGOOGLE device :: Device
device swapchain :: SwapchainKHR
swapchain = IO ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
-> io ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
 -> io ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE))
-> (ContT
      ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
      IO
      ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
    -> IO ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE))
-> ContT
     ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
     IO
     ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
-> io ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
  IO
  ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
-> IO ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
   IO
   ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
 -> io ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE))
-> ContT
     ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
     IO
     ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
-> io ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
forall a b. (a -> b) -> a -> b
$ do
  let vkGetRefreshCycleDurationGOOGLEPtr :: FunPtr
  (Ptr Device_T
   -> SwapchainKHR
   -> ("pDisplayTimingProperties"
       ::: Ptr ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE))
   -> IO Result)
vkGetRefreshCycleDurationGOOGLEPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> SwapchainKHR
      -> ("pDisplayTimingProperties"
          ::: Ptr ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE))
      -> IO Result)
pVkGetRefreshCycleDurationGOOGLE (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  IO ()
-> ContT
     ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE) IO ())
-> IO ()
-> ContT
     ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> SwapchainKHR
   -> ("pDisplayTimingProperties"
       ::: Ptr ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE))
   -> IO Result)
vkGetRefreshCycleDurationGOOGLEPtr FunPtr
  (Ptr Device_T
   -> SwapchainKHR
   -> ("pDisplayTimingProperties"
       ::: Ptr ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE))
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> SwapchainKHR
      -> ("pDisplayTimingProperties"
          ::: Ptr ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE))
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> SwapchainKHR
   -> ("pDisplayTimingProperties"
       ::: Ptr ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE))
   -> 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 "" "The function pointer for vkGetRefreshCycleDurationGOOGLE is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetRefreshCycleDurationGOOGLE' :: Ptr Device_T
-> SwapchainKHR
-> ("pDisplayTimingProperties"
    ::: Ptr ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE))
-> IO Result
vkGetRefreshCycleDurationGOOGLE' = FunPtr
  (Ptr Device_T
   -> SwapchainKHR
   -> ("pDisplayTimingProperties"
       ::: Ptr ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE))
   -> IO Result)
-> Ptr Device_T
-> SwapchainKHR
-> ("pDisplayTimingProperties"
    ::: Ptr ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE))
-> IO Result
mkVkGetRefreshCycleDurationGOOGLE FunPtr
  (Ptr Device_T
   -> SwapchainKHR
   -> ("pDisplayTimingProperties"
       ::: Ptr ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE))
   -> IO Result)
vkGetRefreshCycleDurationGOOGLEPtr
  "pDisplayTimingProperties"
::: Ptr ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
pPDisplayTimingProperties <- ((("pDisplayTimingProperties"
   ::: Ptr ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE))
  -> IO ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE))
 -> IO ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE))
-> ContT
     ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
     IO
     ("pDisplayTimingProperties"
      ::: Ptr ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct
  ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE) =>
(("pDisplayTimingProperties"
  ::: Ptr ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE))
 -> IO b)
-> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @RefreshCycleDurationGOOGLE)
  Result
r <- IO Result
-> ContT
     ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
     IO
     Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT
      ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
      IO
      Result)
-> IO Result
-> ContT
     ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
     IO
     Result
forall a b. (a -> b) -> a -> b
$ Ptr Device_T
-> SwapchainKHR
-> ("pDisplayTimingProperties"
    ::: Ptr ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE))
-> IO Result
vkGetRefreshCycleDurationGOOGLE' (Device -> Ptr Device_T
deviceHandle (Device
device)) (SwapchainKHR
swapchain) ("pDisplayTimingProperties"
::: Ptr ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
pPDisplayTimingProperties)
  IO ()
-> ContT
     ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE) IO ())
-> IO ()
-> ContT
     ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE) 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))
  "displayTimingProperties" ::: RefreshCycleDurationGOOGLE
pDisplayTimingProperties <- IO ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
-> ContT
     ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
     IO
     ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
 -> ContT
      ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
      IO
      ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE))
-> IO ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
-> ContT
     ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
     IO
     ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
forall a b. (a -> b) -> a -> b
$ ("pDisplayTimingProperties"
 ::: Ptr ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE))
-> IO ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @RefreshCycleDurationGOOGLE "pDisplayTimingProperties"
::: Ptr ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
pPDisplayTimingProperties
  ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
-> ContT
     ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
     IO
     ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
 -> ContT
      ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
      IO
      ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE))
-> ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
-> ContT
     ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
     IO
     ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
forall a b. (a -> b) -> a -> b
$ ("displayTimingProperties" ::: 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. If
-- @pPresentationTimingCount@ is smaller than the number of newly-available
-- timing records for the given @swapchain@,
-- 'Vulkan.Core10.Enums.Result.INCOMPLETE' will be returned instead of
-- 'Vulkan.Core10.Enums.Result.SUCCESS' to indicate that not all the
-- available values were returned.
--
-- == Valid Usage (Implicit)
--
-- -   @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   @swapchain@ /must/ be a valid
--     'Vulkan.Extensions.Handles.SwapchainKHR' handle
--
-- -   @pPresentationTimingCount@ /must/ be a valid pointer to a @uint32_t@
--     value
--
-- -   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
--
-- -   Both of @device@, and @swapchain@ /must/ have been created,
--     allocated, or retrieved from the same
--     'Vulkan.Core10.Handles.Instance'
--
-- == 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
--
-- '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 :: Device
-> SwapchainKHR
-> io
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
getPastPresentationTimingGOOGLE device :: Device
device swapchain :: SwapchainKHR
swapchain = IO
  (Result,
   "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
-> io
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (Result,
    "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
 -> io
      (Result,
       "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
-> (ContT
      (Result,
       "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
      IO
      (Result,
       "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
    -> IO
         (Result,
          "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
-> ContT
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
     IO
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
-> io
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  (Result,
   "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
  IO
  (Result,
   "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
-> IO
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   (Result,
    "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
   IO
   (Result,
    "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
 -> io
      (Result,
       "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
-> ContT
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
     IO
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
-> io
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
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 (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  IO ()
-> ContT
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
     IO
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      (Result,
       "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
      IO
      ())
-> IO ()
-> ContT
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
     IO
     ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> SwapchainKHR
   -> ("pPresentationTimingCount" ::: Ptr Word32)
   -> ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
   -> IO Result)
vkGetPastPresentationTimingGOOGLEPtr FunPtr
  (Ptr Device_T
   -> SwapchainKHR
   -> ("pPresentationTimingCount" ::: Ptr Word32)
   -> ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> SwapchainKHR
      -> ("pPresentationTimingCount" ::: Ptr Word32)
      -> ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> SwapchainKHR
   -> ("pPresentationTimingCount" ::: Ptr Word32)
   -> ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
   -> 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 "" "The function pointer for vkGetPastPresentationTimingGOOGLE is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
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 <- ((("pPresentationTimingCount" ::: Ptr Word32)
  -> IO
       (Result,
        "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
 -> IO
      (Result,
       "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
-> ContT
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
     IO
     ("pPresentationTimingCount" ::: Ptr Word32)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pPresentationTimingCount" ::: Ptr Word32)
   -> IO
        (Result,
         "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
  -> IO
       (Result,
        "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
 -> ContT
      (Result,
       "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
      IO
      ("pPresentationTimingCount" ::: Ptr Word32))
-> ((("pPresentationTimingCount" ::: Ptr Word32)
     -> IO
          (Result,
           "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
    -> IO
         (Result,
          "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
-> ContT
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
     IO
     ("pPresentationTimingCount" ::: Ptr Word32)
forall a b. (a -> b) -> a -> b
$ IO ("pPresentationTimingCount" ::: Ptr Word32)
-> (("pPresentationTimingCount" ::: Ptr Word32) -> IO ())
-> (("pPresentationTimingCount" ::: Ptr Word32)
    -> IO
         (Result,
          "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
-> IO
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pPresentationTimingCount" ::: Ptr Word32)
forall a. Int -> IO (Ptr a)
callocBytes @Word32 4) ("pPresentationTimingCount" ::: Ptr Word32) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result
-> ContT
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
     IO
     Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT
      (Result,
       "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
      IO
      Result)
-> IO Result
-> ContT
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
     IO
     Result
forall a b. (a -> b) -> a -> b
$ 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
forall a. Ptr a
nullPtr)
  IO ()
-> ContT
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
     IO
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      (Result,
       "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
      IO
      ())
-> IO ()
-> ContT
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
     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))
  Word32
pPresentationTimingCount <- IO Word32
-> ContT
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
     IO
     Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word32
 -> ContT
      (Result,
       "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
      IO
      Word32)
-> IO Word32
-> ContT
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
     IO
     Word32
forall a b. (a -> b) -> a -> b
$ ("pPresentationTimingCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPresentationTimingCount" ::: Ptr Word32
pPPresentationTimingCount
  "pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
pPPresentationTimings <- ((("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
  -> IO
       (Result,
        "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
 -> IO
      (Result,
       "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
-> ContT
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
     IO
     ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
   -> IO
        (Result,
         "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
  -> IO
       (Result,
        "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
 -> ContT
      (Result,
       "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
      IO
      ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE))
-> ((("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
     -> IO
          (Result,
           "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
    -> IO
         (Result,
          "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
-> ContT
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
     IO
     ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
forall a b. (a -> b) -> a -> b
$ IO ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
    -> IO ())
-> (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
    -> IO
         (Result,
          "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
-> IO
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int
-> IO ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
forall a. Int -> IO (Ptr a)
callocBytes @PastPresentationTimingGOOGLE ((Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPresentationTimingCount)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 40)) ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> IO ()
forall a. Ptr a -> IO ()
free
  [()]
_ <- (Int
 -> ContT
      (Result,
       "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
      IO
      ())
-> [Int]
-> ContT
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
     IO
     [()]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\i :: Int
i -> ((()
  -> IO
       (Result,
        "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
 -> IO
      (Result,
       "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
-> ContT
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
     IO
     ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((()
   -> IO
        (Result,
         "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
  -> IO
       (Result,
        "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
 -> ContT
      (Result,
       "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
      IO
      ())
-> ((()
     -> IO
          (Result,
           "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
    -> IO
         (Result,
          "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
-> ContT
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
     IO
     ()
forall a b. (a -> b) -> a -> b
$ ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> IO
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
-> IO
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
forall a b. ToCStruct a => Ptr a -> IO b -> IO b
pokeZeroCStruct ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
pPPresentationTimings ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> Int
-> "pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* 40) :: Ptr PastPresentationTimingGOOGLE) (IO
   (Result,
    "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
 -> IO
      (Result,
       "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
-> ((()
     -> IO
          (Result,
           "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
    -> IO
         (Result,
          "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
-> (()
    -> IO
         (Result,
          "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
-> IO
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((()
 -> IO
      (Result,
       "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
-> ()
-> IO
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
forall a b. (a -> b) -> a -> b
$ ())) [0..(Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPresentationTimingCount)) Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1]
  Result
r' <- IO Result
-> ContT
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
     IO
     Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT
      (Result,
       "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
      IO
      Result)
-> IO Result
-> ContT
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
     IO
     Result
forall a b. (a -> b) -> a -> b
$ 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))
  IO ()
-> ContT
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
     IO
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      (Result,
       "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
      IO
      ())
-> IO ()
-> ContT
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
     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'))
  Word32
pPresentationTimingCount' <- IO Word32
-> ContT
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
     IO
     Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word32
 -> ContT
      (Result,
       "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
      IO
      Word32)
-> IO Word32
-> ContT
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
     IO
     Word32
forall a b. (a -> b) -> a -> b
$ ("pPresentationTimingCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPresentationTimingCount" ::: Ptr Word32
pPPresentationTimingCount
  "presentationTimings" ::: Vector PastPresentationTimingGOOGLE
pPresentationTimings' <- IO ("presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
-> ContT
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
     IO
     ("presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
 -> ContT
      (Result,
       "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
      IO
      ("presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
-> IO
     ("presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
-> ContT
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
     IO
     ("presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
forall a b. (a -> b) -> a -> b
$ Int
-> (Int -> IO PastPresentationTimingGOOGLE)
-> IO
     ("presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPresentationTimingCount')) (\i :: Int
i -> ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> IO PastPresentationTimingGOOGLE
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PastPresentationTimingGOOGLE ((("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
pPPresentationTimings) ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> Int
-> "pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (40 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr PastPresentationTimingGOOGLE)))
  (Result,
 "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
-> ContT
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
     IO
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result,
  "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
 -> ContT
      (Result,
       "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
      IO
      (Result,
       "presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
-> (Result,
    "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
-> ContT
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
     IO
     (Result,
      "presentationTimings" ::: Vector PastPresentationTimingGOOGLE)
forall a b. (a -> b) -> a -> b
$ ((Result
r'), "presentationTimings" ::: Vector PastPresentationTimingGOOGLE
pPresentationTimings')


-- | VkRefreshCycleDurationGOOGLE - Structure containing the RC duration of a
-- display
--
-- = See Also
--
-- 'getRefreshCycleDurationGOOGLE'
data RefreshCycleDurationGOOGLE = RefreshCycleDurationGOOGLE
  { -- | @refreshDuration@ is the number of nanoseconds from the start of one
    -- refresh cycle to the next.
    ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
-> Word64
refreshDuration :: Word64 }
  deriving (Typeable, ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
-> ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
-> Bool
(("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
 -> ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
 -> Bool)
-> (("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
    -> ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
    -> Bool)
-> Eq ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
-> ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
-> Bool
$c/= :: ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
-> ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
-> Bool
== :: ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
-> ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
-> Bool
$c== :: ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
-> ("displayTimingProperties" ::: RefreshCycleDurationGOOGLE)
-> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (RefreshCycleDurationGOOGLE)
#endif
deriving instance Show RefreshCycleDurationGOOGLE

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

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

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

instance Zero RefreshCycleDurationGOOGLE where
  zero :: "displayTimingProperties" ::: RefreshCycleDurationGOOGLE
zero = Word64 -> "displayTimingProperties" ::: RefreshCycleDurationGOOGLE
RefreshCycleDurationGOOGLE
           Word64
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
--
-- '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
(PastPresentationTimingGOOGLE
 -> PastPresentationTimingGOOGLE -> Bool)
-> (PastPresentationTimingGOOGLE
    -> PastPresentationTimingGOOGLE -> Bool)
-> Eq PastPresentationTimingGOOGLE
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 :: PastPresentationTimingGOOGLE
-> (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
    -> IO b)
-> IO b
withCStruct x :: PastPresentationTimingGOOGLE
x f :: ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> IO b
f = Int
-> Int
-> (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
    -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 40 8 ((("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
  -> IO b)
 -> IO b)
-> (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
    -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \p :: "pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p -> ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> PastPresentationTimingGOOGLE -> IO b -> IO b
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 :: ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> PastPresentationTimingGOOGLE -> IO b -> IO b
pokeCStruct p :: "pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p PastPresentationTimingGOOGLE{..} f :: IO b
f = do
    ("pPresentationTimingCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> Int -> "pPresentationTimingCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32)) (Word32
presentID)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Word64)) (Word64
desiredPresentTime)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word64)) (Word64
actualPresentTime)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word64)) (Word64
earliestPresentTime)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Word64)) (Word64
presentMargin)
    IO b
f
  cStructSize :: Int
cStructSize = 40
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> IO b -> IO b
pokeZeroCStruct p :: "pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p f :: IO b
f = do
    ("pPresentationTimingCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> Int -> "pPresentationTimingCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Word64)) (Word64
forall a. Zero a => a
zero)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word64)) (Word64
forall a. Zero a => a
zero)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word64)) (Word64
forall a. Zero a => a
zero)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Word64)) (Word64
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct PastPresentationTimingGOOGLE where
  peekCStruct :: ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> IO PastPresentationTimingGOOGLE
peekCStruct p :: "pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p = do
    Word32
presentID <- ("pPresentationTimingCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> Int -> "pPresentationTimingCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32))
    Word64
desiredPresentTime <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek @Word64 (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Word64))
    Word64
actualPresentTime <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek @Word64 (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word64))
    Word64
earliestPresentTime <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek @Word64 (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word64))
    Word64
presentMargin <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek @Word64 (("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
p ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Word64))
    PastPresentationTimingGOOGLE -> IO PastPresentationTimingGOOGLE
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PastPresentationTimingGOOGLE -> IO PastPresentationTimingGOOGLE)
-> PastPresentationTimingGOOGLE -> IO PastPresentationTimingGOOGLE
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
_ = 40
  alignment :: PastPresentationTimingGOOGLE -> Int
alignment ~PastPresentationTimingGOOGLE
_ = 8
  peek :: ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> IO PastPresentationTimingGOOGLE
peek = ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> IO PastPresentationTimingGOOGLE
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> PastPresentationTimingGOOGLE -> IO ()
poke ptr :: "pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
ptr poked :: PastPresentationTimingGOOGLE
poked = ("pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE)
-> PastPresentationTimingGOOGLE -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pPresentationTimings" ::: Ptr PastPresentationTimingGOOGLE
ptr PastPresentationTimingGOOGLE
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero PastPresentationTimingGOOGLE where
  zero :: PastPresentationTimingGOOGLE
zero = Word32
-> Word64
-> Word64
-> Word64
-> Word64
-> PastPresentationTimingGOOGLE
PastPresentationTimingGOOGLE
           Word32
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


-- | VkPresentTimesInfoGOOGLE - The earliest time each image should be
-- presented
--
-- == Valid Usage
--
-- -   @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)
--
-- -   @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PRESENT_TIMES_INFO_GOOGLE'
--
-- -   If @pTimes@ is not @NULL@, @pTimes@ /must/ be a valid pointer to an
--     array of @swapchainCount@ 'PresentTimeGOOGLE' structures
--
-- -   @swapchainCount@ /must/ be greater than @0@
--
-- = See Also
--
-- '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 :: PresentTimesInfoGOOGLE
-> (Ptr PresentTimesInfoGOOGLE -> IO b) -> IO b
withCStruct x :: PresentTimesInfoGOOGLE
x f :: Ptr PresentTimesInfoGOOGLE -> IO b
f = Int -> Int -> (Ptr PresentTimesInfoGOOGLE -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((Ptr PresentTimesInfoGOOGLE -> IO b) -> IO b)
-> (Ptr PresentTimesInfoGOOGLE -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr PresentTimesInfoGOOGLE
p -> Ptr PresentTimesInfoGOOGLE
-> PresentTimesInfoGOOGLE -> IO b -> IO b
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 :: Ptr PresentTimesInfoGOOGLE
-> PresentTimesInfoGOOGLE -> IO b -> IO b
pokeCStruct p :: Ptr PresentTimesInfoGOOGLE
p PresentTimesInfoGOOGLE{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PresentTimesInfoGOOGLE
p Ptr PresentTimesInfoGOOGLE -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PRESENT_TIMES_INFO_GOOGLE)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PresentTimesInfoGOOGLE
p Ptr PresentTimesInfoGOOGLE -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    let pTimesLength :: Int
pTimesLength = Vector PresentTimeGOOGLE -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector PresentTimeGOOGLE -> Int)
-> Vector PresentTimeGOOGLE -> Int
forall a b. (a -> b) -> a -> b
$ (Vector PresentTimeGOOGLE
times)
    Word32
swapchainCount'' <- IO Word32 -> ContT b IO Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word32 -> ContT b IO Word32) -> IO Word32 -> ContT b IO Word32
forall a b. (a -> b) -> a -> b
$ if (Word32
swapchainCount) Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== 0
      then Word32 -> IO Word32
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32 -> IO Word32) -> Word32 -> IO Word32
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pTimesLength
      else do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pTimesLength Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== (Word32
swapchainCount) Bool -> Bool -> Bool
|| Int
pTimesLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "pTimes must be empty or have 'swapchainCount' elements" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
        Word32 -> IO Word32
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32
swapchainCount)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPresentationTimingCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PresentTimesInfoGOOGLE
p Ptr PresentTimesInfoGOOGLE
-> Int -> "pPresentationTimingCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32)) (Word32
swapchainCount'')
    Ptr PresentTimeGOOGLE
pTimes'' <- if Vector PresentTimeGOOGLE -> Bool
forall a. Vector a -> Bool
Data.Vector.null (Vector PresentTimeGOOGLE
times)
      then Ptr PresentTimeGOOGLE -> ContT b IO (Ptr PresentTimeGOOGLE)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr PresentTimeGOOGLE
forall a. Ptr a
nullPtr
      else do
        Ptr PresentTimeGOOGLE
pPTimes <- ((Ptr PresentTimeGOOGLE -> IO b) -> IO b)
-> ContT b IO (Ptr PresentTimeGOOGLE)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr PresentTimeGOOGLE -> IO b) -> IO b)
 -> ContT b IO (Ptr PresentTimeGOOGLE))
-> ((Ptr PresentTimeGOOGLE -> IO b) -> IO b)
-> ContT b IO (Ptr PresentTimeGOOGLE)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr PresentTimeGOOGLE -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @PresentTimeGOOGLE (((Vector PresentTimeGOOGLE -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector PresentTimeGOOGLE
times))) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 16) 8
        (Int -> PresentTimeGOOGLE -> ContT b IO ())
-> Vector PresentTimeGOOGLE -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: PresentTimeGOOGLE
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PresentTimeGOOGLE -> PresentTimeGOOGLE -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (Ptr PresentTimeGOOGLE
pPTimes Ptr PresentTimeGOOGLE -> Int -> Ptr PresentTimeGOOGLE
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr PresentTimeGOOGLE) (PresentTimeGOOGLE
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) ((Vector PresentTimeGOOGLE
times))
        Ptr PresentTimeGOOGLE -> ContT b IO (Ptr PresentTimeGOOGLE)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr PresentTimeGOOGLE -> ContT b IO (Ptr PresentTimeGOOGLE))
-> Ptr PresentTimeGOOGLE -> ContT b IO (Ptr PresentTimeGOOGLE)
forall a b. (a -> b) -> a -> b
$ Ptr PresentTimeGOOGLE
pPTimes
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr PresentTimeGOOGLE) -> Ptr PresentTimeGOOGLE -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PresentTimesInfoGOOGLE
p Ptr PresentTimesInfoGOOGLE -> Int -> Ptr (Ptr PresentTimeGOOGLE)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr PresentTimeGOOGLE))) Ptr PresentTimeGOOGLE
pTimes''
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = 32
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr PresentTimesInfoGOOGLE -> IO b -> IO b
pokeZeroCStruct p :: Ptr PresentTimesInfoGOOGLE
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PresentTimesInfoGOOGLE
p Ptr PresentTimesInfoGOOGLE -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PRESENT_TIMES_INFO_GOOGLE)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PresentTimesInfoGOOGLE
p Ptr PresentTimesInfoGOOGLE -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO b
f

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


-- | VkPresentTimeGOOGLE - The earliest time image should be presented
--
-- = See Also
--
-- '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@, but does not need a specific @desiredPresentTime@.
    PresentTimeGOOGLE -> Word64
desiredPresentTime :: Word64
  }
  deriving (Typeable, PresentTimeGOOGLE -> PresentTimeGOOGLE -> Bool
(PresentTimeGOOGLE -> PresentTimeGOOGLE -> Bool)
-> (PresentTimeGOOGLE -> PresentTimeGOOGLE -> Bool)
-> Eq PresentTimeGOOGLE
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 :: PresentTimeGOOGLE -> (Ptr PresentTimeGOOGLE -> IO b) -> IO b
withCStruct x :: PresentTimeGOOGLE
x f :: Ptr PresentTimeGOOGLE -> IO b
f = Int -> Int -> (Ptr PresentTimeGOOGLE -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 16 8 ((Ptr PresentTimeGOOGLE -> IO b) -> IO b)
-> (Ptr PresentTimeGOOGLE -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr PresentTimeGOOGLE
p -> Ptr PresentTimeGOOGLE -> PresentTimeGOOGLE -> IO b -> IO b
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 :: Ptr PresentTimeGOOGLE -> PresentTimeGOOGLE -> IO b -> IO b
pokeCStruct p :: Ptr PresentTimeGOOGLE
p PresentTimeGOOGLE{..} f :: IO b
f = do
    ("pPresentationTimingCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PresentTimeGOOGLE
p Ptr PresentTimeGOOGLE
-> Int -> "pPresentationTimingCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32)) (Word32
presentID)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PresentTimeGOOGLE
p Ptr PresentTimeGOOGLE -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Word64)) (Word64
desiredPresentTime)
    IO b
f
  cStructSize :: Int
cStructSize = 16
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr PresentTimeGOOGLE -> IO b -> IO b
pokeZeroCStruct p :: Ptr PresentTimeGOOGLE
p f :: IO b
f = do
    ("pPresentationTimingCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PresentTimeGOOGLE
p Ptr PresentTimeGOOGLE
-> Int -> "pPresentationTimingCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PresentTimeGOOGLE
p Ptr PresentTimeGOOGLE -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Word64)) (Word64
forall a. Zero a => a
zero)
    IO b
f

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

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

instance Zero PresentTimeGOOGLE where
  zero :: PresentTimeGOOGLE
zero = Word32 -> Word64 -> PresentTimeGOOGLE
PresentTimeGOOGLE
           Word32
forall a. Zero a => a
zero
           Word64
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 :: a
$mGOOGLE_DISPLAY_TIMING_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> 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 :: a
$mGOOGLE_DISPLAY_TIMING_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
GOOGLE_DISPLAY_TIMING_EXTENSION_NAME = "VK_GOOGLE_display_timing"