{-# language CPP #-}
module Vulkan.Core11.Promoted_From_VK_KHR_external_semaphore_capabilities  ( getPhysicalDeviceExternalSemaphoreProperties
                                                                           , PhysicalDeviceExternalSemaphoreInfo(..)
                                                                           , ExternalSemaphoreProperties(..)
                                                                           , StructureType(..)
                                                                           , ExternalSemaphoreHandleTypeFlagBits(..)
                                                                           , ExternalSemaphoreHandleTypeFlags
                                                                           , ExternalSemaphoreFeatureFlagBits(..)
                                                                           , ExternalSemaphoreFeatureFlags
                                                                           ) where

import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytesAligned)
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 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.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
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_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.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
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
--
-- '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.
                                                --
                                                -- @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'.
                                                --
                                                -- @pExternalSemaphoreInfo@ /must/ be a valid pointer to a valid
                                                -- 'PhysicalDeviceExternalSemaphoreInfo' structure
                                                (PhysicalDeviceExternalSemaphoreInfo a)
                                             -> io (ExternalSemaphoreProperties)
getPhysicalDeviceExternalSemaphoreProperties :: PhysicalDevice
-> PhysicalDeviceExternalSemaphoreInfo a
-> io ExternalSemaphoreProperties
getPhysicalDeviceExternalSemaphoreProperties physicalDevice :: PhysicalDevice
physicalDevice externalSemaphoreInfo :: PhysicalDeviceExternalSemaphoreInfo a
externalSemaphoreInfo = IO ExternalSemaphoreProperties -> io ExternalSemaphoreProperties
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ExternalSemaphoreProperties -> io ExternalSemaphoreProperties)
-> (ContT
      ExternalSemaphoreProperties IO ExternalSemaphoreProperties
    -> IO ExternalSemaphoreProperties)
-> ContT ExternalSemaphoreProperties IO ExternalSemaphoreProperties
-> io ExternalSemaphoreProperties
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT ExternalSemaphoreProperties IO ExternalSemaphoreProperties
-> IO ExternalSemaphoreProperties
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT ExternalSemaphoreProperties IO ExternalSemaphoreProperties
 -> io ExternalSemaphoreProperties)
-> ContT ExternalSemaphoreProperties IO ExternalSemaphoreProperties
-> io ExternalSemaphoreProperties
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 (PhysicalDevice -> InstanceCmds
instanceCmds (PhysicalDevice
physicalDevice :: PhysicalDevice))
  IO () -> ContT ExternalSemaphoreProperties IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ExternalSemaphoreProperties IO ())
-> IO () -> ContT ExternalSemaphoreProperties IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr PhysicalDevice_T
   -> ("pExternalSemaphoreInfo"
       ::: Ptr (SomeStruct PhysicalDeviceExternalSemaphoreInfo))
   -> ("pExternalSemaphoreProperties"
       ::: Ptr ExternalSemaphoreProperties)
   -> IO ())
vkGetPhysicalDeviceExternalSemaphorePropertiesPtr FunPtr
  (Ptr PhysicalDevice_T
   -> ("pExternalSemaphoreInfo"
       ::: Ptr (SomeStruct PhysicalDeviceExternalSemaphoreInfo))
   -> ("pExternalSemaphoreProperties"
       ::: Ptr ExternalSemaphoreProperties)
   -> IO ())
-> FunPtr
     (Ptr PhysicalDevice_T
      -> ("pExternalSemaphoreInfo"
          ::: Ptr (SomeStruct PhysicalDeviceExternalSemaphoreInfo))
      -> ("pExternalSemaphoreProperties"
          ::: Ptr ExternalSemaphoreProperties)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr PhysicalDevice_T
   -> ("pExternalSemaphoreInfo"
       ::: Ptr (SomeStruct PhysicalDeviceExternalSemaphoreInfo))
   -> ("pExternalSemaphoreProperties"
       ::: Ptr ExternalSemaphoreProperties)
   -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkGetPhysicalDeviceExternalSemaphoreProperties is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
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 <- ((Ptr (PhysicalDeviceExternalSemaphoreInfo a)
  -> IO ExternalSemaphoreProperties)
 -> IO ExternalSemaphoreProperties)
-> ContT
     ExternalSemaphoreProperties
     IO
     (Ptr (PhysicalDeviceExternalSemaphoreInfo a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (PhysicalDeviceExternalSemaphoreInfo a)
   -> IO ExternalSemaphoreProperties)
  -> IO ExternalSemaphoreProperties)
 -> ContT
      ExternalSemaphoreProperties
      IO
      (Ptr (PhysicalDeviceExternalSemaphoreInfo a)))
