{-# language CPP #-}
-- No documentation found for Chapter "Promoted_From_VK_KHR_external_semaphore_capabilities"
module Vulkan.Core11.Promoted_From_VK_KHR_external_semaphore_capabilities  ( getPhysicalDeviceExternalSemaphoreProperties
                                                                           , PhysicalDeviceExternalSemaphoreInfo(..)
                                                                           , ExternalSemaphoreProperties(..)
                                                                           , StructureType(..)
                                                                           , ExternalSemaphoreHandleTypeFlagBits(..)
                                                                           , ExternalSemaphoreHandleTypeFlags
                                                                           , ExternalSemaphoreFeatureFlagBits(..)
                                                                           , ExternalSemaphoreFeatureFlags
                                                                           ) where

import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytes)
import GHC.IO (throwIO)
import GHC.Ptr (castPtr)
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 Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.Type.Equality ((:~:)(Refl))
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.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Vulkan.CStruct.Extends (forgetExtensions)
import Vulkan.CStruct.Extends (Chain)
import Vulkan.CStruct.Extends (Extends)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.CStruct.Extends (Extensible(..))
import Vulkan.Core11.Enums.ExternalSemaphoreFeatureFlagBits (ExternalSemaphoreFeatureFlags)
import Vulkan.Core11.Enums.ExternalSemaphoreHandleTypeFlagBits (ExternalSemaphoreHandleTypeFlagBits)
import Vulkan.Core11.Enums.ExternalSemaphoreHandleTypeFlagBits (ExternalSemaphoreHandleTypeFlags)
import Vulkan.Dynamic (InstanceCmds(pVkGetPhysicalDeviceExternalSemaphoreProperties))
import Vulkan.CStruct.Extends (PeekChain)
import Vulkan.CStruct.Extends (PeekChain(..))
import Vulkan.Core10.Handles (PhysicalDevice)
import Vulkan.Core10.Handles (PhysicalDevice(..))
import Vulkan.Core10.Handles (PhysicalDevice(PhysicalDevice))
import Vulkan.Core10.Handles (PhysicalDevice_T)
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (PokeChain(..))
import {-# SOURCE #-} Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore (SemaphoreTypeCreateInfo)
import Vulkan.CStruct.Extends (SomeStruct)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_EXTERNAL_SEMAPHORE_PROPERTIES))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_EXTERNAL_SEMAPHORE_INFO))
import Vulkan.Core11.Enums.ExternalSemaphoreFeatureFlagBits (ExternalSemaphoreFeatureFlagBits(..))
import Vulkan.Core11.Enums.ExternalSemaphoreFeatureFlagBits (ExternalSemaphoreFeatureFlags)
import Vulkan.Core11.Enums.ExternalSemaphoreHandleTypeFlagBits (ExternalSemaphoreHandleTypeFlagBits(..))
import Vulkan.Core11.Enums.ExternalSemaphoreHandleTypeFlagBits (ExternalSemaphoreHandleTypeFlags)
import Vulkan.Core10.Enums.StructureType (StructureType(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetPhysicalDeviceExternalSemaphoreProperties
  :: FunPtr (Ptr PhysicalDevice_T -> Ptr (SomeStruct PhysicalDeviceExternalSemaphoreInfo) -> Ptr ExternalSemaphoreProperties -> IO ()) -> Ptr PhysicalDevice_T -> Ptr (SomeStruct PhysicalDeviceExternalSemaphoreInfo) -> Ptr ExternalSemaphoreProperties -> IO ()

-- | vkGetPhysicalDeviceExternalSemaphoreProperties - Function for querying
-- external semaphore handle capabilities.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_1 VK_VERSION_1_1>,
-- 'ExternalSemaphoreProperties', 'Vulkan.Core10.Handles.PhysicalDevice',
-- 'PhysicalDeviceExternalSemaphoreInfo'
getPhysicalDeviceExternalSemaphoreProperties :: forall a io
                                              . ( Extendss PhysicalDeviceExternalSemaphoreInfo a
                                                , PokeChain a
                                                , MonadIO io )
                                             => -- | @physicalDevice@ is the physical device from which to query the
                                                -- semaphore capabilities.
                                                --
                                                -- #VUID-vkGetPhysicalDeviceExternalSemaphoreProperties-physicalDevice-parameter#
                                                -- @physicalDevice@ /must/ be a valid
                                                -- 'Vulkan.Core10.Handles.PhysicalDevice' handle
                                                PhysicalDevice
                                             -> -- | @pExternalSemaphoreInfo@ is a pointer to a
                                                -- 'PhysicalDeviceExternalSemaphoreInfo' structure describing the
                                                -- parameters that would be consumed by
                                                -- 'Vulkan.Core10.QueueSemaphore.createSemaphore'.
                                                --
                                                -- #VUID-vkGetPhysicalDeviceExternalSemaphoreProperties-pExternalSemaphoreInfo-parameter#
                                                -- @pExternalSemaphoreInfo@ /must/ be a valid pointer to a valid
                                                -- 'PhysicalDeviceExternalSemaphoreInfo' structure
                                                (PhysicalDeviceExternalSemaphoreInfo a)
                                             -> io (ExternalSemaphoreProperties)
getPhysicalDeviceExternalSemaphoreProperties :: forall (a :: [*]) (io :: * -> *).
(Extendss PhysicalDeviceExternalSemaphoreInfo a, PokeChain a,
 MonadIO io) =>
PhysicalDevice
-> PhysicalDeviceExternalSemaphoreInfo a
-> io ExternalSemaphoreProperties
getPhysicalDeviceExternalSemaphoreProperties PhysicalDevice
physicalDevice
                                               PhysicalDeviceExternalSemaphoreInfo a
externalSemaphoreInfo = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
  let vkGetPhysicalDeviceExternalSemaphorePropertiesPtr :: FunPtr
  (Ptr PhysicalDevice_T
   -> ("pExternalSemaphoreInfo"
       ::: Ptr (SomeStruct PhysicalDeviceExternalSemaphoreInfo))
   -> ("pExternalSemaphoreProperties"
       ::: Ptr ExternalSemaphoreProperties)
   -> IO ())
vkGetPhysicalDeviceExternalSemaphorePropertiesPtr = InstanceCmds
-> FunPtr
     (Ptr PhysicalDevice_T
      -> ("pExternalSemaphoreInfo"
          ::: Ptr (SomeStruct PhysicalDeviceExternalSemaphoreInfo))
      -> ("pExternalSemaphoreProperties"
          ::: Ptr ExternalSemaphoreProperties)
      -> IO ())
pVkGetPhysicalDeviceExternalSemaphoreProperties (case PhysicalDevice
physicalDevice of PhysicalDevice{InstanceCmds
$sel:instanceCmds:PhysicalDevice :: PhysicalDevice -> InstanceCmds
instanceCmds :: InstanceCmds
instanceCmds} -> InstanceCmds
instanceCmds)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr PhysicalDevice_T
   -> ("pExternalSemaphoreInfo"
       ::: Ptr (SomeStruct PhysicalDeviceExternalSemaphoreInfo))
   -> ("pExternalSemaphoreProperties"
       ::: Ptr ExternalSemaphoreProperties)
   -> IO ())
vkGetPhysicalDeviceExternalSemaphorePropertiesPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetPhysicalDeviceExternalSemaphoreProperties is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkGetPhysicalDeviceExternalSemaphoreProperties' :: Ptr PhysicalDevice_T
-> ("pExternalSemaphoreInfo"
    ::: Ptr (SomeStruct PhysicalDeviceExternalSemaphoreInfo))
-> ("pExternalSemaphoreProperties"
    ::: Ptr ExternalSemaphoreProperties)
-> IO ()
vkGetPhysicalDeviceExternalSemaphoreProperties' = FunPtr
  (Ptr PhysicalDevice_T
   -> ("pExternalSemaphoreInfo"
       ::: Ptr (SomeStruct PhysicalDeviceExternalSemaphoreInfo))
   -> ("pExternalSemaphoreProperties"
       ::: Ptr ExternalSemaphoreProperties)
   -> IO ())
-> Ptr PhysicalDevice_T
-> ("pExternalSemaphoreInfo"
    ::: Ptr (SomeStruct PhysicalDeviceExternalSemaphoreInfo))
-> ("pExternalSemaphoreProperties"
    ::: Ptr ExternalSemaphoreProperties)
-> IO ()
mkVkGetPhysicalDeviceExternalSemaphoreProperties FunPtr
  (Ptr PhysicalDevice_T
   -> ("pExternalSemaphoreInfo"
       ::: Ptr (SomeStruct PhysicalDeviceExternalSemaphoreInfo))
   -> ("pExternalSemaphoreProperties"
       ::: Ptr ExternalSemaphoreProperties)
   -> IO ())
vkGetPhysicalDeviceExternalSemaphorePropertiesPtr
  Ptr (PhysicalDeviceExternalSemaphoreInfo a)
pExternalSemaphoreInfo <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (PhysicalDeviceExternalSemaphoreInfo a
externalSemaphoreInfo)
  "pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
pPExternalSemaphoreProperties <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @ExternalSemaphoreProperties)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPhysicalDeviceExternalSemaphoreProperties" (Ptr PhysicalDevice_T
-> ("pExternalSemaphoreInfo"
    ::: Ptr (SomeStruct PhysicalDeviceExternalSemaphoreInfo))
