{-# language CPP #-}
module Graphics.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.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import Foreign.Marshal.Utils (maybePeek)
import GHC.Base (when)
import GHC.IO (throwIO)
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 Control.Monad.IO.Class (MonadIO)
import Data.Either (Either)
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 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 Graphics.Vulkan.CStruct.Utils (advancePtrBytes)
import Graphics.Vulkan.NamedType ((:::))
import Graphics.Vulkan.Core10.Handles (Device)
import Graphics.Vulkan.Core10.Handles (Device(..))
import Graphics.Vulkan.Dynamic (DeviceCmds(pVkGetPastPresentationTimingGOOGLE))
import Graphics.Vulkan.Dynamic (DeviceCmds(pVkGetRefreshCycleDurationGOOGLE))
import Graphics.Vulkan.Core10.Handles (Device_T)
import Graphics.Vulkan.CStruct (FromCStruct)
import Graphics.Vulkan.CStruct (FromCStruct(..))
import Graphics.Vulkan.Core10.Enums.Result (Result)
import Graphics.Vulkan.Core10.Enums.Result (Result(..))
import Graphics.Vulkan.Core10.Enums.StructureType (StructureType)
import Graphics.Vulkan.Extensions.Handles (SwapchainKHR)
import Graphics.Vulkan.Extensions.Handles (SwapchainKHR(..))
import Graphics.Vulkan.CStruct (ToCStruct)
import Graphics.Vulkan.CStruct (ToCStruct(..))
import Graphics.Vulkan.Exception (VulkanException(..))
import Graphics.Vulkan.Zero (Zero(..))
import Graphics.Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PRESENT_TIMES_INFO_GOOGLE))
import Graphics.Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Graphics.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
getRefreshCycleDurationGOOGLE :: forall io . MonadIO io => Device -> SwapchainKHR -> io (("displayTimingProperties" ::: RefreshCycleDurationGOOGLE))
getRefreshCycleDurationGOOGLE device swapchain = liftIO . evalContT $ do
let vkGetRefreshCycleDurationGOOGLE' = mkVkGetRefreshCycleDurationGOOGLE (pVkGetRefreshCycleDurationGOOGLE (deviceCmds (device :: Device)))
pPDisplayTimingProperties <- ContT (withZeroCStruct @RefreshCycleDurationGOOGLE)
r <- lift $ vkGetRefreshCycleDurationGOOGLE' (deviceHandle (device)) (swapchain) (pPDisplayTimingProperties)
lift $ when (r < SUCCESS) (throwIO (VulkanException r))
pDisplayTimingProperties <- lift $ peekCStruct @RefreshCycleDurationGOOGLE pPDisplayTimingProperties
pure $ (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
getPastPresentationTimingGOOGLE :: forall io . MonadIO io => Device -> SwapchainKHR -> io (Result, ("presentationTimings" ::: Vector PastPresentationTimingGOOGLE))
getPastPresentationTimingGOOGLE device swapchain = liftIO . evalContT $ do
let vkGetPastPresentationTimingGOOGLE' = mkVkGetPastPresentationTimingGOOGLE (pVkGetPastPresentationTimingGOOGLE (deviceCmds (device :: Device)))
let device' = deviceHandle (device)
pPPresentationTimingCount <- ContT $ bracket (callocBytes @Word32 4) free
r <- lift $ vkGetPastPresentationTimingGOOGLE' device' (swapchain) (pPPresentationTimingCount) (nullPtr)
lift $ when (r < SUCCESS) (throwIO (VulkanException r))
pPresentationTimingCount <- lift $ peek @Word32 pPPresentationTimingCount
pPPresentationTimings <- ContT $ bracket (callocBytes @PastPresentationTimingGOOGLE ((fromIntegral (pPresentationTimingCount)) * 40)) free
_ <- traverse (\i -> ContT $ pokeZeroCStruct (pPPresentationTimings `advancePtrBytes` (i * 40) :: Ptr PastPresentationTimingGOOGLE) . ($ ())) [0..(fromIntegral (pPresentationTimingCount)) - 1]
r' <- lift $ vkGetPastPresentationTimingGOOGLE' device' (swapchain) (pPPresentationTimingCount) ((pPPresentationTimings))
lift $ when (r' < SUCCESS) (throwIO (VulkanException r'))
pPresentationTimingCount' <- lift $ peek @Word32 pPPresentationTimingCount
pPresentationTimings' <- lift $ generateM (fromIntegral (pPresentationTimingCount')) (\i -> peekCStruct @PastPresentationTimingGOOGLE (((pPPresentationTimings) `advancePtrBytes` (40 * (i)) :: Ptr PastPresentationTimingGOOGLE)))
pure $ ((r'), pPresentationTimings')
data RefreshCycleDurationGOOGLE = RefreshCycleDurationGOOGLE
{
refreshDuration :: Word64 }
deriving (Typeable)
deriving instance Show RefreshCycleDurationGOOGLE
instance ToCStruct RefreshCycleDurationGOOGLE where
withCStruct x f = allocaBytesAligned 8 8 $ \p -> pokeCStruct p x (f p)
pokeCStruct p RefreshCycleDurationGOOGLE{..} f = do
poke ((p `plusPtr` 0 :: Ptr Word64)) (refreshDuration)
f
cStructSize = 8
cStructAlignment = 8
pokeZeroCStruct p f = do
poke ((p `plusPtr` 0 :: Ptr Word64)) (zero)
f
instance FromCStruct RefreshCycleDurationGOOGLE where
peekCStruct p = do
refreshDuration <- peek @Word64 ((p `plusPtr` 0 :: Ptr Word64))
pure $ RefreshCycleDurationGOOGLE
refreshDuration
instance Storable RefreshCycleDurationGOOGLE where
sizeOf ~_ = 8
alignment ~_ = 8
peek = peekCStruct
poke ptr poked = pokeCStruct ptr poked (pure ())
instance Zero RefreshCycleDurationGOOGLE where
zero = RefreshCycleDurationGOOGLE
zero
data PastPresentationTimingGOOGLE = PastPresentationTimingGOOGLE
{
presentID :: Word32
,
desiredPresentTime :: Word64
,
actualPresentTime :: Word64
,
earliestPresentTime :: Word64
,
presentMargin :: Word64
}
deriving (Typeable)
deriving instance Show PastPresentationTimingGOOGLE
instance ToCStruct PastPresentationTimingGOOGLE where
withCStruct x f = allocaBytesAligned 40 8 $ \p -> pokeCStruct p x (f p)
pokeCStruct p PastPresentationTimingGOOGLE{..} f = do
poke ((p `plusPtr` 0 :: Ptr Word32)) (presentID)
poke ((p `plusPtr` 8 :: Ptr Word64)) (desiredPresentTime)
poke ((p `plusPtr` 16 :: Ptr Word64)) (actualPresentTime)
poke ((p `plusPtr` 24 :: Ptr Word64)) (earliestPresentTime)
poke ((p `plusPtr` 32 :: Ptr Word64)) (presentMargin)
f
cStructSize = 40
cStructAlignment = 8
pokeZeroCStruct p f = do
poke ((p `plusPtr` 0 :: Ptr Word32)) (zero)
poke ((p `plusPtr` 8 :: Ptr Word64)) (zero)
poke ((p `plusPtr` 16 :: Ptr Word64)) (zero)
poke ((p `plusPtr` 24 :: Ptr Word64)) (zero)
poke ((p `plusPtr` 32 :: Ptr Word64)) (zero)
f
instance FromCStruct PastPresentationTimingGOOGLE where
peekCStruct p = do
presentID <- peek @Word32 ((p `plusPtr` 0 :: Ptr Word32))
desiredPresentTime <- peek @Word64 ((p `plusPtr` 8 :: Ptr Word64))
actualPresentTime <- peek @Word64 ((p `plusPtr` 16 :: Ptr Word64))
earliestPresentTime <- peek @Word64 ((p `plusPtr` 24 :: Ptr Word64))
presentMargin <- peek @Word64 ((p `plusPtr` 32 :: Ptr Word64))
pure $ PastPresentationTimingGOOGLE
presentID desiredPresentTime actualPresentTime earliestPresentTime presentMargin
instance Storable PastPresentationTimingGOOGLE where
sizeOf ~_ = 40
alignment ~_ = 8
peek = peekCStruct
poke ptr poked = pokeCStruct ptr poked (pure ())
instance Zero PastPresentationTimingGOOGLE where
zero = PastPresentationTimingGOOGLE
zero
zero
zero
zero
zero
data PresentTimesInfoGOOGLE = PresentTimesInfoGOOGLE
{
times :: Either Word32 (Vector PresentTimeGOOGLE) }
deriving (Typeable)
deriving instance Show PresentTimesInfoGOOGLE
instance ToCStruct PresentTimesInfoGOOGLE where
withCStruct x f = allocaBytesAligned 32 8 $ \p -> pokeCStruct p x (f p)
pokeCStruct p PresentTimesInfoGOOGLE{..} f = evalContT $ do
lift $ poke ((p `plusPtr` 0 :: Ptr StructureType)) (STRUCTURE_TYPE_PRESENT_TIMES_INFO_GOOGLE)
lift $ poke ((p `plusPtr` 8 :: Ptr (Ptr ()))) (nullPtr)
lift $ poke ((p `plusPtr` 16 :: Ptr Word32)) ((fromIntegral (either id (fromIntegral . Data.Vector.length) (times)) :: Word32))
pTimes'' <- case (times) of
Left _ -> pure nullPtr
Right v -> do
pPTimes' <- ContT $ allocaBytesAligned @PresentTimeGOOGLE ((Data.Vector.length (v)) * 16) 8
Data.Vector.imapM_ (\i e -> ContT $ pokeCStruct (pPTimes' `plusPtr` (16 * (i)) :: Ptr PresentTimeGOOGLE) (e) . ($ ())) (v)
pure $ pPTimes'
lift $ poke ((p `plusPtr` 24 :: Ptr (Ptr PresentTimeGOOGLE))) pTimes''
lift $ f
cStructSize = 32
cStructAlignment = 8
pokeZeroCStruct p f = do
poke ((p `plusPtr` 0 :: Ptr StructureType)) (STRUCTURE_TYPE_PRESENT_TIMES_INFO_GOOGLE)
poke ((p `plusPtr` 8 :: Ptr (Ptr ()))) (nullPtr)
f
instance FromCStruct PresentTimesInfoGOOGLE where
peekCStruct p = do
swapchainCount <- peek @Word32 ((p `plusPtr` 16 :: Ptr Word32))
pTimes <- peek @(Ptr PresentTimeGOOGLE) ((p `plusPtr` 24 :: Ptr (Ptr PresentTimeGOOGLE)))
pTimes' <- maybePeek (\j -> generateM (fromIntegral swapchainCount) (\i -> peekCStruct @PresentTimeGOOGLE (((j) `advancePtrBytes` (16 * (i)) :: Ptr PresentTimeGOOGLE)))) pTimes
let pTimes'' = maybe (Left swapchainCount) Right pTimes'
pure $ PresentTimesInfoGOOGLE
pTimes''
instance Zero PresentTimesInfoGOOGLE where
zero = PresentTimesInfoGOOGLE
(Left 0)
data PresentTimeGOOGLE = PresentTimeGOOGLE
{
presentID :: Word32
,
desiredPresentTime :: Word64
}
deriving (Typeable)
deriving instance Show PresentTimeGOOGLE
instance ToCStruct PresentTimeGOOGLE where
withCStruct x f = allocaBytesAligned 16 8 $ \p -> pokeCStruct p x (f p)
pokeCStruct p PresentTimeGOOGLE{..} f = do
poke ((p `plusPtr` 0 :: Ptr Word32)) (presentID)
poke ((p `plusPtr` 8 :: Ptr Word64)) (desiredPresentTime)
f
cStructSize = 16
cStructAlignment = 8
pokeZeroCStruct p f = do
poke ((p `plusPtr` 0 :: Ptr Word32)) (zero)
poke ((p `plusPtr` 8 :: Ptr Word64)) (zero)
f
instance FromCStruct PresentTimeGOOGLE where
peekCStruct p = do
presentID <- peek @Word32 ((p `plusPtr` 0 :: Ptr Word32))
desiredPresentTime <- peek @Word64 ((p `plusPtr` 8 :: Ptr Word64))
pure $ PresentTimeGOOGLE
presentID desiredPresentTime
instance Storable PresentTimeGOOGLE where
sizeOf ~_ = 16
alignment ~_ = 8
peek = peekCStruct
poke ptr poked = pokeCStruct ptr poked (pure ())
instance Zero PresentTimeGOOGLE where
zero = PresentTimeGOOGLE
zero
zero
type GOOGLE_DISPLAY_TIMING_SPEC_VERSION = 1
pattern GOOGLE_DISPLAY_TIMING_SPEC_VERSION :: forall a . Integral a => a
pattern GOOGLE_DISPLAY_TIMING_SPEC_VERSION = 1
type GOOGLE_DISPLAY_TIMING_EXTENSION_NAME = "VK_GOOGLE_display_timing"
pattern GOOGLE_DISPLAY_TIMING_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern GOOGLE_DISPLAY_TIMING_EXTENSION_NAME = "VK_GOOGLE_display_timing"