{-# language CPP #-}
-- | = Name
--
-- VK_KHR_calibrated_timestamps - device extension
--
-- == VK_KHR_calibrated_timestamps
--
-- [__Name String__]
--     @VK_KHR_calibrated_timestamps@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     544
--
-- [__Revision__]
--     1
--
-- [__Ratification Status__]
--     Ratified
--
-- [__Extension and Version Dependencies__]
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_get_physical_device_properties2 VK_KHR_get_physical_device_properties2>
--     or
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#versions-1.1 Version 1.1>
--
-- [__Contact__]
--
--     -   Daniel Rakos
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_KHR_calibrated_timestamps] @aqnuep%0A*Here describe the issue or question you have about the VK_KHR_calibrated_timestamps extension* >
--
-- [__Extension Proposal__]
--     <https://github.com/KhronosGroup/Vulkan-Docs/tree/main/proposals/VK_EXT_calibrated_timestamps.adoc VK_EXT_calibrated_timestamps>
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2023-07-12
--
-- [__IP Status__]
--     No known IP claims.
--
-- [__Contributors__]
--
--     -   Matthaeus G. Chajdas, AMD
--
--     -   Alan Harrison, AMD
--
--     -   Derrick Owens, AMD
--
--     -   Daniel Rakos, RasterGrid
--
--     -   Faith Ekstrand, Intel
--
--     -   Keith Packard, Valve
--
-- == Description
--
-- This extension provides an interface to query calibrated timestamps
-- obtained quasi simultaneously from two time domains.
--
-- == New Commands
--
-- -   'getCalibratedTimestampsKHR'
--
-- -   'getPhysicalDeviceCalibrateableTimeDomainsKHR'
--
-- == New Structures
--
-- -   'CalibratedTimestampInfoKHR'
--
-- == New Enums
--
-- -   'TimeDomainKHR'
--
-- == New Enum Constants
--
-- -   'KHR_CALIBRATED_TIMESTAMPS_EXTENSION_NAME'
--
-- -   'KHR_CALIBRATED_TIMESTAMPS_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_CALIBRATED_TIMESTAMP_INFO_KHR'
--
-- == Version History
--
-- -   Revision 1, 2023-07-12 (Daniel Rakos)
--
--     -   Initial draft.
--
-- == See Also
--
-- 'CalibratedTimestampInfoKHR', 'TimeDomainKHR',
-- 'getCalibratedTimestampsKHR',
-- 'getPhysicalDeviceCalibrateableTimeDomainsKHR'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_KHR_calibrated_timestamps Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_KHR_calibrated_timestamps  ( getPhysicalDeviceCalibrateableTimeDomainsKHR
                                                       , getCalibratedTimestampsKHR
                                                       , CalibratedTimestampInfoKHR(..)
                                                       , TimeDomainKHR( TIME_DOMAIN_DEVICE_KHR
                                                                      , TIME_DOMAIN_CLOCK_MONOTONIC_KHR
                                                                      , TIME_DOMAIN_CLOCK_MONOTONIC_RAW_KHR
                                                                      , TIME_DOMAIN_QUERY_PERFORMANCE_COUNTER_KHR
                                                                      , ..
                                                                      )
                                                       , KHR_CALIBRATED_TIMESTAMPS_SPEC_VERSION
                                                       , pattern KHR_CALIBRATED_TIMESTAMPS_SPEC_VERSION
                                                       , KHR_CALIBRATED_TIMESTAMPS_EXTENSION_NAME
                                                       , pattern KHR_CALIBRATED_TIMESTAMPS_EXTENSION_NAME
                                                       ) where

import Vulkan.Internal.Utils (enumReadPrec)
import Vulkan.Internal.Utils (enumShowsPrec)
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import GHC.Show (showsPrec)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero)
import Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Data.Int (Int32)
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import GHC.Read (Read(readPrec))
import GHC.Show (Show(showsPrec))
import Data.Word (Word32)
import Data.Word (Word64)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import 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(pVkGetCalibratedTimestampsKHR))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Dynamic (InstanceCmds(pVkGetPhysicalDeviceCalibrateableTimeDomainsKHR))
import Vulkan.Core10.Handles (PhysicalDevice)
import Vulkan.Core10.Handles (PhysicalDevice(..))
import Vulkan.Core10.Handles (PhysicalDevice(PhysicalDevice))
import Vulkan.Core10.Handles (PhysicalDevice_T)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_CALIBRATED_TIMESTAMP_INFO_KHR))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetPhysicalDeviceCalibrateableTimeDomainsKHR
  :: FunPtr (Ptr PhysicalDevice_T -> Ptr Word32 -> Ptr TimeDomainKHR -> IO Result) -> Ptr PhysicalDevice_T -> Ptr Word32 -> Ptr TimeDomainKHR -> IO Result

-- | vkGetPhysicalDeviceCalibrateableTimeDomainsKHR - Query calibrateable
-- time domains
--
-- = Description
--
-- If @pTimeDomains@ is @NULL@, then the number of calibrateable time
-- domains supported for the given @physicalDevice@ is returned in
-- @pTimeDomainCount@. Otherwise, @pTimeDomainCount@ /must/ point to a
-- variable set by the user to the number of elements in the @pTimeDomains@
-- array, and on return the variable is overwritten with the number of
-- values actually written to @pTimeDomains@. If the value of
-- @pTimeDomainCount@ is less than the number of calibrateable time domains
-- supported, at most @pTimeDomainCount@ values will be written to
-- @pTimeDomains@, and 'Vulkan.Core10.Enums.Result.INCOMPLETE' will be
-- returned instead of 'Vulkan.Core10.Enums.Result.SUCCESS', to indicate
-- that not all the available time domains were returned.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkGetPhysicalDeviceCalibrateableTimeDomainsKHR-physicalDevice-parameter#
--     @physicalDevice@ /must/ be a valid
--     'Vulkan.Core10.Handles.PhysicalDevice' handle
--
-- -   #VUID-vkGetPhysicalDeviceCalibrateableTimeDomainsKHR-pTimeDomainCount-parameter#
--     @pTimeDomainCount@ /must/ be a valid pointer to a @uint32_t@ value
--
-- -   #VUID-vkGetPhysicalDeviceCalibrateableTimeDomainsKHR-pTimeDomains-parameter#
--     If the value referenced by @pTimeDomainCount@ is not @0@, and
--     @pTimeDomains@ is not @NULL@, @pTimeDomains@ /must/ be a valid
--     pointer to an array of @pTimeDomainCount@ 'TimeDomainKHR' values
--
-- == 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_OUT_OF_DEVICE_MEMORY'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_calibrated_timestamps VK_EXT_calibrated_timestamps>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_calibrated_timestamps VK_KHR_calibrated_timestamps>,
-- 'Vulkan.Core10.Handles.PhysicalDevice', 'TimeDomainKHR'
getPhysicalDeviceCalibrateableTimeDomainsKHR :: forall io
                                              . (MonadIO io)
                                             => -- | @physicalDevice@ is the physical device from which to query the set of
                                                -- calibrateable time domains.
                                                PhysicalDevice
                                             -> io (Result, ("timeDomains" ::: Vector TimeDomainKHR))
