{-# language CPP #-}
module Vulkan.Core10.Event ( createEvent
, withEvent
, destroyEvent
, getEventStatus
, setEvent
, resetEvent
, EventCreateInfo(..)
, Event(..)
, EventCreateFlagBits(..)
, EventCreateFlags
) where
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Typeable (eqT)
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 (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(peek))
import Foreign.Storable (Storable(poke))
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.NamedType ((:::))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks)
import Vulkan.CStruct.Extends (Chain)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkCreateEvent))
import Vulkan.Dynamic (DeviceCmds(pVkDestroyEvent))
import Vulkan.Dynamic (DeviceCmds(pVkGetEventStatus))
import Vulkan.Dynamic (DeviceCmds(pVkResetEvent))
import Vulkan.Dynamic (DeviceCmds(pVkSetEvent))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Core10.Handles (Event)
import Vulkan.Core10.Handles (Event(..))
import Vulkan.Core10.Enums.EventCreateFlagBits (EventCreateFlags)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_metal_objects (ExportMetalObjectCreateInfoEXT)
import Vulkan.CStruct.Extends (Extends)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.CStruct.Extends (Extensible(..))
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_metal_objects (ImportMetalSharedEventInfoEXT)
import Vulkan.CStruct.Extends (PeekChain)
import Vulkan.CStruct.Extends (PeekChain(..))
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (PokeChain(..))
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.CStruct.Extends (SomeStruct)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_EVENT_CREATE_INFO))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Core10.Handles (Event(..))
import Vulkan.Core10.Enums.EventCreateFlagBits (EventCreateFlagBits(..))
import Vulkan.Core10.Enums.EventCreateFlagBits (EventCreateFlags)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkCreateEvent
:: FunPtr (Ptr Device_T -> Ptr (SomeStruct EventCreateInfo) -> Ptr AllocationCallbacks -> Ptr Event -> IO Result) -> Ptr Device_T -> Ptr (SomeStruct EventCreateInfo) -> Ptr AllocationCallbacks -> Ptr Event -> IO Result
createEvent :: forall a io
. (Extendss EventCreateInfo a, PokeChain a, MonadIO io)
=>
Device
->
(EventCreateInfo a)
->
("allocator" ::: Maybe AllocationCallbacks)
-> io (Event)
createEvent :: forall (a :: [*]) (io :: * -> *).
(Extendss EventCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> EventCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io Event
createEvent Device
device EventCreateInfo a
createInfo "allocator" ::: Maybe AllocationCallbacks
allocator = IO Event -> io Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> io Event)
-> (ContT Event IO Event -> IO Event)
-> ContT Event IO Event
-> io Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Event IO Event -> IO Event
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Event IO Event -> io Event)
-> ContT Event IO Event -> io Event
forall a b. (a -> b) -> a -> b
$ do
let vkCreateEventPtr :: FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct EventCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pEvent" ::: Ptr Event)
-> IO Result)
vkCreateEventPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct EventCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pEvent" ::: Ptr Event)
-> IO Result)
pVkCreateEvent (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
IO () -> ContT Event IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Event IO ()) -> IO () -> ContT Event IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct EventCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pEvent" ::: Ptr Event)
-> IO Result)
vkCreateEventPtr FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct EventCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pEvent" ::: Ptr Event)
-> IO Result)
-> FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct EventCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pEvent" ::: Ptr Event)
-> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct EventCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pEvent" ::: Ptr Event)
-> 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 vkCreateEvent is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
let vkCreateEvent' :: Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct EventCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pEvent" ::: Ptr Event)
-> IO Result
vkCreateEvent' = FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct EventCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pEvent" ::: Ptr Event)
-> IO Result)
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct EventCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pEvent" ::: Ptr Event)
-> IO Result
mkVkCreateEvent FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct EventCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pEvent" ::: Ptr Event)
-> IO Result)
vkCreateEventPtr
Ptr (EventCreateInfo a)
pCreateInfo <- ((Ptr (EventCreateInfo a) -> IO Event) -> IO Event)
-> ContT Event IO (Ptr (EventCreateInfo a))
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (EventCreateInfo a) -> IO Event) -> IO Event)
-> ContT Event IO (Ptr (EventCreateInfo a)))
-> ((Ptr (EventCreateInfo a) -> IO Event) -> IO Event)
-> ContT Event IO (Ptr (EventCreateInfo a))
forall a b. (a -> b) -> a -> b
$ EventCreateInfo a
-> (Ptr (EventCreateInfo a) -> IO Event) -> IO Event
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (EventCreateInfo a
createInfo)
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
"allocator" ::: Maybe AllocationCallbacks
Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT Event IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
Just AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO Event)
-> IO Event)
-> ContT Event IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO Event)
-> IO Event)
-> ContT Event IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO Event)
-> IO Event)
-> ContT Event IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO Event)
-> IO Event
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
"pEvent" ::: Ptr Event
pPEvent <- ((("pEvent" ::: Ptr Event) -> IO Event) -> IO Event)
-> ContT Event IO ("pEvent" ::: Ptr Event)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pEvent" ::: Ptr Event) -> IO Event) -> IO Event)
-> ContT Event IO ("pEvent" ::: Ptr Event))
-> ((("pEvent" ::: Ptr Event) -> IO Event) -> IO Event)
-> ContT Event IO ("pEvent" ::: Ptr Event)
forall a b. (a -> b) -> a -> b
$ IO ("pEvent" ::: Ptr Event)
-> (("pEvent" ::: Ptr Event) -> IO ())
-> (("pEvent" ::: Ptr Event) -> IO Event)
-> IO Event
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @Event Int
8) ("pEvent" ::: Ptr Event) -> IO ()
forall a. Ptr a -> IO ()
free
Result
r <- IO Result -> ContT Event IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT Event IO Result)
-> IO Result -> ContT Event IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCreateEvent" (Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct EventCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pEvent" ::: Ptr Event)
-> IO Result
vkCreateEvent'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(Ptr (EventCreateInfo a)
-> "pCreateInfo" ::: Ptr (SomeStruct EventCreateInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (EventCreateInfo a)
pCreateInfo)
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator
("pEvent" ::: Ptr Event
pPEvent))
IO () -> ContT Event IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Event IO ()) -> IO () -> ContT Event 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))
Event
pEvent <- IO Event -> ContT Event IO Event
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Event -> ContT Event IO Event)
-> IO Event -> ContT Event IO Event
forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Event "pEvent" ::: Ptr Event
pPEvent
Event -> ContT Event IO Event
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event -> ContT Event IO Event) -> Event -> ContT Event IO Event
forall a b. (a -> b) -> a -> b
$ (Event
pEvent)
withEvent :: forall a io r . (Extendss EventCreateInfo a, PokeChain a, MonadIO io) => Device -> EventCreateInfo a -> Maybe AllocationCallbacks -> (io Event -> (Event -> io ()) -> r) -> r
withEvent :: forall (a :: [*]) (io :: * -> *) r.
(Extendss EventCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> EventCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io Event -> (Event -> io ()) -> r)
-> r
withEvent Device
device EventCreateInfo a
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator io Event -> (Event -> io ()) -> r
b =
io Event -> (Event -> io ()) -> r
b (Device
-> EventCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io Event
forall (a :: [*]) (io :: * -> *).
(Extendss EventCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> EventCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io Event
createEvent Device
device EventCreateInfo a
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
(\(Event
o0) -> Device
-> Event -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
forall (io :: * -> *).
MonadIO io =>
Device
-> Event -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
destroyEvent Device
device Event
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkDestroyEvent
:: FunPtr (Ptr Device_T -> Event -> Ptr AllocationCallbacks -> IO ()) -> Ptr Device_T -> Event -> Ptr AllocationCallbacks -> IO ()
destroyEvent :: forall io
. (MonadIO io)
=>
Device
->
Event
->
("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyEvent :: forall (io :: * -> *).
MonadIO io =>
Device
-> Event -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
destroyEvent Device
device Event
event "allocator" ::: Maybe AllocationCallbacks
allocator = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> io ()) -> ContT () IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
let vkDestroyEventPtr :: FunPtr
(Ptr Device_T
-> Event -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroyEventPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> Event -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
pVkDestroyEvent (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> Event -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroyEventPtr FunPtr
(Ptr Device_T
-> Event -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
-> FunPtr
(Ptr Device_T
-> Event -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(Ptr Device_T
-> Event -> ("pAllocator" ::: Ptr AllocationCallbacks) -> 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 String
"" String
"The function pointer for vkDestroyEvent is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
let vkDestroyEvent' :: Ptr Device_T
-> Event -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroyEvent' = FunPtr
(Ptr Device_T
-> Event -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
-> Ptr Device_T
-> Event
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroyEvent FunPtr
(Ptr Device_T
-> Event -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroyEventPtr
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
"allocator" ::: Maybe AllocationCallbacks
Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
Just AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkDestroyEvent" (Ptr Device_T
-> Event -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroyEvent'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(Event
event)
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator)
() -> ContT () IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkGetEventStatus
:: FunPtr (Ptr Device_T -> Event -> IO Result) -> Ptr Device_T -> Event -> IO Result
getEventStatus :: forall io
. (MonadIO io)
=>
Device
->
Event
-> io (Result)
getEventStatus :: forall (io :: * -> *). MonadIO io => Device -> Event -> io Result
getEventStatus Device
device Event
event = IO Result -> io Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> io Result) -> IO Result -> io Result
forall a b. (a -> b) -> a -> b
$ do
let vkGetEventStatusPtr :: FunPtr (Ptr Device_T -> Event -> IO Result)
vkGetEventStatusPtr = DeviceCmds -> FunPtr (Ptr Device_T -> Event -> IO Result)
pVkGetEventStatus (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr (Ptr Device_T -> Event -> IO Result)
vkGetEventStatusPtr FunPtr (Ptr Device_T -> Event -> IO Result)
-> FunPtr (Ptr Device_T -> Event -> IO Result) -> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr (Ptr Device_T -> Event -> 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 vkGetEventStatus is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
let vkGetEventStatus' :: Ptr Device_T -> Event -> IO Result
vkGetEventStatus' = FunPtr (Ptr Device_T -> Event -> IO Result)
-> Ptr Device_T -> Event -> IO Result
mkVkGetEventStatus FunPtr (Ptr Device_T -> Event -> IO Result)
vkGetEventStatusPtr
Result
r <- String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetEventStatus" (Ptr Device_T -> Event -> IO Result
vkGetEventStatus'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(Event
event))
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))
Result -> IO Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$ (Result
r)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkSetEvent
:: FunPtr (Ptr Device_T -> Event -> IO Result) -> Ptr Device_T -> Event -> IO Result
setEvent :: forall io
. (MonadIO io)
=>
Device
->
Event
-> io ()
setEvent :: forall (io :: * -> *). MonadIO io => Device -> Event -> io ()
setEvent Device
device Event
event = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
let vkSetEventPtr :: FunPtr (Ptr Device_T -> Event -> IO Result)
vkSetEventPtr = DeviceCmds -> FunPtr (Ptr Device_T -> Event -> IO Result)
pVkSetEvent (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr (Ptr Device_T -> Event -> IO Result)
vkSetEventPtr FunPtr (Ptr Device_T -> Event -> IO Result)
-> FunPtr (Ptr Device_T -> Event -> IO Result) -> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr (Ptr Device_T -> Event -> 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 vkSetEvent is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
let vkSetEvent' :: Ptr Device_T -> Event -> IO Result
vkSetEvent' = FunPtr (Ptr Device_T -> Event -> IO Result)
-> Ptr Device_T -> Event -> IO Result
mkVkSetEvent FunPtr (Ptr Device_T -> Event -> IO Result)
vkSetEventPtr
Result
r <- String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkSetEvent" (Ptr Device_T -> Event -> IO Result
vkSetEvent'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(Event
event))
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))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkResetEvent
:: FunPtr (Ptr Device_T -> Event -> IO Result) -> Ptr Device_T -> Event -> IO Result
resetEvent :: forall io
. (MonadIO io)
=>
Device
->
Event
-> io ()
resetEvent :: forall (io :: * -> *). MonadIO io => Device -> Event -> io ()
resetEvent Device
device Event
event = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
let vkResetEventPtr :: FunPtr (Ptr Device_T -> Event -> IO Result)
vkResetEventPtr = DeviceCmds -> FunPtr (Ptr Device_T -> Event -> IO Result)
pVkResetEvent (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr (Ptr Device_T -> Event -> IO Result)
vkResetEventPtr FunPtr (Ptr Device_T -> Event -> IO Result)
-> FunPtr (Ptr Device_T -> Event -> IO Result) -> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr (Ptr Device_T -> Event -> 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 vkResetEvent is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
let vkResetEvent' :: Ptr Device_T -> Event -> IO Result
vkResetEvent' = FunPtr (Ptr Device_T -> Event -> IO Result)
-> Ptr Device_T -> Event -> IO Result
mkVkResetEvent FunPtr (Ptr Device_T -> Event -> IO Result)
vkResetEventPtr
Result
r <- String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkResetEvent" (Ptr Device_T -> Event -> IO Result
vkResetEvent'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(Event
event))
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))
data EventCreateInfo (es :: [Type]) = EventCreateInfo
{
forall (es :: [*]). EventCreateInfo es -> Chain es
next :: Chain es
,
forall (es :: [*]). EventCreateInfo es -> EventCreateFlags
flags :: EventCreateFlags
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (EventCreateInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (EventCreateInfo es)
instance Extensible EventCreateInfo where
extensibleTypeName :: String
extensibleTypeName = String
"EventCreateInfo"
setNext :: forall (ds :: [*]) (es :: [*]).
EventCreateInfo ds -> Chain es -> EventCreateInfo es
setNext EventCreateInfo{Chain ds
EventCreateFlags
flags :: EventCreateFlags
next :: Chain ds
$sel:flags:EventCreateInfo :: forall (es :: [*]). EventCreateInfo es -> EventCreateFlags
$sel:next:EventCreateInfo :: forall (es :: [*]). EventCreateInfo es -> Chain es
..} Chain es
next' = EventCreateInfo :: forall (es :: [*]).
Chain es -> EventCreateFlags -> EventCreateInfo es
EventCreateInfo{$sel:next:EventCreateInfo :: Chain es
next = Chain es
next', EventCreateFlags
flags :: EventCreateFlags
$sel:flags:EventCreateInfo :: EventCreateFlags
..}
getNext :: forall (es :: [*]). EventCreateInfo es -> Chain es
getNext EventCreateInfo{Chain es
EventCreateFlags
flags :: EventCreateFlags
next :: Chain es
$sel:flags:EventCreateInfo :: forall (es :: [*]). EventCreateInfo es -> EventCreateFlags
$sel:next:EventCreateInfo :: forall (es :: [*]). EventCreateInfo es -> Chain es
..} = Chain es
next
extends :: forall e b proxy. Typeable e => proxy e -> (Extends EventCreateInfo e => b) -> Maybe b
extends :: forall e b (proxy :: * -> *).
Typeable e =>
proxy e -> (Extends EventCreateInfo e => b) -> Maybe b
extends proxy e
_ Extends EventCreateInfo e => b
f
| Just e :~: ImportMetalSharedEventInfoEXT
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @e @ImportMetalSharedEventInfoEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends EventCreateInfo e => b
f
| Just e :~: ExportMetalObjectCreateInfoEXT
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @e @ExportMetalObjectCreateInfoEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends EventCreateInfo e => b
f
| Bool
otherwise = Maybe b
forall a. Maybe a
Nothing
instance ( Extendss EventCreateInfo es
, PokeChain es ) => ToCStruct (EventCreateInfo es) where
withCStruct :: forall b.
EventCreateInfo es -> (Ptr (EventCreateInfo es) -> IO b) -> IO b
withCStruct EventCreateInfo es
x Ptr (EventCreateInfo es) -> IO b
f = Int -> (Ptr (EventCreateInfo es) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr (EventCreateInfo es) -> IO b) -> IO b)
-> (Ptr (EventCreateInfo es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr (EventCreateInfo es)
p -> Ptr (EventCreateInfo es) -> EventCreateInfo es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (EventCreateInfo es)
p EventCreateInfo es
x (Ptr (EventCreateInfo es) -> IO b
f Ptr (EventCreateInfo es)
p)
pokeCStruct :: forall b.
Ptr (EventCreateInfo es) -> EventCreateInfo es -> IO b -> IO b
pokeCStruct Ptr (EventCreateInfo es)
p EventCreateInfo{Chain es
EventCreateFlags
flags :: EventCreateFlags
next :: Chain es
$sel:flags:EventCreateInfo :: forall (es :: [*]). EventCreateInfo es -> EventCreateFlags
$sel:next:EventCreateInfo :: forall (es :: [*]). EventCreateInfo es -> Chain es
..} 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 (EventCreateInfo es)
p Ptr (EventCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_EVENT_CREATE_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 (EventCreateInfo es)
p Ptr (EventCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
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 EventCreateFlags -> EventCreateFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (EventCreateInfo es)
p Ptr (EventCreateInfo es) -> Int -> Ptr EventCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr EventCreateFlags)) (EventCreateFlags
flags)
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 = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b. Ptr (EventCreateInfo es) -> IO b -> IO b
pokeZeroCStruct Ptr (EventCreateInfo es)
p 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 (EventCreateInfo es)
p Ptr (EventCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_EVENT_CREATE_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 (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 (EventCreateInfo es)
p Ptr (EventCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext'
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 EventCreateInfo es
, PeekChain es ) => FromCStruct (EventCreateInfo es) where
peekCStruct :: Ptr (EventCreateInfo es) -> IO (EventCreateInfo es)
peekCStruct Ptr (EventCreateInfo es)
p = do
Ptr ()
pNext <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (EventCreateInfo es)
p Ptr (EventCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
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)
EventCreateFlags
flags <- forall a. Storable a => Ptr a -> IO a
peek @EventCreateFlags ((Ptr (EventCreateInfo es)
p Ptr (EventCreateInfo es) -> Int -> Ptr EventCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr EventCreateFlags))
EventCreateInfo es -> IO (EventCreateInfo es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EventCreateInfo es -> IO (EventCreateInfo es))
-> EventCreateInfo es -> IO (EventCreateInfo es)
forall a b. (a -> b) -> a -> b
$ Chain es -> EventCreateFlags -> EventCreateInfo es
forall (es :: [*]).
Chain es -> EventCreateFlags -> EventCreateInfo es
EventCreateInfo
Chain es
next EventCreateFlags
flags
instance es ~ '[] => Zero (EventCreateInfo es) where
zero :: EventCreateInfo es
zero = Chain es -> EventCreateFlags -> EventCreateInfo es
forall (es :: [*]).
Chain es -> EventCreateFlags -> EventCreateInfo es
EventCreateInfo
()
EventCreateFlags
forall a. Zero a => a
zero