-> ("pExternalSemaphoreProperties"
    ::: Ptr ExternalSemaphoreProperties)
-> IO ()
vkGetPhysicalDeviceExternalSemaphoreProperties'
                                                                              (PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice))
                                                                              (forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (PhysicalDeviceExternalSemaphoreInfo a)
pExternalSemaphoreInfo)
                                                                              ("pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
pPExternalSemaphoreProperties))
  ExternalSemaphoreProperties
pExternalSemaphoreProperties <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ExternalSemaphoreProperties "pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
pPExternalSemaphoreProperties
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (ExternalSemaphoreProperties
pExternalSemaphoreProperties)


-- | VkPhysicalDeviceExternalSemaphoreInfo - Structure specifying semaphore
-- creation parameters.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkPhysicalDeviceExternalSemaphoreInfo-sType-sType# @sType@
--     /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_EXTERNAL_SEMAPHORE_INFO'
--
-- -   #VUID-VkPhysicalDeviceExternalSemaphoreInfo-pNext-pNext# @pNext@
--     /must/ be @NULL@ or a pointer to a valid instance of
--     'Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore.SemaphoreTypeCreateInfo'
--
-- -   #VUID-VkPhysicalDeviceExternalSemaphoreInfo-sType-unique# The
--     @sType@ value of each struct in the @pNext@ chain /must/ be unique
--
-- -   #VUID-VkPhysicalDeviceExternalSemaphoreInfo-handleType-parameter#
--     @handleType@ /must/ be a valid
--     'Vulkan.Core11.Enums.ExternalSemaphoreHandleTypeFlagBits.ExternalSemaphoreHandleTypeFlagBits'
--     value
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_1 VK_VERSION_1_1>,
-- 'Vulkan.Core11.Enums.ExternalSemaphoreHandleTypeFlagBits.ExternalSemaphoreHandleTypeFlagBits',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'getPhysicalDeviceExternalSemaphoreProperties',
-- 'Vulkan.Extensions.VK_KHR_external_semaphore_capabilities.getPhysicalDeviceExternalSemaphorePropertiesKHR'
data PhysicalDeviceExternalSemaphoreInfo (es :: [Type]) = PhysicalDeviceExternalSemaphoreInfo
  { -- | @pNext@ is @NULL@ or a pointer to a structure extending this structure.
    forall (es :: [*]).
PhysicalDeviceExternalSemaphoreInfo es -> Chain es
next :: Chain es
  , -- | @handleType@ is a
    -- 'Vulkan.Core11.Enums.ExternalSemaphoreHandleTypeFlagBits.ExternalSemaphoreHandleTypeFlagBits'
    -- value specifying the external semaphore handle type for which
    -- capabilities will be returned.
    forall (es :: [*]).
PhysicalDeviceExternalSemaphoreInfo es
-> ExternalSemaphoreHandleTypeFlagBits
handleType :: ExternalSemaphoreHandleTypeFlagBits
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceExternalSemaphoreInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (PhysicalDeviceExternalSemaphoreInfo es)

instance Extensible PhysicalDeviceExternalSemaphoreInfo where
  extensibleTypeName :: String
extensibleTypeName = String
"PhysicalDeviceExternalSemaphoreInfo"
  setNext :: forall (ds :: [*]) (es :: [*]).
PhysicalDeviceExternalSemaphoreInfo ds
-> Chain es -> PhysicalDeviceExternalSemaphoreInfo es
setNext PhysicalDeviceExternalSemaphoreInfo{Chain ds
ExternalSemaphoreHandleTypeFlagBits
handleType :: ExternalSemaphoreHandleTypeFlagBits
next :: Chain ds
$sel:handleType:PhysicalDeviceExternalSemaphoreInfo :: forall (es :: [*]).
PhysicalDeviceExternalSemaphoreInfo es
-> ExternalSemaphoreHandleTypeFlagBits
$sel:next:PhysicalDeviceExternalSemaphoreInfo :: forall (es :: [*]).
PhysicalDeviceExternalSemaphoreInfo es -> Chain es
..} Chain es
next' = PhysicalDeviceExternalSemaphoreInfo{$sel:next:PhysicalDeviceExternalSemaphoreInfo :: Chain es
next = Chain es
next', ExternalSemaphoreHandleTypeFlagBits
handleType :: ExternalSemaphoreHandleTypeFlagBits
$sel:handleType:PhysicalDeviceExternalSemaphoreInfo :: ExternalSemaphoreHandleTypeFlagBits
..}
  getNext :: forall (es :: [*]).