-> ((Ptr (PhysicalDeviceExternalSemaphoreInfo a)
     -> IO ExternalSemaphoreProperties)
    -> IO ExternalSemaphoreProperties)
-> ContT
     ExternalSemaphoreProperties
     IO
     (Ptr (PhysicalDeviceExternalSemaphoreInfo a))
forall a b. (a -> b) -> a -> b
$ PhysicalDeviceExternalSemaphoreInfo a
-> (Ptr (PhysicalDeviceExternalSemaphoreInfo a)
    -> IO ExternalSemaphoreProperties)
-> IO ExternalSemaphoreProperties
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (PhysicalDeviceExternalSemaphoreInfo a
externalSemaphoreInfo)
  "pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
pPExternalSemaphoreProperties <- ((("pExternalSemaphoreProperties"
   ::: Ptr ExternalSemaphoreProperties)
  -> IO ExternalSemaphoreProperties)
 -> IO ExternalSemaphoreProperties)
-> ContT
     ExternalSemaphoreProperties
     IO
     ("pExternalSemaphoreProperties"
      ::: Ptr ExternalSemaphoreProperties)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct ExternalSemaphoreProperties =>
(("pExternalSemaphoreProperties"
  ::: Ptr ExternalSemaphoreProperties)
 -> IO b)
-> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @ExternalSemaphoreProperties)
  IO () -> ContT ExternalSemaphoreProperties IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ExternalSemaphoreProperties IO ())
-> IO () -> ContT ExternalSemaphoreProperties IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PhysicalDevice_T
-> ("pExternalSemaphoreInfo"
    ::: Ptr (SomeStruct PhysicalDeviceExternalSemaphoreInfo))
-> ("pExternalSemaphoreProperties"
    ::: Ptr ExternalSemaphoreProperties)
-> IO ()
vkGetPhysicalDeviceExternalSemaphoreProperties' (PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice)) (Ptr (PhysicalDeviceExternalSemaphoreInfo a)
-> "pExternalSemaphoreInfo"
   ::: Ptr (SomeStruct PhysicalDeviceExternalSemaphoreInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (PhysicalDeviceExternalSemaphoreInfo a)
pExternalSemaphoreInfo) ("pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
pPExternalSemaphoreProperties)
  ExternalSemaphoreProperties
pExternalSemaphoreProperties <- IO ExternalSemaphoreProperties
-> ContT ExternalSemaphoreProperties IO ExternalSemaphoreProperties
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ExternalSemaphoreProperties
 -> ContT
      ExternalSemaphoreProperties IO ExternalSemaphoreProperties)
-> IO ExternalSemaphoreProperties
-> ContT ExternalSemaphoreProperties IO ExternalSemaphoreProperties
forall a b. (a -> b) -> a -> b
$ ("pExternalSemaphoreProperties"
 ::: Ptr ExternalSemaphoreProperties)
-> IO ExternalSemaphoreProperties
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ExternalSemaphoreProperties "pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
pPExternalSemaphoreProperties
  ExternalSemaphoreProperties
-> ContT ExternalSemaphoreProperties IO ExternalSemaphoreProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExternalSemaphoreProperties
 -> ContT
      ExternalSemaphoreProperties IO ExternalSemaphoreProperties)
-> ExternalSemaphoreProperties
-> ContT ExternalSemaphoreProperties IO ExternalSemaphoreProperties
forall a b. (a -> b) -> a -> b
$ (ExternalSemaphoreProperties
pExternalSemaphoreProperties)


-- | VkPhysicalDeviceExternalSemaphoreInfo - Structure specifying semaphore
-- creation parameters.
--
-- == Valid Usage (Implicit)
--
-- -   @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_EXTERNAL_SEMAPHORE_INFO'
--
-- -   @pNext@ /must/ be @NULL@ or a pointer to a valid instance of
--     'Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore.SemaphoreTypeCreateInfo'
--
-- -   The @sType@ value of each struct in the @pNext@ chain /must/ be
--     unique
--
-- -   @handleType@ /must/ be a valid
--     'Vulkan.Core11.Enums.ExternalSemaphoreHandleTypeFlagBits.ExternalSemaphoreHandleTypeFlagBits'
--     value
--
-- = See Also
--
-- '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.
    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.
    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
  extensibleType :: StructureType
extensibleType = StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_EXTERNAL_SEMAPHORE_INFO
  setNext :: PhysicalDeviceExternalSemaphoreInfo ds