getPhysicalDeviceCalibrateableTimeDomainsKHR :: forall (io :: * -> *).
MonadIO io =>
PhysicalDevice
-> io (Result, "timeDomains" ::: Vector TimeDomainKHR)
getPhysicalDeviceCalibrateableTimeDomainsKHR PhysicalDevice
physicalDevice = IO (Result, "timeDomains" ::: Vector TimeDomainKHR)
-> io (Result, "timeDomains" ::: Vector TimeDomainKHR)
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result, "timeDomains" ::: Vector TimeDomainKHR)
 -> io (Result, "timeDomains" ::: Vector TimeDomainKHR))
-> (ContT
      (Result, "timeDomains" ::: Vector TimeDomainKHR)
      IO
      (Result, "timeDomains" ::: Vector TimeDomainKHR)
    -> IO (Result, "timeDomains" ::: Vector TimeDomainKHR))
-> ContT
     (Result, "timeDomains" ::: Vector TimeDomainKHR)
     IO
     (Result, "timeDomains" ::: Vector TimeDomainKHR)
-> io (Result, "timeDomains" ::: Vector TimeDomainKHR)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  (Result, "timeDomains" ::: Vector TimeDomainKHR)
  IO
  (Result, "timeDomains" ::: Vector TimeDomainKHR)
-> IO (Result, "timeDomains" ::: Vector TimeDomainKHR)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   (Result, "timeDomains" ::: Vector TimeDomainKHR)
   IO
   (Result, "timeDomains" ::: Vector TimeDomainKHR)
 -> io (Result, "timeDomains" ::: Vector TimeDomainKHR))
-> ContT
     (Result, "timeDomains" ::: Vector TimeDomainKHR)
     IO
     (Result, "timeDomains" ::: Vector TimeDomainKHR)
-> io (Result, "timeDomains" ::: Vector TimeDomainKHR)
forall a b. (a -> b) -> a -> b
$ do
  let vkGetPhysicalDeviceCalibrateableTimeDomainsKHRPtr :: FunPtr
  (Ptr PhysicalDevice_T
   -> Ptr Word32 -> Ptr TimeDomainKHR -> IO Result)
vkGetPhysicalDeviceCalibrateableTimeDomainsKHRPtr = InstanceCmds
-> FunPtr
     (Ptr PhysicalDevice_T
      -> Ptr Word32 -> Ptr TimeDomainKHR -> IO Result)
pVkGetPhysicalDeviceCalibrateableTimeDomainsKHR (case PhysicalDevice
physicalDevice of PhysicalDevice{InstanceCmds
instanceCmds :: InstanceCmds
$sel:instanceCmds:PhysicalDevice :: PhysicalDevice -> InstanceCmds
instanceCmds} -> InstanceCmds
instanceCmds)
  IO ()
-> ContT (Result, "timeDomains" ::: Vector TimeDomainKHR) IO ()
forall (m :: * -> *) a.
Monad m =>
m a -> ContT (Result, "timeDomains" ::: Vector TimeDomainKHR) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT (Result, "timeDomains" ::: Vector TimeDomainKHR) IO ())
-> IO ()
-> ContT (Result, "timeDomains" ::: Vector TimeDomainKHR) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr PhysicalDevice_T
   -> Ptr Word32 -> Ptr TimeDomainKHR -> IO Result)
vkGetPhysicalDeviceCalibrateableTimeDomainsKHRPtr FunPtr
  (Ptr PhysicalDevice_T
   -> Ptr Word32 -> Ptr TimeDomainKHR -> IO Result)
-> FunPtr
     (Ptr PhysicalDevice_T
      -> Ptr Word32 -> Ptr TimeDomainKHR -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr PhysicalDevice_T
   -> Ptr Word32 -> Ptr TimeDomainKHR -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetPhysicalDeviceCalibrateableTimeDomainsKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetPhysicalDeviceCalibrateableTimeDomainsKHR' :: Ptr PhysicalDevice_T
-> Ptr Word32 -> Ptr TimeDomainKHR -> IO Result
vkGetPhysicalDeviceCalibrateableTimeDomainsKHR' = FunPtr
  (Ptr PhysicalDevice_T
   -> Ptr Word32 -> Ptr TimeDomainKHR -> IO Result)
-> Ptr PhysicalDevice_T
-> Ptr Word32
-> Ptr TimeDomainKHR
-> IO Result
mkVkGetPhysicalDeviceCalibrateableTimeDomainsKHR FunPtr
  (Ptr PhysicalDevice_T
   -> Ptr Word32 -> Ptr TimeDomainKHR -> IO Result)
vkGetPhysicalDeviceCalibrateableTimeDomainsKHRPtr
  let physicalDevice' :: Ptr PhysicalDevice_T
physicalDevice' = PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice)
  Ptr Word32
pPTimeDomainCount <- ((Ptr Word32
  -> IO (Result, "timeDomains" ::: Vector TimeDomainKHR))
 -> IO (Result, "timeDomains" ::: Vector TimeDomainKHR))
-> ContT
     (Result, "timeDomains" ::: Vector TimeDomainKHR) IO (Ptr Word32)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Word32
   -> IO (Result, "timeDomains" ::: Vector TimeDomainKHR))
  -> IO (Result, "timeDomains" ::: Vector TimeDomainKHR))
 -> ContT
      (Result, "timeDomains" ::: Vector TimeDomainKHR) IO (Ptr Word32))
-> ((Ptr Word32
     -> IO (Result, "timeDomains" ::: Vector TimeDomainKHR))
    -> IO (Result, "timeDomains" ::: Vector TimeDomainKHR))
-> ContT
     (Result, "timeDomains" ::: Vector TimeDomainKHR) IO (Ptr Word32)
forall a b. (a -> b) -> a -> b
$ IO (Ptr Word32)
-> (Ptr Word32 -> IO ())
-> (Ptr Word32
    -> IO (Result, "timeDomains" ::: Vector TimeDomainKHR))
-> IO (Result, "timeDomains" ::: Vector TimeDomainKHR)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @Word32 Int
4) Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result
-> ContT (Result, "timeDomains" ::: Vector TimeDomainKHR) IO Result
forall (m :: * -> *) a.
Monad m =>
m a -> ContT (Result, "timeDomains" ::: Vector TimeDomainKHR) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT
      (Result, "timeDomains" ::: Vector TimeDomainKHR) IO Result)