PhysicalDeviceExternalSemaphoreInfo es -> Chain es
getNext PhysicalDeviceExternalSemaphoreInfo{Chain es
ExternalSemaphoreHandleTypeFlagBits
handleType :: ExternalSemaphoreHandleTypeFlagBits
next :: Chain es
$sel:handleType:PhysicalDeviceExternalSemaphoreInfo :: forall (es :: [*]).
PhysicalDeviceExternalSemaphoreInfo es
-> ExternalSemaphoreHandleTypeFlagBits
$sel:next:PhysicalDeviceExternalSemaphoreInfo :: forall (es :: [*]).
PhysicalDeviceExternalSemaphoreInfo es -> Chain es
..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends PhysicalDeviceExternalSemaphoreInfo e => b) -> Maybe b
  extends :: forall e b (proxy :: * -> *).
Typeable e =>
proxy e
-> (Extends PhysicalDeviceExternalSemaphoreInfo e => b) -> Maybe b
extends proxy e
_ Extends PhysicalDeviceExternalSemaphoreInfo e => b
f
    | Just e :~: SemaphoreTypeCreateInfo
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @SemaphoreTypeCreateInfo = forall a. a -> Maybe a
Just Extends PhysicalDeviceExternalSemaphoreInfo e => b
f
    | Bool