-> Chain es -> PhysicalDeviceExternalSemaphoreInfo es
setNext x :: PhysicalDeviceExternalSemaphoreInfo ds
x next :: Chain es
next = PhysicalDeviceExternalSemaphoreInfo ds
x{$sel:next:PhysicalDeviceExternalSemaphoreInfo :: Chain es
next = Chain es
next}
  getNext :: PhysicalDeviceExternalSemaphoreInfo es -> Chain es
getNext PhysicalDeviceExternalSemaphoreInfo{..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends PhysicalDeviceExternalSemaphoreInfo e => b) -> Maybe b
  extends :: proxy e
-> (Extends PhysicalDeviceExternalSemaphoreInfo e => b) -> Maybe b
extends _ f :: Extends PhysicalDeviceExternalSemaphoreInfo e => b
f
    | Just Refl <- (Typeable e, Typeable SemaphoreTypeCreateInfo) =>
Maybe (e :~: SemaphoreTypeCreateInfo)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @SemaphoreTypeCreateInfo = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends PhysicalDeviceExternalSemaphoreInfo e => b
f
    | Bool
otherwise = Maybe b
forall a. Maybe a
Nothing

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

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

instance es ~ '[] => Zero (PhysicalDeviceExternalSemaphoreInfo es) where
  zero :: PhysicalDeviceExternalSemaphoreInfo es
zero = Chain es
-> ExternalSemaphoreHandleTypeFlagBits
-> PhysicalDeviceExternalSemaphoreInfo es
forall (es :: [*]).
Chain es
-> ExternalSemaphoreHandleTypeFlagBits
-> PhysicalDeviceExternalSemaphoreInfo es
PhysicalDeviceExternalSemaphoreInfo
           ()
           ExternalSemaphoreHandleTypeFlagBits
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
--
-- '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
(ExternalSemaphoreProperties
 -> ExternalSemaphoreProperties -> Bool)
-> (ExternalSemaphoreProperties
    -> ExternalSemaphoreProperties -> Bool)
-> Eq ExternalSemaphoreProperties
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 :: ExternalSemaphoreProperties
-> (("pExternalSemaphoreProperties"
     ::: Ptr ExternalSemaphoreProperties)
    -> IO b)
-> IO b
withCStruct x :: ExternalSemaphoreProperties
x f :: ("pExternalSemaphoreProperties"
 ::: Ptr ExternalSemaphoreProperties)
-> IO b
f = Int
-> Int
-> (("pExternalSemaphoreProperties"
     ::: Ptr ExternalSemaphoreProperties)
    -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((("pExternalSemaphoreProperties"
   ::: Ptr ExternalSemaphoreProperties)
  -> IO b)
 -> IO b)
-> (("pExternalSemaphoreProperties"
     ::: Ptr ExternalSemaphoreProperties)
    -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \p :: "pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p -> ("pExternalSemaphoreProperties"
 ::: Ptr ExternalSemaphoreProperties)
-> ExternalSemaphoreProperties -> IO b -> IO b
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 :: ("pExternalSemaphoreProperties"
 ::: Ptr ExternalSemaphoreProperties)
-> ExternalSemaphoreProperties -> IO b -> IO b
pokeCStruct p :: "pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p ExternalSemaphoreProperties{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p ("pExternalSemaphoreProperties"
 ::: Ptr ExternalSemaphoreProperties)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_EXTERNAL_SEMAPHORE_PROPERTIES)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p ("pExternalSemaphoreProperties"
 ::: Ptr ExternalSemaphoreProperties)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ExternalSemaphoreHandleTypeFlagBits
-> ExternalSemaphoreHandleTypeFlagBits -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p ("pExternalSemaphoreProperties"
 ::: Ptr ExternalSemaphoreProperties)
-> Int -> Ptr ExternalSemaphoreHandleTypeFlagBits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr ExternalSemaphoreHandleTypeFlags)) (ExternalSemaphoreHandleTypeFlagBits
exportFromImportedHandleTypes)
    Ptr ExternalSemaphoreHandleTypeFlagBits
-> ExternalSemaphoreHandleTypeFlagBits -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p ("pExternalSemaphoreProperties"
 ::: Ptr ExternalSemaphoreProperties)
-> Int -> Ptr ExternalSemaphoreHandleTypeFlagBits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr ExternalSemaphoreHandleTypeFlags)) (ExternalSemaphoreHandleTypeFlagBits
compatibleHandleTypes)
    Ptr ExternalSemaphoreFeatureFlags
-> ExternalSemaphoreFeatureFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p ("pExternalSemaphoreProperties"
 ::: Ptr ExternalSemaphoreProperties)
-> Int -> Ptr ExternalSemaphoreFeatureFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr ExternalSemaphoreFeatureFlags)) (ExternalSemaphoreFeatureFlags
externalSemaphoreFeatures)
    IO b