-> IO Result
-> ContT (Result, "timeDomains" ::: Vector TimeDomainKHR) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPhysicalDeviceCalibrateableTimeDomainsKHR" (Ptr PhysicalDevice_T
-> Ptr Word32 -> Ptr TimeDomainKHR -> IO Result
vkGetPhysicalDeviceCalibrateableTimeDomainsKHR'
                                                                                   Ptr PhysicalDevice_T
physicalDevice'
                                                                                   (Ptr Word32
pPTimeDomainCount)
                                                                                   (Ptr TimeDomainKHR
forall a. Ptr a
nullPtr))
  IO ()
-> ContT (Result, "timeDomains" ::: Vector TimeDomainKHR) IO ()
forall (m :: * -> *) a.
Monad m =>
m a -> ContT (Result, "timeDomains" ::: Vector TimeDomainKHR) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT (Result, "timeDomains" ::: Vector TimeDomainKHR) IO ())
-> IO ()
-> ContT (Result, "timeDomains" ::: Vector TimeDomainKHR) 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
pTimeDomainCount <- IO Word32
-> ContT (Result, "timeDomains" ::: Vector TimeDomainKHR) IO Word32
forall (m :: * -> *) a.
Monad m =>
m a -> ContT (Result, "timeDomains" ::: Vector TimeDomainKHR) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word32
 -> ContT
      (Result, "timeDomains" ::: Vector TimeDomainKHR) IO Word32)
-> IO Word32
-> ContT (Result, "timeDomains" ::: Vector TimeDomainKHR) IO Word32
forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Word32 Ptr Word32
pPTimeDomainCount
  Ptr TimeDomainKHR
pPTimeDomains <- ((Ptr TimeDomainKHR
  -> IO (Result, "timeDomains" ::: Vector TimeDomainKHR))
 -> IO (Result, "timeDomains" ::: Vector TimeDomainKHR))
-> ContT
     (Result, "timeDomains" ::: Vector TimeDomainKHR)
     IO
     (Ptr TimeDomainKHR)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr TimeDomainKHR
   -> IO (Result, "timeDomains" ::: Vector TimeDomainKHR))
  -> IO (Result, "timeDomains" ::: Vector TimeDomainKHR))
 -> ContT
      (Result, "timeDomains" ::: Vector TimeDomainKHR)
      IO
      (Ptr TimeDomainKHR))
-> ((Ptr TimeDomainKHR
     -> IO (Result, "timeDomains" ::: Vector TimeDomainKHR))
    -> IO (Result, "timeDomains" ::: Vector TimeDomainKHR))
-> ContT
     (Result, "timeDomains" ::: Vector TimeDomainKHR)
     IO
     (Ptr TimeDomainKHR)
forall a b. (a -> b) -> a -> b
$ IO (Ptr TimeDomainKHR)
-> (Ptr TimeDomainKHR -> IO ())
-> (Ptr TimeDomainKHR
    -> IO (Result, "timeDomains" ::: Vector TimeDomainKHR))
-> IO (Result, "timeDomains" ::: Vector TimeDomainKHR)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @TimeDomainKHR ((Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pTimeDomainCount)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4)) Ptr TimeDomainKHR -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r' <- IO Result
-> ContT (Result, "timeDomains" ::: Vector TimeDomainKHR) IO Result
forall (m :: * -> *) a.
Monad m =>
m a -> ContT (Result, "timeDomains" ::: Vector TimeDomainKHR) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT
      (Result, "timeDomains" ::: Vector TimeDomainKHR) IO Result)
-> IO Result
-> ContT (Result, "timeDomains" ::: Vector TimeDomainKHR) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPhysicalDeviceCalibrateableTimeDomainsKHR" (Ptr PhysicalDevice_T
-> Ptr Word32 -> Ptr TimeDomainKHR -> IO Result
vkGetPhysicalDeviceCalibrateableTimeDomainsKHR'
                                                                                    Ptr PhysicalDevice_T
physicalDevice'
                                                                                    (Ptr Word32
pPTimeDomainCount)
                                                                                    (Ptr TimeDomainKHR
pPTimeDomains))
  IO ()
-> ContT (Result, "timeDomains" ::: Vector TimeDomainKHR) IO ()
forall (m :: * -> *) a.
Monad m =>
m a -> ContT (Result, "timeDomains" ::: Vector TimeDomainKHR) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT (Result, "timeDomains" ::: Vector TimeDomainKHR) IO ())
-> IO ()
-> ContT (Result, "timeDomains" ::: Vector TimeDomainKHR) 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
pTimeDomainCount' <- IO Word32
-> ContT (Result, "timeDomains" ::: Vector TimeDomainKHR) IO Word32
forall (m :: * -> *) a.
Monad m =>
m a -> ContT (Result, "timeDomains" ::: Vector TimeDomainKHR) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word32
 -> ContT
      (Result, "timeDomains" ::: Vector TimeDomainKHR) IO Word32)
-> IO Word32
-> ContT (Result, "timeDomains" ::: Vector TimeDomainKHR) IO Word32
forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Word32 Ptr Word32
pPTimeDomainCount
  "timeDomains" ::: Vector TimeDomainKHR
pTimeDomains' <- IO ("timeDomains" ::: Vector TimeDomainKHR)
-> ContT
     (Result, "timeDomains" ::: Vector TimeDomainKHR)
     IO
     ("timeDomains" ::: Vector TimeDomainKHR)
forall (m :: * -> *) a.
Monad m =>
m a -> ContT (Result, "timeDomains" ::: Vector TimeDomainKHR) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("timeDomains" ::: Vector TimeDomainKHR)
 -> ContT
      (Result, "timeDomains" ::: Vector TimeDomainKHR)
      IO
      ("timeDomains" ::: Vector TimeDomainKHR))
-> IO ("timeDomains" ::: Vector TimeDomainKHR)
-> ContT
     (Result, "timeDomains" ::: Vector TimeDomainKHR)
     IO
     ("timeDomains" ::: Vector TimeDomainKHR)
forall a b. (a -> b) -> a -> b
$ Int
-> (Int -> IO TimeDomainKHR)
-> IO ("timeDomains" ::: Vector TimeDomainKHR)
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
pTimeDomainCount')) (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @TimeDomainKHR ((Ptr TimeDomainKHR
pPTimeDomains Ptr TimeDomainKHR -> Int -> Ptr TimeDomainKHR
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr TimeDomainKHR)))
  (Result, "timeDomains" ::: Vector TimeDomainKHR)
-> ContT
     (Result, "timeDomains" ::: Vector TimeDomainKHR)
     IO
     (Result, "timeDomains" ::: Vector TimeDomainKHR)