otherwise = forall a. Maybe a
Nothing

instance ( Extendss PhysicalDeviceExternalSemaphoreInfo es
         , PokeChain es ) => ToCStruct (PhysicalDeviceExternalSemaphoreInfo es) where
  withCStruct :: forall b.
PhysicalDeviceExternalSemaphoreInfo es
-> (Ptr (PhysicalDeviceExternalSemaphoreInfo es) -> IO b) -> IO b
withCStruct PhysicalDeviceExternalSemaphoreInfo es
x Ptr (PhysicalDeviceExternalSemaphoreInfo es) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr (PhysicalDeviceExternalSemaphoreInfo es)
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (PhysicalDeviceExternalSemaphoreInfo es)
p PhysicalDeviceExternalSemaphoreInfo es
x (Ptr (PhysicalDeviceExternalSemaphoreInfo es) -> IO b
f Ptr (PhysicalDeviceExternalSemaphoreInfo es)
p)
  pokeCStruct :: forall b.
Ptr (PhysicalDeviceExternalSemaphoreInfo es)
-> PhysicalDeviceExternalSemaphoreInfo es -> IO b -> IO b
pokeCStruct Ptr (PhysicalDeviceExternalSemaphoreInfo es)
p PhysicalDeviceExternalSemaphoreInfo{Chain es
ExternalSemaphoreHandleTypeFlagBits
handleType :: ExternalSemaphoreHandleTypeFlagBits
next :: Chain es
$sel:handleType:PhysicalDeviceExternalSemaphoreInfo :: forall (es :: [*]).
PhysicalDeviceExternalSemaphoreInfo es
-> ExternalSemaphoreHandleTypeFlagBits
$sel:next:PhysicalDeviceExternalSemaphoreInfo :: forall (es :: [*]).
PhysicalDeviceExternalSemaphoreInfo es -> Chain es
..} IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PhysicalDeviceExternalSemaphoreInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_EXTERNAL_SEMAPHORE_INFO)
    Ptr ()