f
  cStructSize :: Int
cStructSize = 32
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: ("pExternalSemaphoreProperties"
 ::: Ptr ExternalSemaphoreProperties)
-> IO b -> IO b
pokeZeroCStruct p :: "pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p ("pExternalSemaphoreProperties"
 ::: Ptr ExternalSemaphoreProperties)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_EXTERNAL_SEMAPHORE_PROPERTIES)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p ("pExternalSemaphoreProperties"
 ::: Ptr ExternalSemaphoreProperties)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ExternalSemaphoreHandleTypeFlagBits
-> ExternalSemaphoreHandleTypeFlagBits -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p ("pExternalSemaphoreProperties"
 ::: Ptr ExternalSemaphoreProperties)
-> Int -> Ptr ExternalSemaphoreHandleTypeFlagBits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr ExternalSemaphoreHandleTypeFlags)) (ExternalSemaphoreHandleTypeFlagBits
forall a. Zero a => a
zero)
    Ptr ExternalSemaphoreHandleTypeFlagBits
-> ExternalSemaphoreHandleTypeFlagBits -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p ("pExternalSemaphoreProperties"
 ::: Ptr ExternalSemaphoreProperties)
-> Int -> Ptr ExternalSemaphoreHandleTypeFlagBits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr ExternalSemaphoreHandleTypeFlags)) (ExternalSemaphoreHandleTypeFlagBits
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct ExternalSemaphoreProperties where
  peekCStruct :: ("pExternalSemaphoreProperties"
 ::: Ptr ExternalSemaphoreProperties)
-> IO ExternalSemaphoreProperties
peekCStruct p :: "pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p = do
    ExternalSemaphoreHandleTypeFlagBits
exportFromImportedHandleTypes <- Ptr ExternalSemaphoreHandleTypeFlagBits
-> IO ExternalSemaphoreHandleTypeFlagBits
forall a. Storable a => Ptr a -> IO a
peek @ExternalSemaphoreHandleTypeFlags (("pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p ("pExternalSemaphoreProperties"
 ::: Ptr ExternalSemaphoreProperties)
-> Int -> Ptr ExternalSemaphoreHandleTypeFlagBits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr ExternalSemaphoreHandleTypeFlags))
    ExternalSemaphoreHandleTypeFlagBits
compatibleHandleTypes <- Ptr ExternalSemaphoreHandleTypeFlagBits
-> IO ExternalSemaphoreHandleTypeFlagBits
forall a. Storable a => Ptr a -> IO a
peek @ExternalSemaphoreHandleTypeFlags (("pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p ("pExternalSemaphoreProperties"
 ::: Ptr ExternalSemaphoreProperties)
-> Int -> Ptr ExternalSemaphoreHandleTypeFlagBits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr ExternalSemaphoreHandleTypeFlags))
    ExternalSemaphoreFeatureFlags
externalSemaphoreFeatures <- Ptr ExternalSemaphoreFeatureFlags
-> IO ExternalSemaphoreFeatureFlags
forall a. Storable a => Ptr a -> IO a
peek @ExternalSemaphoreFeatureFlags (("pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
p ("pExternalSemaphoreProperties"
 ::: Ptr ExternalSemaphoreProperties)
-> Int -> Ptr ExternalSemaphoreFeatureFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr ExternalSemaphoreFeatureFlags))
    ExternalSemaphoreProperties -> IO ExternalSemaphoreProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExternalSemaphoreProperties -> IO ExternalSemaphoreProperties)
-> ExternalSemaphoreProperties -> IO ExternalSemaphoreProperties
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
_ = 32
  alignment :: ExternalSemaphoreProperties -> Int
alignment ~ExternalSemaphoreProperties
_ = 8
  peek :: ("pExternalSemaphoreProperties"
 ::: Ptr ExternalSemaphoreProperties)
-> IO ExternalSemaphoreProperties
peek = ("pExternalSemaphoreProperties"
 ::: Ptr ExternalSemaphoreProperties)
-> IO ExternalSemaphoreProperties
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: ("pExternalSemaphoreProperties"
 ::: Ptr ExternalSemaphoreProperties)
-> ExternalSemaphoreProperties -> IO ()
poke ptr :: "pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
ptr poked :: ExternalSemaphoreProperties
poked = ("pExternalSemaphoreProperties"
 ::: Ptr ExternalSemaphoreProperties)
-> ExternalSemaphoreProperties -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pExternalSemaphoreProperties" ::: Ptr ExternalSemaphoreProperties
ptr ExternalSemaphoreProperties
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

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