forall a.
a -> ContT (Result, "timeDomains" ::: Vector TimeDomainKHR) IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result, "timeDomains" ::: Vector TimeDomainKHR)
 -> ContT
      (Result, "timeDomains" ::: Vector TimeDomainKHR)
      IO
      (Result, "timeDomains" ::: Vector TimeDomainKHR))
-> (Result, "timeDomains" ::: Vector TimeDomainKHR)
-> ContT
     (Result, "timeDomains" ::: Vector TimeDomainKHR)
     IO
     (Result, "timeDomains" ::: Vector TimeDomainKHR)
forall a b. (a -> b) -> a -> b
$ ((Result
r'), "timeDomains" ::: Vector TimeDomainKHR
pTimeDomains')


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetCalibratedTimestampsKHR
  :: FunPtr (Ptr Device_T -> Word32 -> Ptr CalibratedTimestampInfoKHR -> Ptr Word64 -> Ptr Word64 -> IO Result) -> Ptr Device_T -> Word32 -> Ptr CalibratedTimestampInfoKHR -> Ptr Word64 -> Ptr Word64 -> IO Result

-- | vkGetCalibratedTimestampsKHR - Query calibrated timestamps
--
-- = Description
--
-- Note
--
-- The maximum deviation /may/ vary between calls to
-- 'getCalibratedTimestampsKHR' even for the same set of time domains due
-- to implementation and platform specific reasons. It is the application’s
-- responsibility to assess whether the returned maximum deviation makes
-- the timestamp values suitable for any particular purpose and /can/
-- choose to re-issue the timestamp calibration call pursuing a lower
-- deviation value.
--
-- Calibrated timestamp values /can/ be extrapolated to estimate future
-- coinciding timestamp values, however, depending on the nature of the
-- time domains and other properties of the platform extrapolating values
-- over a sufficiently long period of time /may/ no longer be accurate
-- enough to fit any particular purpose, so applications are expected to
-- re-calibrate the timestamps on a regular basis.
--
-- == Valid Usage
--
-- -   #VUID-vkGetCalibratedTimestampsEXT-timeDomain-09246# The
--     @timeDomain@ value of each
--     'Vulkan.Extensions.VK_EXT_calibrated_timestamps.CalibratedTimestampInfoEXT'
--     in @pTimestampInfos@ /must/ be unique
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkGetCalibratedTimestampsKHR-device-parameter# @device@ /must/
--     be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkGetCalibratedTimestampsKHR-pTimestampInfos-parameter#
--     @pTimestampInfos@ /must/ be a valid pointer to an array of
--     @timestampCount@ valid 'CalibratedTimestampInfoKHR' structures
--
-- -   #VUID-vkGetCalibratedTimestampsKHR-pTimestamps-parameter#
--     @pTimestamps@ /must/ be a valid pointer to an array of
--     @timestampCount@ @uint64_t@ values
--
-- -   #VUID-vkGetCalibratedTimestampsKHR-pMaxDeviation-parameter#
--     @pMaxDeviation@ /must/ be a valid pointer to a @uint64_t@ value
--
-- -   #VUID-vkGetCalibratedTimestampsKHR-timestampCount-arraylength#
--     @timestampCount@ /must/ be greater than @0@
--
-- == 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_OUT_OF_DEVICE_MEMORY'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_calibrated_timestamps VK_EXT_calibrated_timestamps>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_calibrated_timestamps VK_KHR_calibrated_timestamps>,
-- 'CalibratedTimestampInfoKHR', 'Vulkan.Core10.Handles.Device'
getCalibratedTimestampsKHR :: forall io
                            . (MonadIO io)
                           => -- | @device@ is the logical device used to perform the query.
                              Device
                           -> -- | @pTimestampInfos@ is a pointer to an array of @timestampCount@
                              -- 'CalibratedTimestampInfoKHR' structures, describing the time domains the
                              -- calibrated timestamps should be captured from.
                              ("timestampInfos" ::: Vector CalibratedTimestampInfoKHR)
                           -> io (("timestamps" ::: Vector Word64), ("maxDeviation" ::: Word64))
getCalibratedTimestampsKHR :: forall (io :: * -> *).
MonadIO io =>
Device
-> ("timestampInfos" ::: Vector CalibratedTimestampInfoKHR)
-> io ("timestamps" ::: Vector Word64, Word64)
getCalibratedTimestampsKHR Device
device "timestampInfos" ::: Vector CalibratedTimestampInfoKHR
timestampInfos = IO ("timestamps" ::: Vector Word64, Word64)
-> io ("timestamps" ::: Vector Word64, Word64)
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ("timestamps" ::: Vector Word64, Word64)
 -> io ("timestamps" ::: Vector Word64, Word64))
-> (ContT
      ("timestamps" ::: Vector Word64, Word64)
      IO
      ("timestamps" ::: Vector Word64, Word64)
    -> IO ("timestamps" ::: Vector Word64, Word64))
-> ContT
     ("timestamps" ::: Vector Word64, Word64)
     IO
     ("timestamps" ::: Vector Word64, Word64)
-> io ("timestamps" ::: Vector Word64, Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  ("timestamps" ::: Vector Word64, Word64)
  IO
  ("timestamps" ::: Vector Word64, Word64)
-> IO ("timestamps" ::: Vector Word64, Word64)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   ("timestamps" ::: Vector Word64, Word64)
   IO
   ("timestamps" ::: Vector Word64, Word64)
 -> io ("timestamps" ::: Vector Word64, Word64))
-> ContT
     ("timestamps" ::: Vector Word64, Word64)
     IO
     ("timestamps" ::: Vector Word64, Word64)
-> io ("timestamps" ::: Vector Word64, Word64)
forall a b. (a -> b) -> a -> b
$ do
  let vkGetCalibratedTimestampsKHRPtr :: FunPtr
  (Ptr Device_T
   -> Word32
   -> Ptr CalibratedTimestampInfoKHR
   -> Ptr Word64
   -> Ptr Word64
   -> IO Result)
vkGetCalibratedTimestampsKHRPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> Word32
      -> Ptr CalibratedTimestampInfoKHR
      -> Ptr Word64
      -> Ptr Word64
      -> IO Result)
pVkGetCalibratedTimestampsKHR (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT ("timestamps" ::: Vector Word64, Word64) IO ()
forall (m :: * -> *) a.
Monad m =>
m a -> ContT ("timestamps" ::: Vector Word64, Word64) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ("timestamps" ::: Vector Word64, Word64) IO ())
-> IO () -> ContT ("timestamps" ::: Vector Word64, Word64) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> Word32
   -> Ptr CalibratedTimestampInfoKHR
   -> Ptr Word64
   -> Ptr Word64
   -> IO Result)