pNext'' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. Ptr a -> Ptr b
castPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PhysicalDeviceExternalSemaphoreInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext''
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PhysicalDeviceExternalSemaphoreInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ExternalSemaphoreHandleTypeFlagBits)) (ExternalSemaphoreHandleTypeFlagBits
handleType)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr (PhysicalDeviceExternalSemaphoreInfo es) -> IO b -> IO b
pokeZeroCStruct Ptr (PhysicalDeviceExternalSemaphoreInfo es)
p IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PhysicalDeviceExternalSemaphoreInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_EXTERNAL_SEMAPHORE_INFO)
    Ptr ()
pNext' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. Ptr a -> Ptr b
castPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PhysicalDeviceExternalSemaphoreInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext'
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PhysicalDeviceExternalSemaphoreInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ExternalSemaphoreHandleTypeFlagBits)) (forall a. Zero a => a
zero)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f

instance ( Extendss PhysicalDeviceExternalSemaphoreInfo es
         , PeekChain es ) => FromCStruct (PhysicalDeviceExternalSemaphoreInfo es) where
  peekCStruct :: Ptr (PhysicalDeviceExternalSemaphoreInfo es)
-> IO (PhysicalDeviceExternalSemaphoreInfo es)
peekCStruct Ptr (PhysicalDeviceExternalSemaphoreInfo es)
p = do
    Ptr ()
pNext <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (PhysicalDeviceExternalSemaphoreInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ())))
    Chain es
next <- forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
    ExternalSemaphoreHandleTypeFlagBits