vkGetCalibratedTimestampsKHRPtr FunPtr
  (Ptr Device_T
   -> Word32
   -> Ptr CalibratedTimestampInfoKHR
   -> Ptr Word64
   -> Ptr Word64
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> Word32
      -> Ptr CalibratedTimestampInfoKHR
      -> Ptr Word64
      -> Ptr Word64
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> Word32
   -> Ptr CalibratedTimestampInfoKHR
   -> Ptr Word64
   -> Ptr Word64
   -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetCalibratedTimestampsKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetCalibratedTimestampsKHR' :: Ptr Device_T
-> Word32
-> Ptr CalibratedTimestampInfoKHR
-> Ptr Word64
-> Ptr Word64
-> IO Result
vkGetCalibratedTimestampsKHR' = FunPtr
  (Ptr Device_T
   -> Word32
   -> Ptr CalibratedTimestampInfoKHR
   -> Ptr Word64
   -> Ptr Word64
   -> IO Result)
-> Ptr Device_T
-> Word32
-> Ptr CalibratedTimestampInfoKHR
-> Ptr Word64
-> Ptr Word64
-> IO Result
mkVkGetCalibratedTimestampsKHR FunPtr
  (Ptr Device_T
   -> Word32
   -> Ptr CalibratedTimestampInfoKHR
   -> Ptr Word64
   -> Ptr Word64
   -> IO Result)
vkGetCalibratedTimestampsKHRPtr
  Ptr CalibratedTimestampInfoKHR
pPTimestampInfos <- ((Ptr CalibratedTimestampInfoKHR
  -> IO ("timestamps" ::: Vector Word64, Word64))
 -> IO ("timestamps" ::: Vector Word64, Word64))
-> ContT
     ("timestamps" ::: Vector Word64, Word64)
     IO
     (Ptr CalibratedTimestampInfoKHR)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr CalibratedTimestampInfoKHR
   -> IO ("timestamps" ::: Vector Word64, Word64))
  -> IO ("timestamps" ::: Vector Word64, Word64))
 -> ContT
      ("timestamps" ::: Vector Word64, Word64)
      IO
      (Ptr CalibratedTimestampInfoKHR))
-> ((Ptr CalibratedTimestampInfoKHR
     -> IO ("timestamps" ::: Vector Word64, Word64))
    -> IO ("timestamps" ::: Vector Word64, Word64))
-> ContT
     ("timestamps" ::: Vector Word64, Word64)
     IO
     (Ptr CalibratedTimestampInfoKHR)
forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @CalibratedTimestampInfoKHR ((("timestampInfos" ::: Vector CalibratedTimestampInfoKHR) -> Int
forall a. Vector a -> Int
Data.Vector.length ("timestampInfos" ::: Vector CalibratedTimestampInfoKHR
timestampInfos)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
24)
  IO () -> ContT ("timestamps" ::: Vector Word64, Word64) IO ()
forall (m :: * -> *) a.
Monad m =>
m a -> ContT ("timestamps" ::: Vector Word64, Word64) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ("timestamps" ::: Vector Word64, Word64) IO ())
-> IO () -> ContT ("timestamps" ::: Vector Word64, Word64) IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> CalibratedTimestampInfoKHR -> IO ())
-> ("timestampInfos" ::: Vector CalibratedTimestampInfoKHR)
-> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i CalibratedTimestampInfoKHR
e -> Ptr CalibratedTimestampInfoKHR
-> CalibratedTimestampInfoKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr CalibratedTimestampInfoKHR
pPTimestampInfos Ptr CalibratedTimestampInfoKHR
-> Int -> Ptr CalibratedTimestampInfoKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
24 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr CalibratedTimestampInfoKHR) (CalibratedTimestampInfoKHR
e)) ("timestampInfos" ::: Vector CalibratedTimestampInfoKHR
timestampInfos)
  Ptr Word64
pPTimestamps <- ((Ptr Word64 -> IO ("timestamps" ::: Vector Word64, Word64))
 -> IO ("timestamps" ::: Vector Word64, Word64))
-> ContT ("timestamps" ::: Vector Word64, Word64) IO (Ptr Word64)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Word64 -> IO ("timestamps" ::: Vector Word64, Word64))
  -> IO ("timestamps" ::: Vector Word64, Word64))
 -> ContT ("timestamps" ::: Vector Word64, Word64) IO (Ptr Word64))
-> ((Ptr Word64 -> IO ("timestamps" ::: Vector Word64, Word64))
    -> IO ("timestamps" ::: Vector Word64, Word64))
-> ContT ("timestamps" ::: Vector Word64, Word64) IO (Ptr Word64)
forall a b. (a -> b) -> a -> b
$ IO (Ptr Word64)
-> (Ptr Word64 -> IO ())
-> (Ptr Word64 -> IO ("timestamps" ::: Vector Word64, Word64))
-> IO ("timestamps" ::: Vector Word64, Word64)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @Word64 ((Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (("timestampInfos" ::: Vector CalibratedTimestampInfoKHR) -> Int
forall a. Vector a -> Int
Data.Vector.length (("timestampInfos" ::: Vector CalibratedTimestampInfoKHR) -> Int)
-> ("timestampInfos" ::: Vector CalibratedTimestampInfoKHR) -> Int
forall a b. (a -> b) -> a -> b
$ ("timestampInfos" ::: Vector CalibratedTimestampInfoKHR
timestampInfos)) :: Word32))) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)) Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
free
  Ptr Word64
pPMaxDeviation <- ((Ptr Word64 -> IO ("timestamps" ::: Vector Word64, Word64))
 -> IO ("timestamps" ::: Vector Word64, Word64))
-> ContT ("timestamps" ::: Vector Word64, Word64) IO (Ptr Word64)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Word64 -> IO ("timestamps" ::: Vector Word64, Word64))
  -> IO ("timestamps" ::: Vector Word64, Word64))
 -> ContT ("timestamps" ::: Vector Word64, Word64) IO (Ptr Word64))
-> ((Ptr Word64 -> IO ("timestamps" ::: Vector Word64, Word64))
    -> IO ("timestamps" ::: Vector Word64, Word64))
-> ContT ("timestamps" ::: Vector Word64, Word64) IO (Ptr Word64)
forall a b. (a -> b) -> a -> b
$ IO (Ptr Word64)
-> (Ptr Word64 -> IO ())
-> (Ptr Word64 -> IO ("timestamps" ::: Vector Word64, Word64))
-> IO ("timestamps" ::: Vector Word64, Word64)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @Word64 Int
8) Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result
-> ContT ("timestamps" ::: Vector Word64, Word64) IO Result
forall (m :: * -> *) a.
Monad m =>
m a -> ContT ("timestamps" ::: Vector Word64, Word64) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT ("timestamps" ::: Vector Word64, Word64) IO Result)
-> IO Result
-> ContT ("timestamps" ::: Vector Word64, Word64) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetCalibratedTimestampsKHR" (Ptr Device_T
-> Word32
-> Ptr CalibratedTimestampInfoKHR
-> Ptr Word64
-> Ptr Word64
-> IO Result
vkGetCalibratedTimestampsKHR'
                                                                 (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                                 ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (("timestampInfos" ::: Vector CalibratedTimestampInfoKHR) -> Int
forall a. Vector a -> Int
Data.Vector.length (("timestampInfos" ::: Vector CalibratedTimestampInfoKHR) -> Int)
-> ("timestampInfos" ::: Vector CalibratedTimestampInfoKHR) -> Int
forall a b. (a -> b) -> a -> b
$ ("timestampInfos" ::: Vector CalibratedTimestampInfoKHR
timestampInfos)) :: Word32))
                                                                 (Ptr CalibratedTimestampInfoKHR
pPTimestampInfos)
                                                                 (Ptr Word64
pPTimestamps)
                                                                 (Ptr Word64
pPMaxDeviation))
  IO () -> ContT ("timestamps" ::: Vector Word64, Word64) IO ()
forall (m :: * -> *) a.
Monad m =>
m a -> ContT ("timestamps" ::: Vector Word64, Word64) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ("timestamps" ::: Vector Word64, Word64) IO ())
-> IO () -> ContT ("timestamps" ::: Vector Word64, Word64) 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))
  "timestamps" ::: Vector Word64
pTimestamps <- IO ("timestamps" ::: Vector Word64)
-> ContT
     ("timestamps" ::: Vector Word64, Word64)
     IO
     ("timestamps" ::: Vector Word64)
forall (m :: * -> *) a.
Monad m =>
m a -> ContT ("timestamps" ::: Vector Word64, Word64) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("timestamps" ::: Vector Word64)
 -> ContT
      ("timestamps" ::: Vector Word64, Word64)
      IO
      ("timestamps" ::: Vector Word64))
-> IO ("timestamps" ::: Vector Word64)
-> ContT
     ("timestamps" ::: Vector Word64, Word64)
     IO
     ("timestamps" ::: Vector Word64)
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> IO Word64) -> IO ("timestamps" ::: Vector Word64)
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 ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (("timestampInfos" ::: Vector CalibratedTimestampInfoKHR) -> Int
forall a. Vector a -> Int
Data.Vector.length (("timestampInfos" ::: Vector CalibratedTimestampInfoKHR) -> Int)
-> ("timestampInfos" ::: Vector CalibratedTimestampInfoKHR) -> Int
forall a b. (a -> b) -> a -> b
$ ("timestampInfos" ::: Vector CalibratedTimestampInfoKHR
timestampInfos)) :: Word32))) (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr Word64
pPTimestamps Ptr Word64 -> Int -> Ptr Word64
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word64)))
  Word64
pMaxDeviation <- IO Word64
-> ContT ("timestamps" ::: Vector Word64, Word64) IO Word64
forall (m :: * -> *) a.
Monad m =>
m a -> ContT ("timestamps" ::: Vector Word64, Word64) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word64
 -> ContT ("timestamps" ::: Vector Word64, Word64) IO Word64)
-> IO Word64
-> ContT ("timestamps" ::: Vector Word64, Word64) IO Word64
forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Word64 Ptr Word64
pPMaxDeviation
  ("timestamps" ::: Vector Word64, Word64)
-> ContT
     ("timestamps" ::: Vector Word64, Word64)
     IO
     ("timestamps" ::: Vector Word64, Word64)
forall a. a -> ContT ("timestamps" ::: Vector Word64, Word64) IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("timestamps" ::: Vector Word64, Word64)
 -> ContT
      ("timestamps" ::: Vector Word64, Word64)
      IO
      ("timestamps" ::: Vector Word64, Word64))
-> ("timestamps" ::: Vector Word64, Word64)
-> ContT
     ("timestamps" ::: Vector Word64, Word64)
     IO
     ("timestamps" ::: Vector Word64, Word64)
forall a b. (a -> b) -> a -> b
$ ("timestamps" ::: Vector Word64
pTimestamps, Word64
pMaxDeviation)


-- | VkCalibratedTimestampInfoKHR - Structure specifying the input parameters
-- of a calibrated timestamp query
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_calibrated_timestamps VK_EXT_calibrated_timestamps>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_calibrated_timestamps VK_KHR_calibrated_timestamps>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'TimeDomainKHR',
-- 'Vulkan.Extensions.VK_EXT_calibrated_timestamps.getCalibratedTimestampsEXT',
-- 'getCalibratedTimestampsKHR'
data CalibratedTimestampInfoKHR = CalibratedTimestampInfoKHR
  { -- | @timeDomain@ is a 'TimeDomainKHR' value specifying the time domain from
    -- which the calibrated timestamp value should be returned.
    --
    -- #VUID-VkCalibratedTimestampInfoEXT-timeDomain-02354# @timeDomain@ /must/
    -- be one of the 'TimeDomainKHR' values returned by
    -- 'getPhysicalDeviceCalibrateableTimeDomainsKHR'
    --
    -- #VUID-VkCalibratedTimestampInfoKHR-timeDomain-parameter# @timeDomain@
    -- /must/ be a valid 'TimeDomainKHR' value
    CalibratedTimestampInfoKHR -> TimeDomainKHR
timeDomain :: TimeDomainKHR }
  deriving (Typeable, CalibratedTimestampInfoKHR -> CalibratedTimestampInfoKHR -> Bool
(CalibratedTimestampInfoKHR -> CalibratedTimestampInfoKHR -> Bool)
-> (CalibratedTimestampInfoKHR
    -> CalibratedTimestampInfoKHR -> Bool)
-> Eq CalibratedTimestampInfoKHR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CalibratedTimestampInfoKHR -> CalibratedTimestampInfoKHR -> Bool
== :: CalibratedTimestampInfoKHR -> CalibratedTimestampInfoKHR -> Bool
$c/= :: CalibratedTimestampInfoKHR -> CalibratedTimestampInfoKHR -> Bool
/= :: CalibratedTimestampInfoKHR -> CalibratedTimestampInfoKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CalibratedTimestampInfoKHR)
#endif
deriving instance Show CalibratedTimestampInfoKHR

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

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

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

instance Zero CalibratedTimestampInfoKHR where
  zero :: CalibratedTimestampInfoKHR
zero = TimeDomainKHR -> CalibratedTimestampInfoKHR
CalibratedTimestampInfoKHR
           TimeDomainKHR
forall a. Zero a => a
zero


-- | VkTimeDomainKHR - Supported time domains
--
-- = Description
--
-- Note
--
-- An implementation supporting @VK_KHR_calibrated_timestamps@ or
-- @VK_EXT_calibrated_timestamps@ will use the same time domain for all its
-- 'Vulkan.Core10.Handles.Queue' so that timestamp values reported for
-- 'TIME_DOMAIN_DEVICE_KHR' can be matched to any timestamp captured
-- through 'Vulkan.Core10.CommandBufferBuilding.cmdWriteTimestamp' or
-- 'Vulkan.Core13.Promoted_From_VK_KHR_synchronization2.cmdWriteTimestamp2'
-- .
--
-- > struct timespec tv;
-- > clock_gettime(CLOCK_MONOTONIC, &tv);
-- > return tv.tv_nsec + tv.tv_sec*1000000000ull;
--
-- > struct timespec tv;
-- > clock_gettime(CLOCK_MONOTONIC_RAW, &tv);
-- > return tv.tv_nsec + tv.tv_sec*1000000000ull;
--
-- > LARGE_INTEGER counter;
-- > QueryPerformanceCounter(&counter);
-- > return counter.QuadPart;
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_calibrated_timestamps VK_EXT_calibrated_timestamps>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_calibrated_timestamps VK_KHR_calibrated_timestamps>,
-- 'CalibratedTimestampInfoKHR',
-- 'Vulkan.Extensions.VK_EXT_calibrated_timestamps.getPhysicalDeviceCalibrateableTimeDomainsEXT',
-- 'getPhysicalDeviceCalibrateableTimeDomainsKHR'
newtype TimeDomainKHR = TimeDomainKHR Int32
  deriving newtype (TimeDomainKHR -> TimeDomainKHR -> Bool
(TimeDomainKHR -> TimeDomainKHR -> Bool)
-> (TimeDomainKHR -> TimeDomainKHR -> Bool) -> Eq TimeDomainKHR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeDomainKHR -> TimeDomainKHR -> Bool
== :: TimeDomainKHR -> TimeDomainKHR -> Bool
$c/= :: TimeDomainKHR -> TimeDomainKHR -> Bool
/= :: TimeDomainKHR -> TimeDomainKHR -> Bool
Eq, Eq TimeDomainKHR
Eq TimeDomainKHR =>
(TimeDomainKHR -> TimeDomainKHR -> Ordering)
-> (TimeDomainKHR -> TimeDomainKHR -> Bool)
-> (TimeDomainKHR -> TimeDomainKHR -> Bool)
-> (TimeDomainKHR -> TimeDomainKHR -> Bool)
-> (TimeDomainKHR -> TimeDomainKHR -> Bool)
-> (TimeDomainKHR -> TimeDomainKHR -> TimeDomainKHR)
-> (TimeDomainKHR -> TimeDomainKHR -> TimeDomainKHR)
-> Ord TimeDomainKHR
TimeDomainKHR -> TimeDomainKHR -> Bool
TimeDomainKHR -> TimeDomainKHR -> Ordering
TimeDomainKHR -> TimeDomainKHR -> TimeDomainKHR
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TimeDomainKHR -> TimeDomainKHR -> Ordering
compare :: TimeDomainKHR -> TimeDomainKHR -> Ordering
$c< :: TimeDomainKHR -> TimeDomainKHR -> Bool
< :: TimeDomainKHR -> TimeDomainKHR -> Bool
$c<= :: TimeDomainKHR -> TimeDomainKHR -> Bool
<= :: TimeDomainKHR -> TimeDomainKHR -> Bool
$c> :: TimeDomainKHR -> TimeDomainKHR -> Bool
> :: TimeDomainKHR -> TimeDomainKHR -> Bool
$c>= :: TimeDomainKHR -> TimeDomainKHR -> Bool
>= :: TimeDomainKHR -> TimeDomainKHR -> Bool
$cmax :: TimeDomainKHR -> TimeDomainKHR -> TimeDomainKHR
max :: TimeDomainKHR -> TimeDomainKHR -> TimeDomainKHR
$cmin :: TimeDomainKHR -> TimeDomainKHR -> TimeDomainKHR
min :: TimeDomainKHR -> TimeDomainKHR -> TimeDomainKHR
Ord, Ptr TimeDomainKHR -> IO TimeDomainKHR
Ptr TimeDomainKHR -> Int -> IO TimeDomainKHR
Ptr TimeDomainKHR -> Int -> TimeDomainKHR -> IO ()
Ptr TimeDomainKHR -> TimeDomainKHR -> IO ()
TimeDomainKHR -> Int
(TimeDomainKHR -> Int)
-> (TimeDomainKHR -> Int)
-> (Ptr TimeDomainKHR -> Int -> IO TimeDomainKHR)
-> (Ptr TimeDomainKHR -> Int -> TimeDomainKHR -> IO ())
-> (forall b. Ptr b -> Int -> IO TimeDomainKHR)
-> (forall b. Ptr b -> Int -> TimeDomainKHR -> IO ())
-> (Ptr TimeDomainKHR -> IO TimeDomainKHR)
-> (Ptr TimeDomainKHR -> TimeDomainKHR -> IO ())
-> Storable TimeDomainKHR
forall b. Ptr b -> Int -> IO TimeDomainKHR
forall b. Ptr b -> Int -> TimeDomainKHR -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: TimeDomainKHR -> Int
sizeOf :: TimeDomainKHR -> Int
$calignment :: TimeDomainKHR -> Int
alignment :: TimeDomainKHR -> Int
$cpeekElemOff :: Ptr TimeDomainKHR -> Int -> IO TimeDomainKHR
peekElemOff :: Ptr TimeDomainKHR -> Int -> IO TimeDomainKHR
$cpokeElemOff :: Ptr TimeDomainKHR -> Int -> TimeDomainKHR -> IO ()
pokeElemOff :: Ptr TimeDomainKHR -> Int -> TimeDomainKHR -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO TimeDomainKHR
peekByteOff :: forall b. Ptr b -> Int -> IO TimeDomainKHR
$cpokeByteOff :: forall b. Ptr b -> Int -> TimeDomainKHR -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> TimeDomainKHR -> IO ()
$cpeek :: Ptr TimeDomainKHR -> IO TimeDomainKHR
peek :: Ptr TimeDomainKHR -> IO TimeDomainKHR
$cpoke :: Ptr TimeDomainKHR -> TimeDomainKHR -> IO ()
poke :: Ptr TimeDomainKHR -> TimeDomainKHR -> IO ()
Storable, TimeDomainKHR
TimeDomainKHR -> Zero TimeDomainKHR
forall a. a -> Zero a
$czero :: TimeDomainKHR
zero :: TimeDomainKHR
Zero)