handleType <- forall a. Storable a => Ptr a -> IO a
peek @ExternalSemaphoreHandleTypeFlagBits ((Ptr (PhysicalDeviceExternalSemaphoreInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ExternalSemaphoreHandleTypeFlagBits))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (es :: [*]).
Chain es
-> ExternalSemaphoreHandleTypeFlagBits
-> PhysicalDeviceExternalSemaphoreInfo es
PhysicalDeviceExternalSemaphoreInfo
             Chain es
next ExternalSemaphoreHandleTypeFlagBits
handleType

instance es ~ '[] => Zero (PhysicalDeviceExternalSemaphoreInfo es) where
  zero :: PhysicalDeviceExternalSemaphoreInfo es
zero = forall (es :: [*]).
Chain es
-> ExternalSemaphoreHandleTypeFlagBits
-> PhysicalDeviceExternalSemaphoreInfo es
PhysicalDeviceExternalSemaphoreInfo
           ()
           forall a. Zero a => a
zero


-- | VkExternalSemaphoreProperties - Structure describing supported external
-- semaphore handle features
--
-- = Description
--
-- If @handleType@ is not supported by the implementation, then
-- 'ExternalSemaphoreProperties'::@externalSemaphoreFeatures@ will be set
-- to zero.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_1 VK_VERSION_1_1>,
-- 'Vulkan.Core11.Enums.ExternalSemaphoreFeatureFlagBits.ExternalSemaphoreFeatureFlags',
-- 'Vulkan.Core11.Enums.ExternalSemaphoreHandleTypeFlagBits.ExternalSemaphoreHandleTypeFlags',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'getPhysicalDeviceExternalSemaphoreProperties',
-- 'Vulkan.Extensions.VK_KHR_external_semaphore_capabilities.getPhysicalDeviceExternalSemaphorePropertiesKHR'
data ExternalSemaphoreProperties = ExternalSemaphoreProperties
  { -- | @exportFromImportedHandleTypes@ is a bitmask of
    -- 'Vulkan.Core11.Enums.ExternalSemaphoreHandleTypeFlagBits.ExternalSemaphoreHandleTypeFlagBits'
    -- specifying which types of imported handle @handleType@ /can/ be exported
    -- from.
    ExternalSemaphoreProperties -> ExternalSemaphoreHandleTypeFlagBits
exportFromImportedHandleTypes :: ExternalSemaphoreHandleTypeFlags
  , -- | @compatibleHandleTypes@ is a bitmask of
    -- 'Vulkan.Core11.Enums.ExternalSemaphoreHandleTypeFlagBits.ExternalSemaphoreHandleTypeFlagBits'
    -- specifying handle types which /can/ be specified at the same time as
    -- @handleType@ when creating a semaphore.
    ExternalSemaphoreProperties -> ExternalSemaphoreHandleTypeFlagBits
compatibleHandleTypes :: ExternalSemaphoreHandleTypeFlags
  , -- | @externalSemaphoreFeatures@ is a bitmask of
    -- 'Vulkan.Core11.Enums.ExternalSemaphoreFeatureFlagBits.ExternalSemaphoreFeatureFlagBits'
    -- describing the features of @handleType@.
    ExternalSemaphoreProperties -> ExternalSemaphoreFeatureFlags
externalSemaphoreFeatures :: ExternalSemaphoreFeatureFlags
  }
  deriving (Typeable, ExternalSemaphoreProperties -> ExternalSemaphoreProperties -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExternalSemaphoreProperties -> ExternalSemaphoreProperties -> Bool
$c/= :: ExternalSemaphoreProperties -> ExternalSemaphoreProperties -> Bool
== :: ExternalSemaphoreProperties -> ExternalSemaphoreProperties -> Bool
$c== :: ExternalSemaphoreProperties -> ExternalSemaphoreProperties -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ExternalSemaphoreProperties)
#endif
deriving instance Show ExternalSemaphoreProperties

instance ToCStruct ExternalSemaphoreProperties where
  withCStruct :: forall b.
ExternalSemaphoreProperties
-> (("pExternalSemaphoreProperties"
     ::: Ptr ExternalSemaphoreProperties)
    -> IO b)
-> IO b
withCStruct ExternalSemaphoreProperties
x ("pExternalSemaphoreProperties"
 ::: Ptr ExternalSemaphoreProperties)
-> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \"pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p ExternalSemaphoreProperties
x (("pExternalSemaphoreProperties"
 ::: Ptr ExternalSemaphoreProperties)
-> IO b
f "pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p)
  pokeCStruct :: forall b.
("pExternalSemaphoreProperties"
 ::: Ptr ExternalSemaphoreProperties)
-> ExternalSemaphoreProperties -> IO b -> IO b
pokeCStruct "pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p ExternalSemaphoreProperties{ExternalSemaphoreHandleTypeFlagBits
ExternalSemaphoreFeatureFlags
externalSemaphoreFeatures :: ExternalSemaphoreFeatureFlags
compatibleHandleTypes :: ExternalSemaphoreHandleTypeFlagBits
exportFromImportedHandleTypes :: ExternalSemaphoreHandleTypeFlagBits
$sel:externalSemaphoreFeatures:ExternalSemaphoreProperties :: ExternalSemaphoreProperties -> ExternalSemaphoreFeatureFlags
$sel:compatibleHandleTypes:ExternalSemaphoreProperties :: ExternalSemaphoreProperties -> ExternalSemaphoreHandleTypeFlagBits
$sel:exportFromImportedHandleTypes:ExternalSemaphoreProperties :: ExternalSemaphoreProperties -> ExternalSemaphoreHandleTypeFlagBits
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_EXTERNAL_SEMAPHORE_PROPERTIES)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ExternalSemaphoreHandleTypeFlags)) (ExternalSemaphoreHandleTypeFlagBits
exportFromImportedHandleTypes)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr ExternalSemaphoreHandleTypeFlags)) (ExternalSemaphoreHandleTypeFlagBits
compatibleHandleTypes)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ExternalSemaphoreFeatureFlags)) (ExternalSemaphoreFeatureFlags
externalSemaphoreFeatures)
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pExternalSemaphoreProperties"
 ::: Ptr ExternalSemaphoreProperties)