-- | 'TIME_DOMAIN_DEVICE_KHR' specifies the device time domain. Timestamp
-- values in this time domain use the same units and are comparable with
-- device timestamp values captured using
-- 'Vulkan.Core10.CommandBufferBuilding.cmdWriteTimestamp' or
-- 'Vulkan.Core13.Promoted_From_VK_KHR_synchronization2.cmdWriteTimestamp2'
-- and are defined to be incrementing according to the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#limits-timestampPeriod timestampPeriod>
-- of the device.
pattern $bTIME_DOMAIN_DEVICE_KHR :: TimeDomainKHR
$mTIME_DOMAIN_DEVICE_KHR :: forall {r}. TimeDomainKHR -> ((# #) -> r) -> ((# #) -> r) -> r
TIME_DOMAIN_DEVICE_KHR = TimeDomainKHR 0

-- | 'TIME_DOMAIN_CLOCK_MONOTONIC_KHR' specifies the CLOCK_MONOTONIC time
-- domain available on POSIX platforms. Timestamp values in this time
-- domain are in units of nanoseconds and are comparable with platform
-- timestamp values captured using the POSIX clock_gettime API as computed
-- by this example:
pattern $bTIME_DOMAIN_CLOCK_MONOTONIC_KHR :: TimeDomainKHR
$mTIME_DOMAIN_CLOCK_MONOTONIC_KHR :: forall {r}. TimeDomainKHR -> ((# #) -> r) -> ((# #) -> r) -> r
TIME_DOMAIN_CLOCK_MONOTONIC_KHR = TimeDomainKHR 1

-- | 'TIME_DOMAIN_CLOCK_MONOTONIC_RAW_KHR' specifies the CLOCK_MONOTONIC_RAW
-- time domain available on POSIX platforms. Timestamp values in this time
-- domain are in units of nanoseconds and are comparable with platform
-- timestamp values captured using the POSIX clock_gettime API as computed
-- by this example:
pattern $bTIME_DOMAIN_CLOCK_MONOTONIC_RAW_KHR :: TimeDomainKHR
$mTIME_DOMAIN_CLOCK_MONOTONIC_RAW_KHR :: forall {r}. TimeDomainKHR -> ((# #) -> r) -> ((# #) -> r) -> r
TIME_DOMAIN_CLOCK_MONOTONIC_RAW_KHR = TimeDomainKHR 2

-- | 'TIME_DOMAIN_QUERY_PERFORMANCE_COUNTER_KHR' specifies the performance
-- counter (QPC) time domain available on Windows. Timestamp values in this
-- time domain are in the same units as those provided by the Windows
-- QueryPerformanceCounter API and are comparable with platform timestamp
-- values captured using that API as computed by this example:
pattern $bTIME_DOMAIN_QUERY_PERFORMANCE_COUNTER_KHR :: TimeDomainKHR
$mTIME_DOMAIN_QUERY_PERFORMANCE_COUNTER_KHR :: forall {r}. TimeDomainKHR -> ((# #) -> r) -> ((# #) -> r) -> r
TIME_DOMAIN_QUERY_PERFORMANCE_COUNTER_KHR = TimeDomainKHR 3

{-# COMPLETE
  TIME_DOMAIN_DEVICE_KHR
  , TIME_DOMAIN_CLOCK_MONOTONIC_KHR
  , TIME_DOMAIN_CLOCK_MONOTONIC_RAW_KHR
  , TIME_DOMAIN_QUERY_PERFORMANCE_COUNTER_KHR ::
    TimeDomainKHR
  #-}

conNameTimeDomainKHR :: String
conNameTimeDomainKHR :: String
conNameTimeDomainKHR = String
"TimeDomainKHR"

enumPrefixTimeDomainKHR :: String
enumPrefixTimeDomainKHR :: String
enumPrefixTimeDomainKHR = String
"TIME_DOMAIN_"

showTableTimeDomainKHR :: [(TimeDomainKHR, String)]
showTableTimeDomainKHR :: [(TimeDomainKHR, String)]
showTableTimeDomainKHR =
  [ (TimeDomainKHR
TIME_DOMAIN_DEVICE_KHR, String
"DEVICE_KHR")
  ,
    ( TimeDomainKHR
TIME_DOMAIN_CLOCK_MONOTONIC_KHR
    , String
"CLOCK_MONOTONIC_KHR"
    )
  ,
    ( TimeDomainKHR
TIME_DOMAIN_CLOCK_MONOTONIC_RAW_KHR
    , String
"CLOCK_MONOTONIC_RAW_KHR"
    )
  ,
    ( TimeDomainKHR
TIME_DOMAIN_QUERY_PERFORMANCE_COUNTER_KHR
    , String
"QUERY_PERFORMANCE_COUNTER_KHR"
    )
  ]

instance Show TimeDomainKHR where
  showsPrec :: Int -> TimeDomainKHR -> ShowS
showsPrec =
    String
-> [(TimeDomainKHR, String)]
-> String
-> (TimeDomainKHR -> Int32)
-> (Int32 -> ShowS)
-> Int
-> TimeDomainKHR
-> ShowS
forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
      String
enumPrefixTimeDomainKHR
      [(TimeDomainKHR, String)]
showTableTimeDomainKHR
      String
conNameTimeDomainKHR
      (\(TimeDomainKHR Int32
x) -> Int32
x)
      (Int -> Int32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11)

instance Read TimeDomainKHR where
  readPrec :: ReadPrec TimeDomainKHR
readPrec =
    String
-> [(TimeDomainKHR, String)]
-> String
-> (Int32 -> TimeDomainKHR)
-> ReadPrec TimeDomainKHR
forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
      String
enumPrefixTimeDomainKHR
      [(TimeDomainKHR, String)]
showTableTimeDomainKHR
      String
conNameTimeDomainKHR
      Int32 -> TimeDomainKHR
TimeDomainKHR

type KHR_CALIBRATED_TIMESTAMPS_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_KHR_CALIBRATED_TIMESTAMPS_SPEC_VERSION"
pattern KHR_CALIBRATED_TIMESTAMPS_SPEC_VERSION :: forall a . Integral a => a
pattern $bKHR_CALIBRATED_TIMESTAMPS_SPEC_VERSION :: forall a. Integral a => a
$mKHR_CALIBRATED_TIMESTAMPS_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
KHR_CALIBRATED_TIMESTAMPS_SPEC_VERSION = 1


type KHR_CALIBRATED_TIMESTAMPS_EXTENSION_NAME = "VK_KHR_calibrated_timestamps"

-- No documentation found for TopLevel "VK_KHR_CALIBRATED_TIMESTAMPS_EXTENSION_NAME"
pattern KHR_CALIBRATED_TIMESTAMPS_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bKHR_CALIBRATED_TIMESTAMPS_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mKHR_CALIBRATED_TIMESTAMPS_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
KHR_CALIBRATED_TIMESTAMPS_EXTENSION_NAME = "VK_KHR_calibrated_timestamps"