-> IO b -> IO b
pokeZeroCStruct "pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_EXTERNAL_SEMAPHORE_PROPERTIES)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ExternalSemaphoreHandleTypeFlags)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr ExternalSemaphoreHandleTypeFlags)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct ExternalSemaphoreProperties where
  peekCStruct :: ("pExternalSemaphoreProperties"
 ::: Ptr ExternalSemaphoreProperties)
-> IO ExternalSemaphoreProperties
peekCStruct "pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p = do
    ExternalSemaphoreHandleTypeFlagBits
exportFromImportedHandleTypes <- forall a. Storable a => Ptr a -> IO a
peek @ExternalSemaphoreHandleTypeFlags (("pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ExternalSemaphoreHandleTypeFlags))
    ExternalSemaphoreHandleTypeFlagBits
compatibleHandleTypes <- forall a. Storable a => Ptr a -> IO a
peek @ExternalSemaphoreHandleTypeFlags (("pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr ExternalSemaphoreHandleTypeFlags))
    ExternalSemaphoreFeatureFlags
externalSemaphoreFeatures <- forall a. Storable a => Ptr a -> IO a
peek @ExternalSemaphoreFeatureFlags (("pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ExternalSemaphoreFeatureFlags))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ExternalSemaphoreHandleTypeFlagBits
-> ExternalSemaphoreHandleTypeFlagBits
-> ExternalSemaphoreFeatureFlags
-> ExternalSemaphoreProperties
ExternalSemaphoreProperties
             ExternalSemaphoreHandleTypeFlagBits
exportFromImportedHandleTypes
             ExternalSemaphoreHandleTypeFlagBits
compatibleHandleTypes
             ExternalSemaphoreFeatureFlags
externalSemaphoreFeatures

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

instance Zero ExternalSemaphoreProperties where
  zero :: ExternalSemaphoreProperties
zero = ExternalSemaphoreHandleTypeFlagBits
-> ExternalSemaphoreHandleTypeFlagBits
-> ExternalSemaphoreFeatureFlags
-> ExternalSemaphoreProperties
ExternalSemaphoreProperties
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero