{-# language CPP #-}
-- No documentation found for Chapter "Image"
module OpenXR.Core10.Image  ( enumerateSwapchainFormats
                            , createSwapchain
                            , withSwapchain
                            , destroySwapchain
                            , enumerateSwapchainImages
                            , acquireSwapchainImage
                            , waitSwapchainImage
                            , waitSwapchainImageSafe
                            , releaseSwapchainImage
                            , SwapchainCreateInfo(..)
                            , SwapchainImageBaseHeader(..)
                            , IsSwapchainImage(..)
                            , SwapchainImageAcquireInfo(..)
                            , SwapchainImageWaitInfo(..)
                            , SwapchainImageReleaseInfo(..)
                            ) where

import OpenXR.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Foldable (traverse_)
import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytesAligned)
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 Data.Vector (generateM)
import GHC.IO.Exception (pattern IOError)
import GHC.IO.Exception (pattern InvalidArgument)
import Control.Monad.Trans.Cont (pattern ContT)
import OpenXR.CStruct (FromCStruct)
import OpenXR.CStruct (FromCStruct(..))
import OpenXR.CStruct (ToCStruct)
import OpenXR.CStruct (ToCStruct(..))
import OpenXR.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(..))
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Data.Int (Int64)
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import OpenXR.CStruct.Utils (advancePtrBytes)
import OpenXR.CStruct.Extends (forgetExtensions)
import OpenXR.CStruct.Extends (lowerChildPointer)
import OpenXR.NamedType ((:::))
import OpenXR.CStruct.Extends (Chain)
import OpenXR.Core10.FundamentalTypes (Duration)
import OpenXR.CStruct.Extends (Extends)
import OpenXR.CStruct.Extends (Extendss)
import OpenXR.CStruct.Extends (Extensible(..))
import OpenXR.CStruct.Extends (Inheritable(..))
import OpenXR.CStruct.Extends (Inherits)
import OpenXR.Dynamic (InstanceCmds(..))
import OpenXR.Dynamic (InstanceCmds(pXrAcquireSwapchainImage))
import OpenXR.Dynamic (InstanceCmds(pXrCreateSwapchain))
import OpenXR.Dynamic (InstanceCmds(pXrDestroySwapchain))
import OpenXR.Dynamic (InstanceCmds(pXrEnumerateSwapchainFormats))
import OpenXR.Dynamic (InstanceCmds(pXrReleaseSwapchainImage))
import OpenXR.Dynamic (InstanceCmds(pXrWaitSwapchainImage))
import OpenXR.Exception (OpenXrException(..))
import OpenXR.CStruct.Extends (PeekChain)
import OpenXR.CStruct.Extends (PeekChain(..))
import OpenXR.CStruct.Extends (PokeChain)
import OpenXR.CStruct.Extends (PokeChain(..))
import OpenXR.Core10.Enums.Result (Result)
import OpenXR.Core10.Enums.Result (Result(..))
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_secondary_view_configuration (SecondaryViewConfigurationSwapchainCreateInfoMSFT)
import OpenXR.Core10.Handles (Session)
import OpenXR.Core10.Handles (Session(..))
import OpenXR.Core10.Handles (Session_T)
import OpenXR.CStruct.Extends (SomeChild)
import OpenXR.CStruct.Extends (SomeChild(..))
import OpenXR.CStruct.Extends (SomeStruct)
import OpenXR.Core10.Enums.StructureType (StructureType)
import OpenXR.Core10.Handles (Swapchain)
import OpenXR.Core10.Handles (Swapchain(..))
import OpenXR.Core10.Handles (Swapchain(Swapchain))
import OpenXR.Core10.Enums.SwapchainCreateFlags (SwapchainCreateFlags)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_D3D11_enable (SwapchainImageD3D11KHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_D3D12_enable (SwapchainImageD3D12KHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_opengl_es_enable (SwapchainImageOpenGLESKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_opengl_enable (SwapchainImageOpenGLKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_vulkan_enable (SwapchainImageVulkanKHR)
import OpenXR.Core10.Enums.SwapchainUsageFlags (SwapchainUsageFlags)
import OpenXR.Core10.Handles (Swapchain_T)
import OpenXR.Core10.Enums.Result (Result(SUCCESS))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_SWAPCHAIN_CREATE_INFO))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_SWAPCHAIN_IMAGE_ACQUIRE_INFO))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_SWAPCHAIN_IMAGE_D3D11_KHR))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_SWAPCHAIN_IMAGE_D3D12_KHR))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_SWAPCHAIN_IMAGE_OPENGL_ES_KHR))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_SWAPCHAIN_IMAGE_OPENGL_KHR))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_SWAPCHAIN_IMAGE_RELEASE_INFO))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_SWAPCHAIN_IMAGE_VULKAN_KHR))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_SWAPCHAIN_IMAGE_WAIT_INFO))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrEnumerateSwapchainFormats
  :: FunPtr (Ptr Session_T -> Word32 -> Ptr Word32 -> Ptr Int64 -> IO Result) -> Ptr Session_T -> Word32 -> Ptr Word32 -> Ptr Int64 -> IO Result

-- | xrEnumerateSwapchainFormats - Enumerates swapchain formats
--
-- == Parameter Descriptions
--
-- -   @session@ is the session that enumerates the supported formats.
--
-- -   @formatCapacityInput@ is the capacity of the @formats@, or 0 to
--     retrieve the required capacity.
--
-- -   @formatCountOutput@ is a pointer to the count of @uint64_t@ formats
--     written, or a pointer to the required capacity in the case that
--     @formatCapacityInput@ is @0@.
--
-- -   @formats@ is a pointer to an array of @int64_t@ format ids, but
--     /can/ be @NULL@ if @formatCapacityInput@ is @0@. The format ids are
--     specific to the specified graphics API.
--
-- -   See
--     <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#buffer-size-parameters Buffer Size Parameters>
--     chapter for a detailed description of retrieving the required
--     @formats@ size.
--
-- = Description
--
-- 'enumerateSwapchainFormats' enumerates the texture formats supported by
-- the current session. The type of formats returned are dependent on the
-- graphics API specified in 'OpenXR.Core10.Device.createSession'. For
-- example, if a DirectX graphics API was specified, then the enumerated
-- formats correspond to the DXGI formats, such as
-- @DXGI_FORMAT_R8G8B8A8_UNORM_SRGB@. Texture formats /should/ be in order
-- from highest to lowest runtime preference.
--
-- With an OpenGL-based graphics API, the texture formats correspond to
-- OpenGL internal formats.
--
-- With a Direct3D-based graphics API, 'enumerateSwapchainFormats' never
-- returns typeless formats (e.g. @DXGI_FORMAT_R8G8B8A8_TYPELESS@). Only
-- concrete formats are returned, and only concrete formats may be
-- specified by applications for swapchain creation.
--
-- Runtimes /must/ always return identical buffer contents from this
-- enumeration for the lifetime of the session.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-xrEnumerateSwapchainFormats-session-parameter# @session@
--     /must/ be a valid 'OpenXR.Core10.Handles.Session' handle
--
-- -   #VUID-xrEnumerateSwapchainFormats-formatCountOutput-parameter#
--     @formatCountOutput@ /must/ be a pointer to a @uint32_t@ value
--
-- -   #VUID-xrEnumerateSwapchainFormats-formats-parameter# If
--     @formatCapacityInput@ is not @0@, @formats@ /must/ be a pointer to
--     an array of @formatCapacityInput@ @int64_t@ values
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
--     -   'OpenXR.Core10.Enums.Result.SESSION_LOSS_PENDING'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SIZE_INSUFFICIENT'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Session', 'createSwapchain'
enumerateSwapchainFormats :: forall io
                           . (MonadIO io)
                          => -- No documentation found for Nested "xrEnumerateSwapchainFormats" "session"
                             Session
                          -> io (Result, ("formats" ::: Vector Int64))
enumerateSwapchainFormats :: Session -> io (Result, "formats" ::: Vector Int64)
enumerateSwapchainFormats session :: Session
session = IO (Result, "formats" ::: Vector Int64)
-> io (Result, "formats" ::: Vector Int64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result, "formats" ::: Vector Int64)
 -> io (Result, "formats" ::: Vector Int64))
-> (ContT
      (Result, "formats" ::: Vector Int64)
      IO
      (Result, "formats" ::: Vector Int64)
    -> IO (Result, "formats" ::: Vector Int64))
-> ContT
     (Result, "formats" ::: Vector Int64)
     IO
     (Result, "formats" ::: Vector Int64)
-> io (Result, "formats" ::: Vector Int64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  (Result, "formats" ::: Vector Int64)
  IO
  (Result, "formats" ::: Vector Int64)
-> IO (Result, "formats" ::: Vector Int64)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   (Result, "formats" ::: Vector Int64)
   IO
   (Result, "formats" ::: Vector Int64)
 -> io (Result, "formats" ::: Vector Int64))
-> ContT
     (Result, "formats" ::: Vector Int64)
     IO
     (Result, "formats" ::: Vector Int64)
-> io (Result, "formats" ::: Vector Int64)
forall a b. (a -> b) -> a -> b
$ do
  let xrEnumerateSwapchainFormatsPtr :: FunPtr
  (Ptr Session_T
   -> ("formatCapacityInput" ::: Word32)
   -> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
   -> ("formats" ::: Ptr Int64)
   -> IO Result)
xrEnumerateSwapchainFormatsPtr = InstanceCmds
-> FunPtr
     (Ptr Session_T
      -> ("formatCapacityInput" ::: Word32)
      -> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
      -> ("formats" ::: Ptr Int64)
      -> IO Result)
pXrEnumerateSwapchainFormats (Session -> InstanceCmds
instanceCmds (Session
session :: Session))
  IO () -> ContT (Result, "formats" ::: Vector Int64) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, "formats" ::: Vector Int64) IO ())
-> IO () -> ContT (Result, "formats" ::: Vector Int64) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Session_T
   -> ("formatCapacityInput" ::: Word32)
   -> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
   -> ("formats" ::: Ptr Int64)
   -> IO Result)
xrEnumerateSwapchainFormatsPtr FunPtr
  (Ptr Session_T
   -> ("formatCapacityInput" ::: Word32)
   -> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
   -> ("formats" ::: Ptr Int64)
   -> IO Result)
-> FunPtr
     (Ptr Session_T
      -> ("formatCapacityInput" ::: Word32)
      -> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
      -> ("formats" ::: Ptr Int64)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Session_T
   -> ("formatCapacityInput" ::: Word32)
   -> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
   -> ("formats" ::: Ptr Int64)
   -> 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 "" "The function pointer for xrEnumerateSwapchainFormats is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrEnumerateSwapchainFormats' :: Ptr Session_T
-> ("formatCapacityInput" ::: Word32)
-> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> ("formats" ::: Ptr Int64)
-> IO Result
xrEnumerateSwapchainFormats' = FunPtr
  (Ptr Session_T
   -> ("formatCapacityInput" ::: Word32)
   -> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
   -> ("formats" ::: Ptr Int64)
   -> IO Result)
-> Ptr Session_T
-> ("formatCapacityInput" ::: Word32)
-> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> ("formats" ::: Ptr Int64)
-> IO Result
mkXrEnumerateSwapchainFormats FunPtr
  (Ptr Session_T
   -> ("formatCapacityInput" ::: Word32)
   -> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
   -> ("formats" ::: Ptr Int64)
   -> IO Result)
xrEnumerateSwapchainFormatsPtr
  let session' :: Ptr Session_T
session' = Session -> Ptr Session_T
sessionHandle (Session
session)
  "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
pFormatCountOutput <- ((("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
  -> IO (Result, "formats" ::: Vector Int64))
 -> IO (Result, "formats" ::: Vector Int64))
-> ContT
     (Result, "formats" ::: Vector Int64)
     IO
     ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
   -> IO (Result, "formats" ::: Vector Int64))
  -> IO (Result, "formats" ::: Vector Int64))
 -> ContT
      (Result, "formats" ::: Vector Int64)
      IO
      ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)))
-> ((("formatCountOutput"
      ::: Ptr ("formatCapacityInput" ::: Word32))
     -> IO (Result, "formats" ::: Vector Int64))
    -> IO (Result, "formats" ::: Vector Int64))
-> ContT
     (Result, "formats" ::: Vector Int64)
     IO
     ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
forall a b. (a -> b) -> a -> b
$ IO ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> (("formatCountOutput"
     ::: Ptr ("formatCapacityInput" ::: Word32))
    -> IO ())
-> (("formatCountOutput"
     ::: Ptr ("formatCapacityInput" ::: Word32))
    -> IO (Result, "formats" ::: Vector Int64))
-> IO (Result, "formats" ::: Vector Int64)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int
-> IO
     ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
forall a. Int -> IO (Ptr a)
callocBytes @Word32 4) ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT (Result, "formats" ::: Vector Int64) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT (Result, "formats" ::: Vector Int64) IO Result)
-> IO Result
-> ContT (Result, "formats" ::: Vector Int64) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrEnumerateSwapchainFormats" (Ptr Session_T
-> ("formatCapacityInput" ::: Word32)
-> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> ("formats" ::: Ptr Int64)
-> IO Result
xrEnumerateSwapchainFormats' Ptr Session_T
session' (0) ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
pFormatCountOutput) ("formats" ::: Ptr Int64
forall a. Ptr a
nullPtr))
  IO () -> ContT (Result, "formats" ::: Vector Int64) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, "formats" ::: Vector Int64) IO ())
-> IO () -> ContT (Result, "formats" ::: Vector Int64) 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) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))
  "formatCapacityInput" ::: Word32
formatCountOutput <- IO ("formatCapacityInput" ::: Word32)
-> ContT
     (Result, "formats" ::: Vector Int64)
     IO
     ("formatCapacityInput" ::: Word32)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("formatCapacityInput" ::: Word32)
 -> ContT
      (Result, "formats" ::: Vector Int64)
      IO
      ("formatCapacityInput" ::: Word32))
-> IO ("formatCapacityInput" ::: Word32)
-> ContT
     (Result, "formats" ::: Vector Int64)
     IO
     ("formatCapacityInput" ::: Word32)
forall a b. (a -> b) -> a -> b
$ ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> IO ("formatCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
pFormatCountOutput
  "formats" ::: Ptr Int64
pFormats <- ((("formats" ::: Ptr Int64)
  -> IO (Result, "formats" ::: Vector Int64))
 -> IO (Result, "formats" ::: Vector Int64))
-> ContT
     (Result, "formats" ::: Vector Int64) IO ("formats" ::: Ptr Int64)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("formats" ::: Ptr Int64)
   -> IO (Result, "formats" ::: Vector Int64))
  -> IO (Result, "formats" ::: Vector Int64))
 -> ContT
      (Result, "formats" ::: Vector Int64) IO ("formats" ::: Ptr Int64))
-> ((("formats" ::: Ptr Int64)
     -> IO (Result, "formats" ::: Vector Int64))
    -> IO (Result, "formats" ::: Vector Int64))
-> ContT
     (Result, "formats" ::: Vector Int64) IO ("formats" ::: Ptr Int64)
forall a b. (a -> b) -> a -> b
$ IO ("formats" ::: Ptr Int64)
-> (("formats" ::: Ptr Int64) -> IO ())
-> (("formats" ::: Ptr Int64)
    -> IO (Result, "formats" ::: Vector Int64))
-> IO (Result, "formats" ::: Vector Int64)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("formats" ::: Ptr Int64)
forall a. Int -> IO (Ptr a)
callocBytes @Int64 ((("formatCapacityInput" ::: Word32) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ("formatCapacityInput" ::: Word32
formatCountOutput)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8)) ("formats" ::: Ptr Int64) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r' <- IO Result -> ContT (Result, "formats" ::: Vector Int64) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT (Result, "formats" ::: Vector Int64) IO Result)
-> IO Result
-> ContT (Result, "formats" ::: Vector Int64) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrEnumerateSwapchainFormats" (Ptr Session_T
-> ("formatCapacityInput" ::: Word32)
-> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> ("formats" ::: Ptr Int64)
-> IO Result
xrEnumerateSwapchainFormats' Ptr Session_T
session' (("formatCapacityInput" ::: Word32
formatCountOutput)) ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
pFormatCountOutput) ("formats" ::: Ptr Int64
pFormats))
  IO () -> ContT (Result, "formats" ::: Vector Int64) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, "formats" ::: Vector Int64) IO ())
-> IO () -> ContT (Result, "formats" ::: Vector Int64) 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) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r'))
  "formatCapacityInput" ::: Word32
formatCountOutput' <- IO ("formatCapacityInput" ::: Word32)
-> ContT
     (Result, "formats" ::: Vector Int64)
     IO
     ("formatCapacityInput" ::: Word32)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("formatCapacityInput" ::: Word32)
 -> ContT
      (Result, "formats" ::: Vector Int64)
      IO
      ("formatCapacityInput" ::: Word32))
-> IO ("formatCapacityInput" ::: Word32)
-> ContT
     (Result, "formats" ::: Vector Int64)
     IO
     ("formatCapacityInput" ::: Word32)
forall a b. (a -> b) -> a -> b
$ ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> IO ("formatCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
pFormatCountOutput
  "formats" ::: Vector Int64
formats' <- IO ("formats" ::: Vector Int64)
-> ContT
     (Result, "formats" ::: Vector Int64)
     IO
     ("formats" ::: Vector Int64)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("formats" ::: Vector Int64)
 -> ContT
      (Result, "formats" ::: Vector Int64)
      IO
      ("formats" ::: Vector Int64))
-> IO ("formats" ::: Vector Int64)
-> ContT
     (Result, "formats" ::: Vector Int64)
     IO
     ("formats" ::: Vector Int64)
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> IO Int64) -> IO ("formats" ::: Vector Int64)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (("formatCapacityInput" ::: Word32) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ("formatCapacityInput" ::: Word32
formatCountOutput')) (\i :: Int
i -> ("formats" ::: Ptr Int64) -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek @Int64 (("formats" ::: Ptr Int64
pFormats ("formats" ::: Ptr Int64) -> Int -> "formats" ::: Ptr Int64
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Int64)))
  (Result, "formats" ::: Vector Int64)
-> ContT
     (Result, "formats" ::: Vector Int64)
     IO
     (Result, "formats" ::: Vector Int64)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result, "formats" ::: Vector Int64)
 -> ContT
      (Result, "formats" ::: Vector Int64)
      IO
      (Result, "formats" ::: Vector Int64))
-> (Result, "formats" ::: Vector Int64)
-> ContT
     (Result, "formats" ::: Vector Int64)
     IO
     (Result, "formats" ::: Vector Int64)
forall a b. (a -> b) -> a -> b
$ ((Result
r'), "formats" ::: Vector Int64
formats')


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrCreateSwapchain
  :: FunPtr (Ptr Session_T -> Ptr (SomeStruct SwapchainCreateInfo) -> Ptr (Ptr Swapchain_T) -> IO Result) -> Ptr Session_T -> Ptr (SomeStruct SwapchainCreateInfo) -> Ptr (Ptr Swapchain_T) -> IO Result

-- | xrCreateSwapchain - Creates an XrSwapchain
--
-- == Parameter Descriptions
--
-- = Description
--
-- Creates an 'OpenXR.Core10.Handles.Swapchain' handle. The returned
-- swapchain handle /may/ be subsequently used in API calls. Multiple
-- 'OpenXR.Core10.Handles.Swapchain' handles may exist simultaneously, up
-- to some limit imposed by the runtime. The
-- 'OpenXR.Core10.Handles.Swapchain' handle /must/ be eventually freed via
-- the 'destroySwapchain' function. The runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_SWAPCHAIN_FORMAT_UNSUPPORTED' if the
-- image format specified in the 'SwapchainCreateInfo' is unsupported. The
-- runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_FEATURE_UNSUPPORTED' if any bit of the
-- create flags specified in the 'SwapchainCreateInfo' is unsupported.
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
--     -   'OpenXR.Core10.Enums.Result.SESSION_LOSS_PENDING'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_LIMIT_REACHED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_OUT_OF_MEMORY'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SWAPCHAIN_FORMAT_UNSUPPORTED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_FEATURE_UNSUPPORTED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Session', 'OpenXR.Core10.Handles.Swapchain',
-- 'SwapchainCreateInfo', 'acquireSwapchainImage', 'destroySwapchain',
-- 'enumerateSwapchainFormats', 'enumerateSwapchainImages',
-- 'releaseSwapchainImage'
createSwapchain :: forall a io
                 . (Extendss SwapchainCreateInfo a, PokeChain a, MonadIO io)
                => -- | @session@ is the session that creates the image.
                   --
                   -- #VUID-xrCreateSwapchain-session-parameter# @session@ /must/ be a valid
                   -- 'OpenXR.Core10.Handles.Session' handle
                   Session
                -> -- | @createInfo@ is a pointer to an 'SwapchainCreateInfo' structure
                   -- containing parameters to be used to create the image.
                   --
                   -- #VUID-xrCreateSwapchain-createInfo-parameter# @createInfo@ /must/ be a
                   -- pointer to a valid 'SwapchainCreateInfo' structure
                   (SwapchainCreateInfo a)
                -> io (Result, Swapchain)
createSwapchain :: Session -> SwapchainCreateInfo a -> io (Result, Swapchain)
createSwapchain session :: Session
session createInfo :: SwapchainCreateInfo a
createInfo = IO (Result, Swapchain) -> io (Result, Swapchain)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result, Swapchain) -> io (Result, Swapchain))
-> (ContT (Result, Swapchain) IO (Result, Swapchain)
    -> IO (Result, Swapchain))
-> ContT (Result, Swapchain) IO (Result, Swapchain)
-> io (Result, Swapchain)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT (Result, Swapchain) IO (Result, Swapchain)
-> IO (Result, Swapchain)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT (Result, Swapchain) IO (Result, Swapchain)
 -> io (Result, Swapchain))
-> ContT (Result, Swapchain) IO (Result, Swapchain)
-> io (Result, Swapchain)
forall a b. (a -> b) -> a -> b
$ do
  let cmds :: InstanceCmds
cmds = Session -> InstanceCmds
instanceCmds (Session
session :: Session)
  let xrCreateSwapchainPtr :: FunPtr
  (Ptr Session_T
   -> ("createInfo" ::: Ptr (SomeStruct SwapchainCreateInfo))
   -> ("swapchain" ::: Ptr (Ptr Swapchain_T))
   -> IO Result)
xrCreateSwapchainPtr = InstanceCmds
-> FunPtr
     (Ptr Session_T
      -> ("createInfo" ::: Ptr (SomeStruct SwapchainCreateInfo))
      -> ("swapchain" ::: Ptr (Ptr Swapchain_T))
      -> IO Result)
pXrCreateSwapchain InstanceCmds
cmds
  IO () -> ContT (Result, Swapchain) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, Swapchain) IO ())
-> IO () -> ContT (Result, Swapchain) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Session_T
   -> ("createInfo" ::: Ptr (SomeStruct SwapchainCreateInfo))
   -> ("swapchain" ::: Ptr (Ptr Swapchain_T))
   -> IO Result)
xrCreateSwapchainPtr FunPtr
  (Ptr Session_T
   -> ("createInfo" ::: Ptr (SomeStruct SwapchainCreateInfo))
   -> ("swapchain" ::: Ptr (Ptr Swapchain_T))
   -> IO Result)
-> FunPtr
     (Ptr Session_T
      -> ("createInfo" ::: Ptr (SomeStruct SwapchainCreateInfo))
      -> ("swapchain" ::: Ptr (Ptr Swapchain_T))
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Session_T
   -> ("createInfo" ::: Ptr (SomeStruct SwapchainCreateInfo))
   -> ("swapchain" ::: Ptr (Ptr Swapchain_T))
   -> 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 "" "The function pointer for xrCreateSwapchain is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrCreateSwapchain' :: Ptr Session_T
-> ("createInfo" ::: Ptr (SomeStruct SwapchainCreateInfo))
-> ("swapchain" ::: Ptr (Ptr Swapchain_T))
-> IO Result
xrCreateSwapchain' = FunPtr
  (Ptr Session_T
   -> ("createInfo" ::: Ptr (SomeStruct SwapchainCreateInfo))
   -> ("swapchain" ::: Ptr (Ptr Swapchain_T))
   -> IO Result)
-> Ptr Session_T
-> ("createInfo" ::: Ptr (SomeStruct SwapchainCreateInfo))
-> ("swapchain" ::: Ptr (Ptr Swapchain_T))
-> IO Result
mkXrCreateSwapchain FunPtr
  (Ptr Session_T
   -> ("createInfo" ::: Ptr (SomeStruct SwapchainCreateInfo))
   -> ("swapchain" ::: Ptr (Ptr Swapchain_T))
   -> IO Result)
xrCreateSwapchainPtr
  Ptr (SwapchainCreateInfo a)
createInfo' <- ((Ptr (SwapchainCreateInfo a) -> IO (Result, Swapchain))
 -> IO (Result, Swapchain))
-> ContT (Result, Swapchain) IO (Ptr (SwapchainCreateInfo a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (SwapchainCreateInfo a) -> IO (Result, Swapchain))
  -> IO (Result, Swapchain))
 -> ContT (Result, Swapchain) IO (Ptr (SwapchainCreateInfo a)))
-> ((Ptr (SwapchainCreateInfo a) -> IO (Result, Swapchain))
    -> IO (Result, Swapchain))
-> ContT (Result, Swapchain) IO (Ptr (SwapchainCreateInfo a))
forall a b. (a -> b) -> a -> b
$ SwapchainCreateInfo a
-> (Ptr (SwapchainCreateInfo a) -> IO (Result, Swapchain))
-> IO (Result, Swapchain)
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (SwapchainCreateInfo a
createInfo)
  "swapchain" ::: Ptr (Ptr Swapchain_T)
pSwapchain <- ((("swapchain" ::: Ptr (Ptr Swapchain_T))
  -> IO (Result, Swapchain))
 -> IO (Result, Swapchain))
-> ContT
     (Result, Swapchain) IO ("swapchain" ::: Ptr (Ptr Swapchain_T))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("swapchain" ::: Ptr (Ptr Swapchain_T))
   -> IO (Result, Swapchain))
  -> IO (Result, Swapchain))
 -> ContT
      (Result, Swapchain) IO ("swapchain" ::: Ptr (Ptr Swapchain_T)))
-> ((("swapchain" ::: Ptr (Ptr Swapchain_T))
     -> IO (Result, Swapchain))
    -> IO (Result, Swapchain))
-> ContT
     (Result, Swapchain) IO ("swapchain" ::: Ptr (Ptr Swapchain_T))
forall a b. (a -> b) -> a -> b
$ IO ("swapchain" ::: Ptr (Ptr Swapchain_T))
-> (("swapchain" ::: Ptr (Ptr Swapchain_T)) -> IO ())
-> (("swapchain" ::: Ptr (Ptr Swapchain_T))
    -> IO (Result, Swapchain))
-> IO (Result, Swapchain)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("swapchain" ::: Ptr (Ptr Swapchain_T))
forall a. Int -> IO (Ptr a)
callocBytes @(Ptr Swapchain_T) 8) ("swapchain" ::: Ptr (Ptr Swapchain_T)) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT (Result, Swapchain) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT (Result, Swapchain) IO Result)
-> IO Result -> ContT (Result, Swapchain) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrCreateSwapchain" (Ptr Session_T
-> ("createInfo" ::: Ptr (SomeStruct SwapchainCreateInfo))
-> ("swapchain" ::: Ptr (Ptr Swapchain_T))
-> IO Result
xrCreateSwapchain' (Session -> Ptr Session_T
sessionHandle (Session
session)) (Ptr (SwapchainCreateInfo a)
-> "createInfo" ::: Ptr (SomeStruct SwapchainCreateInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (SwapchainCreateInfo a)
createInfo') ("swapchain" ::: Ptr (Ptr Swapchain_T)
pSwapchain))
  IO () -> ContT (Result, Swapchain) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, Swapchain) IO ())
-> IO () -> ContT (Result, Swapchain) 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) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))
  Ptr Swapchain_T
swapchain <- IO (Ptr Swapchain_T)
-> ContT (Result, Swapchain) IO (Ptr Swapchain_T)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Ptr Swapchain_T)
 -> ContT (Result, Swapchain) IO (Ptr Swapchain_T))
-> IO (Ptr Swapchain_T)
-> ContT (Result, Swapchain) IO (Ptr Swapchain_T)
forall a b. (a -> b) -> a -> b
$ ("swapchain" ::: Ptr (Ptr Swapchain_T)) -> IO (Ptr Swapchain_T)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Swapchain_T) "swapchain" ::: Ptr (Ptr Swapchain_T)
pSwapchain
  (Result, Swapchain)
-> ContT (Result, Swapchain) IO (Result, Swapchain)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result, Swapchain)
 -> ContT (Result, Swapchain) IO (Result, Swapchain))
-> (Result, Swapchain)
-> ContT (Result, Swapchain) IO (Result, Swapchain)
forall a b. (a -> b) -> a -> b
$ (Result
r, ((\h :: Ptr Swapchain_T
h -> Ptr Swapchain_T -> InstanceCmds -> Swapchain
Swapchain Ptr Swapchain_T
h InstanceCmds
cmds ) Ptr Swapchain_T
swapchain))

-- | A convenience wrapper to make a compatible pair of calls to
-- 'createSwapchain' and 'destroySwapchain'
--
-- To ensure that 'destroySwapchain' is always called: pass
-- 'Control.Exception.bracket' (or the allocate function from your
-- favourite resource management library) as the last argument.
-- To just extract the pair pass '(,)' as the last argument.
--
withSwapchain :: forall a io r . (Extendss SwapchainCreateInfo a, PokeChain a, MonadIO io) => Session -> SwapchainCreateInfo a -> (io (Result, Swapchain) -> ((Result, Swapchain) -> io ()) -> r) -> r
withSwapchain :: Session
-> SwapchainCreateInfo a
-> (io (Result, Swapchain) -> ((Result, Swapchain) -> io ()) -> r)
-> r
withSwapchain session :: Session
session createInfo :: SwapchainCreateInfo a
createInfo b :: io (Result, Swapchain) -> ((Result, Swapchain) -> io ()) -> r
b =
  io (Result, Swapchain) -> ((Result, Swapchain) -> io ()) -> r
b (Session -> SwapchainCreateInfo a -> io (Result, Swapchain)
forall (a :: [*]) (io :: * -> *).
(Extendss SwapchainCreateInfo a, PokeChain a, MonadIO io) =>
Session -> SwapchainCreateInfo a -> io (Result, Swapchain)
createSwapchain Session
session SwapchainCreateInfo a
createInfo)
    (\(_, o1 :: Swapchain
o1) -> Swapchain -> io ()
forall (io :: * -> *). MonadIO io => Swapchain -> io ()
destroySwapchain Swapchain
o1)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrDestroySwapchain
  :: FunPtr (Ptr Swapchain_T -> IO Result) -> Ptr Swapchain_T -> IO Result

-- | xrDestroySwapchain - Destroys an XrSwapchain
--
-- == Parameter Descriptions
--
-- = Description
--
-- All submitted graphics API commands that refer to @swapchain@ /must/
-- have completed execution. Runtimes /may/ continue to utilize swapchain
-- images after 'destroySwapchain' is called.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-xrDestroySwapchain-swapchain-parameter# @swapchain@ /must/ be
--     a valid 'OpenXR.Core10.Handles.Swapchain' handle
--
-- == Thread Safety
--
-- -   Access to @swapchain@, and any child handles, /must/ be externally
--     synchronized
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Swapchain', 'createSwapchain'
destroySwapchain :: forall io
                  . (MonadIO io)
                 => -- | @swapchain@ is the swapchain to destroy.
                    Swapchain
                 -> io ()
destroySwapchain :: Swapchain -> io ()
destroySwapchain swapchain :: Swapchain
swapchain = 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 xrDestroySwapchainPtr :: FunPtr (Ptr Swapchain_T -> IO Result)
xrDestroySwapchainPtr = InstanceCmds -> FunPtr (Ptr Swapchain_T -> IO Result)
pXrDestroySwapchain (Swapchain -> InstanceCmds
instanceCmds (Swapchain
swapchain :: Swapchain))
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr (Ptr Swapchain_T -> IO Result)
xrDestroySwapchainPtr FunPtr (Ptr Swapchain_T -> IO Result)
-> FunPtr (Ptr Swapchain_T -> IO Result) -> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr (Ptr Swapchain_T -> 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 "" "The function pointer for xrDestroySwapchain is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrDestroySwapchain' :: Ptr Swapchain_T -> IO Result
xrDestroySwapchain' = FunPtr (Ptr Swapchain_T -> IO Result)
-> Ptr Swapchain_T -> IO Result
mkXrDestroySwapchain FunPtr (Ptr Swapchain_T -> IO Result)
xrDestroySwapchainPtr
  Result
r <- String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrDestroySwapchain" (Ptr Swapchain_T -> IO Result
xrDestroySwapchain' (Swapchain -> Ptr Swapchain_T
swapchainHandle (Swapchain
swapchain)))
  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) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrEnumerateSwapchainImages
  :: FunPtr (Ptr Swapchain_T -> Word32 -> Ptr Word32 -> Ptr (SomeChild SwapchainImageBaseHeader) -> IO Result) -> Ptr Swapchain_T -> Word32 -> Ptr Word32 -> Ptr (SomeChild SwapchainImageBaseHeader) -> IO Result

-- | xrEnumerateSwapchainImages - Gets images from an XrSwapchain
--
-- == Parameter Descriptions
--
-- -   @swapchain@ is the 'OpenXR.Core10.Handles.Swapchain' to get images
--     from.
--
-- -   @imageCapacityInput@ is the capacity of the @images@ array, or 0 to
--     indicate a request to retrieve the required capacity.
--
-- -   @imageCountOutput@ is a pointer to the count of @images@ written, or
--     a pointer to the required capacity in the case that
--     @imageCapacityInput@ is 0.
--
-- -   @images@ is a pointer to an array of graphics API-specific
--     @XrSwapchainImage@ structures based off of
--     'SwapchainImageBaseHeader'. It /can/ be @NULL@ if
--     @imageCapacityInput@ is 0.
--
-- -   See
--     <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#buffer-size-parameters Buffer Size Parameters>
--     chapter for a detailed description of retrieving the required
--     @images@ size.
--
-- = Description
--
-- Fills an array of graphics API-specific @XrSwapchainImage@ structures.
-- The resources /must/ be constant and valid for the lifetime of the
-- 'OpenXR.Core10.Handles.Swapchain'.
--
-- Runtimes /must/ always return identical buffer contents from this
-- enumeration for the lifetime of the swapchain.
--
-- Note: @images@ is a pointer to an array of structures of graphics
-- API-specific type, not an array of structure pointers.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-xrEnumerateSwapchainImages-swapchain-parameter# @swapchain@
--     /must/ be a valid 'OpenXR.Core10.Handles.Swapchain' handle
--
-- -   #VUID-xrEnumerateSwapchainImages-imageCountOutput-parameter#
--     @imageCountOutput@ /must/ be a pointer to a @uint32_t@ value
--
-- -   #VUID-xrEnumerateSwapchainImages-images-parameter# If
--     @imageCapacityInput@ is not @0@, @images@ /must/ be a pointer to an
--     array of @imageCapacityInput@ 'SwapchainImageBaseHeader'-based
--     structures. See also:
--     'OpenXR.Extensions.XR_KHR_D3D11_enable.SwapchainImageD3D11KHR',
--     'OpenXR.Extensions.XR_KHR_D3D12_enable.SwapchainImageD3D12KHR',
--     'OpenXR.Extensions.XR_KHR_opengl_es_enable.SwapchainImageOpenGLESKHR',
--     'OpenXR.Extensions.XR_KHR_opengl_enable.SwapchainImageOpenGLKHR',
--     'OpenXR.Extensions.XR_KHR_vulkan_enable.SwapchainImageVulkanKHR'
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
--     -   'OpenXR.Core10.Enums.Result.SESSION_LOSS_PENDING'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SIZE_INSUFFICIENT'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Swapchain', 'SwapchainImageBaseHeader',
-- 'createSwapchain'
enumerateSwapchainImages :: forall a io
                          . (Inherits SwapchainImageBaseHeader a, ToCStruct a, FromCStruct a, MonadIO io)
                         => -- No documentation found for Nested "xrEnumerateSwapchainImages" "swapchain"
                            Swapchain
                         -> io (Result, "images" ::: Vector a)
enumerateSwapchainImages :: Swapchain -> io (Result, "images" ::: Vector a)
enumerateSwapchainImages swapchain :: Swapchain
swapchain = IO (Result, "images" ::: Vector a)
-> io (Result, "images" ::: Vector a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result, "images" ::: Vector a)
 -> io (Result, "images" ::: Vector a))
-> (ContT
      (Result, "images" ::: Vector a) IO (Result, "images" ::: Vector a)
    -> IO (Result, "images" ::: Vector a))
-> ContT
     (Result, "images" ::: Vector a) IO (Result, "images" ::: Vector a)
-> io (Result, "images" ::: Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  (Result, "images" ::: Vector a) IO (Result, "images" ::: Vector a)
-> IO (Result, "images" ::: Vector a)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   (Result, "images" ::: Vector a) IO (Result, "images" ::: Vector a)
 -> io (Result, "images" ::: Vector a))
-> ContT
     (Result, "images" ::: Vector a) IO (Result, "images" ::: Vector a)
-> io (Result, "images" ::: Vector a)
forall a b. (a -> b) -> a -> b
$ do
  let xrEnumerateSwapchainImagesPtr :: FunPtr
  (Ptr Swapchain_T
   -> ("formatCapacityInput" ::: Word32)
   -> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
   -> ("images" ::: Ptr (SomeChild SwapchainImageBaseHeader))
   -> IO Result)
xrEnumerateSwapchainImagesPtr = InstanceCmds
-> FunPtr
     (Ptr Swapchain_T
      -> ("formatCapacityInput" ::: Word32)
      -> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
      -> ("images" ::: Ptr (SomeChild SwapchainImageBaseHeader))
      -> IO Result)
pXrEnumerateSwapchainImages (Swapchain -> InstanceCmds
instanceCmds (Swapchain
swapchain :: Swapchain))
  IO () -> ContT (Result, "images" ::: Vector a) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, "images" ::: Vector a) IO ())
-> IO () -> ContT (Result, "images" ::: Vector a) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Swapchain_T
   -> ("formatCapacityInput" ::: Word32)
   -> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
   -> ("images" ::: Ptr (SomeChild SwapchainImageBaseHeader))
   -> IO Result)
xrEnumerateSwapchainImagesPtr FunPtr
  (Ptr Swapchain_T
   -> ("formatCapacityInput" ::: Word32)
   -> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
   -> ("images" ::: Ptr (SomeChild SwapchainImageBaseHeader))
   -> IO Result)
-> FunPtr
     (Ptr Swapchain_T
      -> ("formatCapacityInput" ::: Word32)
      -> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
      -> ("images" ::: Ptr (SomeChild SwapchainImageBaseHeader))
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Swapchain_T
   -> ("formatCapacityInput" ::: Word32)
   -> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
   -> ("images" ::: Ptr (SomeChild SwapchainImageBaseHeader))
   -> 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 "" "The function pointer for xrEnumerateSwapchainImages is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrEnumerateSwapchainImages' :: Ptr Swapchain_T
-> ("formatCapacityInput" ::: Word32)
-> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> ("images" ::: Ptr (SomeChild SwapchainImageBaseHeader))
-> IO Result
xrEnumerateSwapchainImages' = FunPtr
  (Ptr Swapchain_T
   -> ("formatCapacityInput" ::: Word32)
   -> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
   -> ("images" ::: Ptr (SomeChild SwapchainImageBaseHeader))
   -> IO Result)
-> Ptr Swapchain_T
-> ("formatCapacityInput" ::: Word32)
-> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> ("images" ::: Ptr (SomeChild SwapchainImageBaseHeader))
-> IO Result
mkXrEnumerateSwapchainImages FunPtr
  (Ptr Swapchain_T
   -> ("formatCapacityInput" ::: Word32)
   -> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
   -> ("images" ::: Ptr (SomeChild SwapchainImageBaseHeader))
   -> IO Result)
xrEnumerateSwapchainImagesPtr
  let swapchain' :: Ptr Swapchain_T
swapchain' = Swapchain -> Ptr Swapchain_T
swapchainHandle Swapchain
swapchain
  "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
pImageCountOutput <- ((("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
  -> IO (Result, "images" ::: Vector a))
 -> IO (Result, "images" ::: Vector a))
-> ContT
     (Result, "images" ::: Vector a)
     IO
     ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
   -> IO (Result, "images" ::: Vector a))
  -> IO (Result, "images" ::: Vector a))
 -> ContT
      (Result, "images" ::: Vector a)
      IO
      ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)))
-> ((("formatCountOutput"
      ::: Ptr ("formatCapacityInput" ::: Word32))
     -> IO (Result, "images" ::: Vector a))
    -> IO (Result, "images" ::: Vector a))
-> ContT
     (Result, "images" ::: Vector a)
     IO
     ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
forall a b. (a -> b) -> a -> b
$ IO ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> (("formatCountOutput"
     ::: Ptr ("formatCapacityInput" ::: Word32))
    -> IO ())
-> (("formatCountOutput"
     ::: Ptr ("formatCapacityInput" ::: Word32))
    -> IO (Result, "images" ::: Vector a))
-> IO (Result, "images" ::: Vector a)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int
-> IO
     ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
forall a. Int -> IO (Ptr a)
callocBytes @Word32 4) ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT (Result, "images" ::: Vector a) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT (Result, "images" ::: Vector a) IO Result)
-> IO Result -> ContT (Result, "images" ::: Vector a) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrEnumerateSwapchainImages" (Ptr Swapchain_T
-> ("formatCapacityInput" ::: Word32)
-> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> ("images" ::: Ptr (SomeChild SwapchainImageBaseHeader))
-> IO Result
xrEnumerateSwapchainImages' Ptr Swapchain_T
swapchain' 0 "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
pImageCountOutput "images" ::: Ptr (SomeChild SwapchainImageBaseHeader)
forall a. Ptr a
nullPtr)
  IO () -> ContT (Result, "images" ::: Vector a) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, "images" ::: Vector a) IO ())
-> IO () -> ContT (Result, "images" ::: Vector a) 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) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))
  "formatCapacityInput" ::: Word32
imageCountOutput <- IO ("formatCapacityInput" ::: Word32)
-> ContT
     (Result, "images" ::: Vector a)
     IO
     ("formatCapacityInput" ::: Word32)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("formatCapacityInput" ::: Word32)
 -> ContT
      (Result, "images" ::: Vector a)
      IO
      ("formatCapacityInput" ::: Word32))
-> IO ("formatCapacityInput" ::: Word32)
-> ContT
     (Result, "images" ::: Vector a)
     IO
     ("formatCapacityInput" ::: Word32)
forall a b. (a -> b) -> a -> b
$ ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> IO ("formatCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
pImageCountOutput
  Ptr a
pImages <- ((Ptr a -> IO (Result, "images" ::: Vector a))
 -> IO (Result, "images" ::: Vector a))
-> ContT (Result, "images" ::: Vector a) IO (Ptr a)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr a -> IO (Result, "images" ::: Vector a))
  -> IO (Result, "images" ::: Vector a))
 -> ContT (Result, "images" ::: Vector a) IO (Ptr a))
-> ((Ptr a -> IO (Result, "images" ::: Vector a))
    -> IO (Result, "images" ::: Vector a))
-> ContT (Result, "images" ::: Vector a) IO (Ptr a)
forall a b. (a -> b) -> a -> b
$ IO (Ptr a)
-> (Ptr a -> IO ())
-> (Ptr a -> IO (Result, "images" ::: Vector a))
-> IO (Result, "images" ::: Vector a)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr a)
forall a. Int -> IO (Ptr a)
callocBytes @a (("formatCapacityInput" ::: Word32) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral "formatCapacityInput" ::: Word32
imageCountOutput Int -> Int -> Int
forall a. Num a => a -> a -> a
* ToCStruct a => Int
forall a. ToCStruct a => Int
cStructSize @a)) Ptr a -> IO ()
forall a. Ptr a -> IO ()
free
  (Int -> ContT (Result, "images" ::: Vector a) IO ())
-> [Int] -> ContT (Result, "images" ::: Vector a) IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\i :: Int
i -> ((() -> IO (Result, "images" ::: Vector a))
 -> IO (Result, "images" ::: Vector a))
-> ContT (Result, "images" ::: Vector a) IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO (Result, "images" ::: Vector a))
  -> IO (Result, "images" ::: Vector a))
 -> ContT (Result, "images" ::: Vector a) IO ())
-> ((() -> IO (Result, "images" ::: Vector a))
    -> IO (Result, "images" ::: Vector a))
-> ContT (Result, "images" ::: Vector a) IO ()
forall a b. (a -> b) -> a -> b
$ Ptr a
-> IO (Result, "images" ::: Vector a)
-> IO (Result, "images" ::: Vector a)
forall a b. ToCStruct a => Ptr a -> IO b -> IO b
pokeZeroCStruct (Ptr a
pImages Ptr a -> Int -> Ptr a
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* ToCStruct a => Int
forall a. ToCStruct a => Int
cStructSize @a) :: Ptr a) (IO (Result, "images" ::: Vector a)
 -> IO (Result, "images" ::: Vector a))
-> ((() -> IO (Result, "images" ::: Vector a))
    -> IO (Result, "images" ::: Vector a))
-> (() -> IO (Result, "images" ::: Vector a))
-> IO (Result, "images" ::: Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO (Result, "images" ::: Vector a))
-> () -> IO (Result, "images" ::: Vector a)
forall a b. (a -> b) -> a -> b
$ ())) [0..("formatCapacityInput" ::: Word32) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral "formatCapacityInput" ::: Word32
imageCountOutput Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1]
  Result
r' <- IO Result -> ContT (Result, "images" ::: Vector a) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT (Result, "images" ::: Vector a) IO Result)
-> IO Result -> ContT (Result, "images" ::: Vector a) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrEnumerateSwapchainImages" (Ptr Swapchain_T
-> ("formatCapacityInput" ::: Word32)
-> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> ("images" ::: Ptr (SomeChild SwapchainImageBaseHeader))
-> IO Result
xrEnumerateSwapchainImages' Ptr Swapchain_T
swapchain' "formatCapacityInput" ::: Word32
imageCountOutput "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
pImageCountOutput (Ptr a -> "images" ::: Ptr (SomeChild SwapchainImageBaseHeader)
forall a b. Inherits a b => Ptr b -> Ptr (SomeChild a)
lowerChildPointer Ptr a
pImages))
  IO () -> ContT (Result, "images" ::: Vector a) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, "images" ::: Vector a) IO ())
-> IO () -> ContT (Result, "images" ::: Vector a) 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) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r'))
  "formatCapacityInput" ::: Word32
imageCountOutput' <- IO ("formatCapacityInput" ::: Word32)
-> ContT
     (Result, "images" ::: Vector a)
     IO
     ("formatCapacityInput" ::: Word32)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("formatCapacityInput" ::: Word32)
 -> ContT
      (Result, "images" ::: Vector a)
      IO
      ("formatCapacityInput" ::: Word32))
-> IO ("formatCapacityInput" ::: Word32)
-> ContT
     (Result, "images" ::: Vector a)
     IO
     ("formatCapacityInput" ::: Word32)
forall a b. (a -> b) -> a -> b
$ ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> IO ("formatCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
pImageCountOutput
  "images" ::: Vector a
images' <- IO ("images" ::: Vector a)
-> ContT (Result, "images" ::: Vector a) IO ("images" ::: Vector a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("images" ::: Vector a)
 -> ContT
      (Result, "images" ::: Vector a) IO ("images" ::: Vector a))
-> IO ("images" ::: Vector a)
-> ContT (Result, "images" ::: Vector a) IO ("images" ::: Vector a)
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> IO a) -> IO ("images" ::: Vector a)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (("formatCapacityInput" ::: Word32) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral "formatCapacityInput" ::: Word32
imageCountOutput') (\i :: Int
i -> Ptr a -> IO a
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @a (Ptr a
pImages Ptr a -> Int -> Ptr a
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (ToCStruct a => Int
forall a. ToCStruct a => Int
cStructSize @a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i) :: Ptr a))
  (Result, "images" ::: Vector a)
-> ContT
     (Result, "images" ::: Vector a) IO (Result, "images" ::: Vector a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result
r', "images" ::: Vector a
images')


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrAcquireSwapchainImage
  :: FunPtr (Ptr Swapchain_T -> Ptr SwapchainImageAcquireInfo -> Ptr Word32 -> IO Result) -> Ptr Swapchain_T -> Ptr SwapchainImageAcquireInfo -> Ptr Word32 -> IO Result

-- | xrAcquireSwapchainImage - Acquire a swapchain image
--
-- == Parameter Descriptions
--
-- = Description
--
-- Acquires the image corresponding to the @index@ position in the array
-- returned by 'enumerateSwapchainImages'. The runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_CALL_ORDER_INVALID' if @index@ has
-- already been acquired and not yet released with 'releaseSwapchainImage'.
-- If the @swapchain@ was created with the
-- @XR_SWAPCHAIN_CREATE_STATIC_IMAGE_BIT@ set in
-- 'SwapchainCreateInfo'::@createFlags@, this function /must/ not have been
-- previously called for this swapchain. The runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_CALL_ORDER_INVALID' if a @swapchain@
-- created with the @XR_SWAPCHAIN_CREATE_STATIC_IMAGE_BIT@ set in
-- 'SwapchainCreateInfo'::@createFlags@ and this function has been
-- successfully called previously for this swapchain.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-xrAcquireSwapchainImage-swapchain-parameter# @swapchain@
--     /must/ be a valid 'OpenXR.Core10.Handles.Swapchain' handle
--
-- -   #VUID-xrAcquireSwapchainImage-acquireInfo-parameter# If
--     @acquireInfo@ is not @NULL@, @acquireInfo@ /must/ be a pointer to a
--     valid 'SwapchainImageAcquireInfo' structure
--
-- -   #VUID-xrAcquireSwapchainImage-index-parameter# @index@ /must/ be a
--     pointer to a @uint32_t@ value
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
--     -   'OpenXR.Core10.Enums.Result.SESSION_LOSS_PENDING'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_CALL_ORDER_INVALID'
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Swapchain', 'SwapchainImageAcquireInfo',
-- 'createSwapchain', 'destroySwapchain', 'enumerateSwapchainImages',
-- 'releaseSwapchainImage', 'waitSwapchainImage'
acquireSwapchainImage :: forall io
                       . (MonadIO io)
                      => -- | @swapchain@ is the swapchain from which to acquire an image.
                         Swapchain
                      -> -- | @acquireInfo@ exists for extensibility purposes, it is @NULL@ or a
                         -- pointer to a valid 'SwapchainImageAcquireInfo'.
                         ("acquireInfo" ::: Maybe SwapchainImageAcquireInfo)
                      -> io (Result, ("index" ::: Word32))
acquireSwapchainImage :: Swapchain
-> ("acquireInfo" ::: Maybe SwapchainImageAcquireInfo)
-> io (Result, "formatCapacityInput" ::: Word32)
acquireSwapchainImage swapchain :: Swapchain
swapchain acquireInfo :: "acquireInfo" ::: Maybe SwapchainImageAcquireInfo
acquireInfo = IO (Result, "formatCapacityInput" ::: Word32)
-> io (Result, "formatCapacityInput" ::: Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result, "formatCapacityInput" ::: Word32)
 -> io (Result, "formatCapacityInput" ::: Word32))
-> (ContT
      (Result, "formatCapacityInput" ::: Word32)
      IO
      (Result, "formatCapacityInput" ::: Word32)
    -> IO (Result, "formatCapacityInput" ::: Word32))
-> ContT
     (Result, "formatCapacityInput" ::: Word32)
     IO
     (Result, "formatCapacityInput" ::: Word32)
-> io (Result, "formatCapacityInput" ::: Word32)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  (Result, "formatCapacityInput" ::: Word32)
  IO
  (Result, "formatCapacityInput" ::: Word32)
-> IO (Result, "formatCapacityInput" ::: Word32)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   (Result, "formatCapacityInput" ::: Word32)
   IO
   (Result, "formatCapacityInput" ::: Word32)
 -> io (Result, "formatCapacityInput" ::: Word32))
-> ContT
     (Result, "formatCapacityInput" ::: Word32)
     IO
     (Result, "formatCapacityInput" ::: Word32)
-> io (Result, "formatCapacityInput" ::: Word32)
forall a b. (a -> b) -> a -> b
$ do
  let xrAcquireSwapchainImagePtr :: FunPtr
  (Ptr Swapchain_T
   -> Ptr SwapchainImageAcquireInfo
   -> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
   -> IO Result)
xrAcquireSwapchainImagePtr = InstanceCmds
-> FunPtr
     (Ptr Swapchain_T
      -> Ptr SwapchainImageAcquireInfo
      -> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
      -> IO Result)
pXrAcquireSwapchainImage (Swapchain -> InstanceCmds
instanceCmds (Swapchain
swapchain :: Swapchain))
  IO () -> ContT (Result, "formatCapacityInput" ::: Word32) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, "formatCapacityInput" ::: Word32) IO ())
-> IO () -> ContT (Result, "formatCapacityInput" ::: Word32) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Swapchain_T
   -> Ptr SwapchainImageAcquireInfo
   -> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
   -> IO Result)
xrAcquireSwapchainImagePtr FunPtr
  (Ptr Swapchain_T
   -> Ptr SwapchainImageAcquireInfo
   -> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
   -> IO Result)
-> FunPtr
     (Ptr Swapchain_T
      -> Ptr SwapchainImageAcquireInfo
      -> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Swapchain_T
   -> Ptr SwapchainImageAcquireInfo
   -> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
   -> 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 "" "The function pointer for xrAcquireSwapchainImage is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrAcquireSwapchainImage' :: Ptr Swapchain_T
-> Ptr SwapchainImageAcquireInfo
-> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> IO Result
xrAcquireSwapchainImage' = FunPtr
  (Ptr Swapchain_T
   -> Ptr SwapchainImageAcquireInfo
   -> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
   -> IO Result)
-> Ptr Swapchain_T
-> Ptr SwapchainImageAcquireInfo
-> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> IO Result
mkXrAcquireSwapchainImage FunPtr
  (Ptr Swapchain_T
   -> Ptr SwapchainImageAcquireInfo
   -> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
   -> IO Result)
xrAcquireSwapchainImagePtr
  Ptr SwapchainImageAcquireInfo
acquireInfo' <- case ("acquireInfo" ::: Maybe SwapchainImageAcquireInfo
acquireInfo) of
    Nothing -> Ptr SwapchainImageAcquireInfo
-> ContT
     (Result, "formatCapacityInput" ::: Word32)
     IO
     (Ptr SwapchainImageAcquireInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr SwapchainImageAcquireInfo
forall a. Ptr a
nullPtr
    Just j :: SwapchainImageAcquireInfo
j -> ((Ptr SwapchainImageAcquireInfo
  -> IO (Result, "formatCapacityInput" ::: Word32))
 -> IO (Result, "formatCapacityInput" ::: Word32))
-> ContT
     (Result, "formatCapacityInput" ::: Word32)
     IO
     (Ptr SwapchainImageAcquireInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr SwapchainImageAcquireInfo
   -> IO (Result, "formatCapacityInput" ::: Word32))
  -> IO (Result, "formatCapacityInput" ::: Word32))
 -> ContT
      (Result, "formatCapacityInput" ::: Word32)
      IO
      (Ptr SwapchainImageAcquireInfo))
-> ((Ptr SwapchainImageAcquireInfo
     -> IO (Result, "formatCapacityInput" ::: Word32))
    -> IO (Result, "formatCapacityInput" ::: Word32))
-> ContT
     (Result, "formatCapacityInput" ::: Word32)
     IO
     (Ptr SwapchainImageAcquireInfo)
forall a b. (a -> b) -> a -> b
$ SwapchainImageAcquireInfo
-> (Ptr SwapchainImageAcquireInfo
    -> IO (Result, "formatCapacityInput" ::: Word32))
-> IO (Result, "formatCapacityInput" ::: Word32)
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (SwapchainImageAcquireInfo
j)
  "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
pIndex <- ((("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
  -> IO (Result, "formatCapacityInput" ::: Word32))
 -> IO (Result, "formatCapacityInput" ::: Word32))
-> ContT
     (Result, "formatCapacityInput" ::: Word32)
     IO
     ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
   -> IO (Result, "formatCapacityInput" ::: Word32))
  -> IO (Result, "formatCapacityInput" ::: Word32))
 -> ContT
      (Result, "formatCapacityInput" ::: Word32)
      IO
      ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)))
-> ((("formatCountOutput"
      ::: Ptr ("formatCapacityInput" ::: Word32))
     -> IO (Result, "formatCapacityInput" ::: Word32))
    -> IO (Result, "formatCapacityInput" ::: Word32))
-> ContT
     (Result, "formatCapacityInput" ::: Word32)
     IO
     ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
forall a b. (a -> b) -> a -> b
$ IO ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> (("formatCountOutput"
     ::: Ptr ("formatCapacityInput" ::: Word32))
    -> IO ())
-> (("formatCountOutput"
     ::: Ptr ("formatCapacityInput" ::: Word32))
    -> IO (Result, "formatCapacityInput" ::: Word32))
-> IO (Result, "formatCapacityInput" ::: Word32)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int
-> IO
     ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
forall a. Int -> IO (Ptr a)
callocBytes @Word32 4) ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result
-> ContT (Result, "formatCapacityInput" ::: Word32) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT (Result, "formatCapacityInput" ::: Word32) IO Result)
-> IO Result
-> ContT (Result, "formatCapacityInput" ::: Word32) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrAcquireSwapchainImage" (Ptr Swapchain_T
-> Ptr SwapchainImageAcquireInfo
-> ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> IO Result
xrAcquireSwapchainImage' (Swapchain -> Ptr Swapchain_T
swapchainHandle (Swapchain
swapchain)) Ptr SwapchainImageAcquireInfo
acquireInfo' ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
pIndex))
  IO () -> ContT (Result, "formatCapacityInput" ::: Word32) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, "formatCapacityInput" ::: Word32) IO ())
-> IO () -> ContT (Result, "formatCapacityInput" ::: Word32) 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) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))
  "formatCapacityInput" ::: Word32
index <- IO ("formatCapacityInput" ::: Word32)
-> ContT
     (Result, "formatCapacityInput" ::: Word32)
     IO
     ("formatCapacityInput" ::: Word32)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("formatCapacityInput" ::: Word32)
 -> ContT
      (Result, "formatCapacityInput" ::: Word32)
      IO
      ("formatCapacityInput" ::: Word32))
-> IO ("formatCapacityInput" ::: Word32)
-> ContT
     (Result, "formatCapacityInput" ::: Word32)
     IO
     ("formatCapacityInput" ::: Word32)
forall a b. (a -> b) -> a -> b
$ ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> IO ("formatCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
pIndex
  (Result, "formatCapacityInput" ::: Word32)
-> ContT
     (Result, "formatCapacityInput" ::: Word32)
     IO
     (Result, "formatCapacityInput" ::: Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result, "formatCapacityInput" ::: Word32)
 -> ContT
      (Result, "formatCapacityInput" ::: Word32)
      IO
      (Result, "formatCapacityInput" ::: Word32))
-> (Result, "formatCapacityInput" ::: Word32)
-> ContT
     (Result, "formatCapacityInput" ::: Word32)
     IO
     (Result, "formatCapacityInput" ::: Word32)
forall a b. (a -> b) -> a -> b
$ (Result
r, "formatCapacityInput" ::: Word32
index)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrWaitSwapchainImageUnsafe
  :: FunPtr (Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result) -> Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result

foreign import ccall
  "dynamic" mkXrWaitSwapchainImageSafe
  :: FunPtr (Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result) -> Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result

-- | waitSwapchainImage with selectable safeness
waitSwapchainImageSafeOrUnsafe :: forall io
                                . (MonadIO io)
                               => (FunPtr (Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result) -> Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result)
                               -> -- | @swapchain@ is the swapchain from which to wait for an image.
                                  --
                                  -- #VUID-xrWaitSwapchainImage-swapchain-parameter# @swapchain@ /must/ be a
                                  -- valid 'OpenXR.Core10.Handles.Swapchain' handle
                                  Swapchain
                               -> -- | @waitInfo@ is a pointer to an 'SwapchainImageWaitInfo' structure.
                                  --
                                  -- #VUID-xrWaitSwapchainImage-waitInfo-parameter# @waitInfo@ /must/ be a
                                  -- pointer to a valid 'SwapchainImageWaitInfo' structure
                                  SwapchainImageWaitInfo
                               -> io (Result)
waitSwapchainImageSafeOrUnsafe :: (FunPtr
   (Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result)
 -> Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result)
-> Swapchain -> SwapchainImageWaitInfo -> io Result
waitSwapchainImageSafeOrUnsafe mkXrWaitSwapchainImage :: FunPtr (Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result)
-> Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result
mkXrWaitSwapchainImage swapchain :: Swapchain
swapchain waitInfo :: SwapchainImageWaitInfo
waitInfo = IO Result -> io Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> io Result)
-> (ContT Result IO Result -> IO Result)
-> ContT Result IO Result
-> io Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Result IO Result -> IO Result
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Result IO Result -> io Result)
-> ContT Result IO Result -> io Result
forall a b. (a -> b) -> a -> b
$ do
  let xrWaitSwapchainImagePtr :: FunPtr (Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result)
xrWaitSwapchainImagePtr = InstanceCmds
-> FunPtr
     (Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result)
pXrWaitSwapchainImage (Swapchain -> InstanceCmds
instanceCmds (Swapchain
swapchain :: Swapchain))
  IO () -> ContT Result IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Result IO ()) -> IO () -> ContT Result IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr (Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result)
xrWaitSwapchainImagePtr FunPtr (Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result)
-> FunPtr
     (Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr (Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> 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 "" "The function pointer for xrWaitSwapchainImage is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrWaitSwapchainImage' :: Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result
xrWaitSwapchainImage' = FunPtr (Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result)
-> Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result
mkXrWaitSwapchainImage FunPtr (Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result)
xrWaitSwapchainImagePtr
  Ptr SwapchainImageWaitInfo
waitInfo' <- ((Ptr SwapchainImageWaitInfo -> IO Result) -> IO Result)
-> ContT Result IO (Ptr SwapchainImageWaitInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr SwapchainImageWaitInfo -> IO Result) -> IO Result)
 -> ContT Result IO (Ptr SwapchainImageWaitInfo))
-> ((Ptr SwapchainImageWaitInfo -> IO Result) -> IO Result)
-> ContT Result IO (Ptr SwapchainImageWaitInfo)
forall a b. (a -> b) -> a -> b
$ SwapchainImageWaitInfo
-> (Ptr SwapchainImageWaitInfo -> IO Result) -> IO Result
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (SwapchainImageWaitInfo
waitInfo)
  Result
r <- IO Result -> ContT Result IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT Result IO Result)
-> IO Result -> ContT Result IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrWaitSwapchainImage" (Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result
xrWaitSwapchainImage' (Swapchain -> Ptr Swapchain_T
swapchainHandle (Swapchain
swapchain)) Ptr SwapchainImageWaitInfo
waitInfo')
  IO () -> ContT Result IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Result IO ()) -> IO () -> ContT Result 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) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))
  Result -> ContT Result IO Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> ContT Result IO Result)
-> Result -> ContT Result IO Result
forall a b. (a -> b) -> a -> b
$ (Result
r)

-- | xrWaitSwapchainImage - Wait for a swapchain image to be available
--
-- == Parameter Descriptions
--
-- = Description
--
-- Before an application can begin writing to a swapchain image, it must
-- first wait on the image to avoid writing to it before the compositor has
-- finished reading from it. 'waitSwapchainImage' will implicitly wait on
-- the oldest acquired swapchain image which has not yet been successfully
-- waited on. Once a swapchain image has been successfully waited on, it
-- /must/ be released before waiting on the next acquired swapchain image.
--
-- This function may block for longer than the timeout specified in
-- 'SwapchainImageWaitInfo' due to scheduling or contention.
--
-- If the timeout expires without the image becoming available for writing,
-- 'OpenXR.Core10.Enums.Result.TIMEOUT_EXPIRED' /must/ be returned. If
-- 'waitSwapchainImage' returns
-- 'OpenXR.Core10.Enums.Result.TIMEOUT_EXPIRED', the next call to
-- 'waitSwapchainImage' will wait on the same image index again until the
-- function succeeds with 'OpenXR.Core10.Enums.Result.SUCCESS'. Note that
-- this is not an error code; @XR_SUCCEEDED(XR_TIMEOUT_EXPIRED)@ is @true@.
--
-- The runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_CALL_ORDER_INVALID' if no image has
-- been acquired by calling 'acquireSwapchainImage'.
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
--     -   'OpenXR.Core10.Enums.Result.TIMEOUT_EXPIRED'
--
--     -   'OpenXR.Core10.Enums.Result.SESSION_LOSS_PENDING'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_CALL_ORDER_INVALID'
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Swapchain', 'SwapchainImageWaitInfo',
-- 'acquireSwapchainImage', 'createSwapchain', 'destroySwapchain',
-- 'enumerateSwapchainImages', 'releaseSwapchainImage'
waitSwapchainImage :: forall io
                    . (MonadIO io)
                   => -- | @swapchain@ is the swapchain from which to wait for an image.
                      --
                      -- #VUID-xrWaitSwapchainImage-swapchain-parameter# @swapchain@ /must/ be a
                      -- valid 'OpenXR.Core10.Handles.Swapchain' handle
                      Swapchain
                   -> -- | @waitInfo@ is a pointer to an 'SwapchainImageWaitInfo' structure.
                      --
                      -- #VUID-xrWaitSwapchainImage-waitInfo-parameter# @waitInfo@ /must/ be a
                      -- pointer to a valid 'SwapchainImageWaitInfo' structure
                      SwapchainImageWaitInfo
                   -> io (Result)
waitSwapchainImage :: Swapchain -> SwapchainImageWaitInfo -> io Result
waitSwapchainImage = (FunPtr
   (Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result)
 -> Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result)
-> Swapchain -> SwapchainImageWaitInfo -> io Result
forall (io :: * -> *).
MonadIO io =>
(FunPtr
   (Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result)
 -> Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result)
-> Swapchain -> SwapchainImageWaitInfo -> io Result
waitSwapchainImageSafeOrUnsafe FunPtr (Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result)
-> Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result
mkXrWaitSwapchainImageUnsafe

-- | A variant of 'waitSwapchainImage' which makes a *safe* FFI call
waitSwapchainImageSafe :: forall io
                        . (MonadIO io)
                       => -- | @swapchain@ is the swapchain from which to wait for an image.
                          --
                          -- #VUID-xrWaitSwapchainImage-swapchain-parameter# @swapchain@ /must/ be a
                          -- valid 'OpenXR.Core10.Handles.Swapchain' handle
                          Swapchain
                       -> -- | @waitInfo@ is a pointer to an 'SwapchainImageWaitInfo' structure.
                          --
                          -- #VUID-xrWaitSwapchainImage-waitInfo-parameter# @waitInfo@ /must/ be a
                          -- pointer to a valid 'SwapchainImageWaitInfo' structure
                          SwapchainImageWaitInfo
                       -> io (Result)
waitSwapchainImageSafe :: Swapchain -> SwapchainImageWaitInfo -> io Result
waitSwapchainImageSafe = (FunPtr
   (Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result)
 -> Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result)
-> Swapchain -> SwapchainImageWaitInfo -> io Result
forall (io :: * -> *).
MonadIO io =>
(FunPtr
   (Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result)
 -> Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result)
-> Swapchain -> SwapchainImageWaitInfo -> io Result
waitSwapchainImageSafeOrUnsafe FunPtr (Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result)
-> Ptr Swapchain_T -> Ptr SwapchainImageWaitInfo -> IO Result
mkXrWaitSwapchainImageSafe


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrReleaseSwapchainImage
  :: FunPtr (Ptr Swapchain_T -> Ptr SwapchainImageReleaseInfo -> IO Result) -> Ptr Swapchain_T -> Ptr SwapchainImageReleaseInfo -> IO Result

-- | xrReleaseSwapchainImage - Release a swapchain image
--
-- == Parameter Descriptions
--
-- = Description
--
-- If the @swapchain@ was created with the
-- @XR_SWAPCHAIN_CREATE_STATIC_IMAGE_BIT@ set in
-- 'SwapchainCreateInfo'::@createFlags@ structure, this function /must/ not
-- have been previously called for this swapchain.
--
-- The runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_CALL_ORDER_INVALID' if no image has
-- been waited on by calling 'waitSwapchainImage'.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-xrReleaseSwapchainImage-swapchain-parameter# @swapchain@
--     /must/ be a valid 'OpenXR.Core10.Handles.Swapchain' handle
--
-- -   #VUID-xrReleaseSwapchainImage-releaseInfo-parameter# If
--     @releaseInfo@ is not @NULL@, @releaseInfo@ /must/ be a pointer to a
--     valid 'SwapchainImageReleaseInfo' structure
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
--     -   'OpenXR.Core10.Enums.Result.SESSION_LOSS_PENDING'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_CALL_ORDER_INVALID'
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Swapchain', 'SwapchainImageReleaseInfo',
-- 'acquireSwapchainImage', 'createSwapchain', 'destroySwapchain',
-- 'enumerateSwapchainImages', 'waitSwapchainImage'
releaseSwapchainImage :: forall io
                       . (MonadIO io)
                      => -- | @swapchain@ is the 'OpenXR.Core10.Handles.Swapchain' from which to
                         -- release an image.
                         Swapchain
                      -> -- | @releaseInfo@ exists for extensibility purposes, it is @NULL@ or a
                         -- pointer to a valid 'SwapchainImageReleaseInfo'.
                         ("releaseInfo" ::: Maybe SwapchainImageReleaseInfo)
                      -> io (Result)
releaseSwapchainImage :: Swapchain
-> ("releaseInfo" ::: Maybe SwapchainImageReleaseInfo) -> io Result
releaseSwapchainImage swapchain :: Swapchain
swapchain releaseInfo :: "releaseInfo" ::: Maybe SwapchainImageReleaseInfo
releaseInfo = IO Result -> io Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> io Result)
-> (ContT Result IO Result -> IO Result)
-> ContT Result IO Result
-> io Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Result IO Result -> IO Result
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Result IO Result -> io Result)
-> ContT Result IO Result -> io Result
forall a b. (a -> b) -> a -> b
$ do
  let xrReleaseSwapchainImagePtr :: FunPtr
  (Ptr Swapchain_T -> Ptr SwapchainImageReleaseInfo -> IO Result)
xrReleaseSwapchainImagePtr = InstanceCmds
-> FunPtr
     (Ptr Swapchain_T -> Ptr SwapchainImageReleaseInfo -> IO Result)
pXrReleaseSwapchainImage (Swapchain -> InstanceCmds
instanceCmds (Swapchain
swapchain :: Swapchain))
  IO () -> ContT Result IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Result IO ()) -> IO () -> ContT Result IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Swapchain_T -> Ptr SwapchainImageReleaseInfo -> IO Result)
xrReleaseSwapchainImagePtr FunPtr
  (Ptr Swapchain_T -> Ptr SwapchainImageReleaseInfo -> IO Result)
-> FunPtr
     (Ptr Swapchain_T -> Ptr SwapchainImageReleaseInfo -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Swapchain_T -> Ptr SwapchainImageReleaseInfo -> 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 "" "The function pointer for xrReleaseSwapchainImage is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrReleaseSwapchainImage' :: Ptr Swapchain_T -> Ptr SwapchainImageReleaseInfo -> IO Result
xrReleaseSwapchainImage' = FunPtr
  (Ptr Swapchain_T -> Ptr SwapchainImageReleaseInfo -> IO Result)
-> Ptr Swapchain_T -> Ptr SwapchainImageReleaseInfo -> IO Result
mkXrReleaseSwapchainImage FunPtr
  (Ptr Swapchain_T -> Ptr SwapchainImageReleaseInfo -> IO Result)
xrReleaseSwapchainImagePtr
  Ptr SwapchainImageReleaseInfo
releaseInfo' <- case ("releaseInfo" ::: Maybe SwapchainImageReleaseInfo
releaseInfo) of
    Nothing -> Ptr SwapchainImageReleaseInfo
-> ContT Result IO (Ptr SwapchainImageReleaseInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr SwapchainImageReleaseInfo
forall a. Ptr a
nullPtr
    Just j :: SwapchainImageReleaseInfo
j -> ((Ptr SwapchainImageReleaseInfo -> IO Result) -> IO Result)
-> ContT Result IO (Ptr SwapchainImageReleaseInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr SwapchainImageReleaseInfo -> IO Result) -> IO Result)
 -> ContT Result IO (Ptr SwapchainImageReleaseInfo))
-> ((Ptr SwapchainImageReleaseInfo -> IO Result) -> IO Result)
-> ContT Result IO (Ptr SwapchainImageReleaseInfo)
forall a b. (a -> b) -> a -> b
$ SwapchainImageReleaseInfo
-> (Ptr SwapchainImageReleaseInfo -> IO Result) -> IO Result
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (SwapchainImageReleaseInfo
j)
  Result
r <- IO Result -> ContT Result IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT Result IO Result)
-> IO Result -> ContT Result IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrReleaseSwapchainImage" (Ptr Swapchain_T -> Ptr SwapchainImageReleaseInfo -> IO Result
xrReleaseSwapchainImage' (Swapchain -> Ptr Swapchain_T
swapchainHandle (Swapchain
swapchain)) Ptr SwapchainImageReleaseInfo
releaseInfo')
  IO () -> ContT Result IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Result IO ()) -> IO () -> ContT Result 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) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))
  Result -> ContT Result IO Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> ContT Result IO Result)
-> Result -> ContT Result IO Result
forall a b. (a -> b) -> a -> b
$ (Result
r)


-- | XrSwapchainCreateInfo - Creation info for a swapchain
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'OpenXR.Core10.Enums.SessionCreateFlags.SessionCreateFlags',
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'OpenXR.Core10.Enums.SwapchainCreateFlags.SwapchainCreateFlags',
-- 'OpenXR.Core10.Enums.SwapchainUsageFlags.SwapchainUsageFlags',
-- 'OpenXR.Core10.Device.createSession', 'createSwapchain',
-- 'OpenXR.Extensions.XR_KHR_android_surface_swapchain.createSwapchainAndroidSurfaceKHR',
-- 'enumerateSwapchainFormats'
data SwapchainCreateInfo (es :: [Type]) = SwapchainCreateInfo
  { -- | @next@ is @NULL@ or a pointer to the next structure in a structure
    -- chain. No such structures are defined in core OpenXR.
    --
    -- #VUID-XrSwapchainCreateInfo-next-next# @next@ /must/ be @NULL@ or a
    -- valid pointer to the
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#valid-usage-for-structure-pointer-chains next structure in a structure chain>.
    -- See also:
    -- 'OpenXR.Extensions.XR_MSFT_secondary_view_configuration.SecondaryViewConfigurationSwapchainCreateInfoMSFT'
    SwapchainCreateInfo es -> Chain es
next :: Chain es
  , -- | @createFlags@ is a bitmask of
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrSwapchainCreateFlagBits XrSwapchainCreateFlagBits>
    -- describing additional properties of the swapchain.
    --
    -- #VUID-XrSwapchainCreateInfo-createFlags-parameter# @createFlags@ /must/
    -- be @0@ or a valid combination of
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrSwapchainCreateFlagBits XrSwapchainCreateFlagBits>
    -- values
    SwapchainCreateInfo es -> SwapchainCreateFlags
createFlags :: SwapchainCreateFlags
  , -- | @usageFlags@ is a bitmask of
    -- 'OpenXR.Extensions.XR_MND_swapchain_usage_input_attachment_bit.SwapchainUsageFlagBits'
    -- describing the intended usage of the swapchain’s images. The usage flags
    -- define how the corresponding graphics API objects are created. A
    -- mismatch /may/ result in swapchain images that do not support the
    -- application’s usage.
    --
    -- #VUID-XrSwapchainCreateInfo-usageFlags-parameter# @usageFlags@ /must/ be
    -- @0@ or a valid combination of
    -- 'OpenXR.Extensions.XR_MND_swapchain_usage_input_attachment_bit.SwapchainUsageFlagBits'
    -- values
    SwapchainCreateInfo es -> SwapchainUsageFlags
usageFlags :: SwapchainUsageFlags
  , -- | @format@ is a graphics API-specific texture format identifier. For
    -- example, if the graphics API specified in
    -- 'OpenXR.Core10.Device.createSession' is Vulkan, then this format is a
    -- Vulkan format such as @VK_FORMAT_R8G8B8A8_SRGB@. The format identifies
    -- the format that the runtime will interpret the texture as upon
    -- submission. Valid formats are indicated by 'enumerateSwapchainFormats'.
    SwapchainCreateInfo es -> Int64
format :: Int64
  , -- | @sampleCount@ is the number of sub-data element samples in the image,
    -- /must/ not be @0@ or greater than the graphics API’s maximum limit.
    SwapchainCreateInfo es -> "formatCapacityInput" ::: Word32
sampleCount :: Word32
  , -- | @width@ is the width of the image, /must/ not be @0@ or greater than the
    -- graphics API’s maximum limit.
    SwapchainCreateInfo es -> "formatCapacityInput" ::: Word32
width :: Word32
  , -- | @height@ is the height of the image, /must/ not be @0@ or greater than
    -- the graphics API’s maximum limit.
    SwapchainCreateInfo es -> "formatCapacityInput" ::: Word32
height :: Word32
  , -- | @faceCount@ is the number of faces, which can be either @6@ (for
    -- cubemaps) or @1@.
    SwapchainCreateInfo es -> "formatCapacityInput" ::: Word32
faceCount :: Word32
  , -- | @arraySize@ is the number of array layers in the image or @1@ for a 2D
    -- image, /must/ not be @0@ or greater than the graphics API’s maximum
    -- limit.
    SwapchainCreateInfo es -> "formatCapacityInput" ::: Word32
arraySize :: Word32
  , -- | @mipCount@ describes the number of levels of detail available for
    -- minified sampling of the image, /must/ not be @0@ or greater than the
    -- graphics API’s maximum limit.
    SwapchainCreateInfo es -> "formatCapacityInput" ::: Word32
mipCount :: Word32
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SwapchainCreateInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (SwapchainCreateInfo es)

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

instance (Extendss SwapchainCreateInfo es, PokeChain es) => ToCStruct (SwapchainCreateInfo es) where
  withCStruct :: SwapchainCreateInfo es
-> (Ptr (SwapchainCreateInfo es) -> IO b) -> IO b
withCStruct x :: SwapchainCreateInfo es
x f :: Ptr (SwapchainCreateInfo es) -> IO b
f = Int -> Int -> (Ptr (SwapchainCreateInfo es) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 56 8 ((Ptr (SwapchainCreateInfo es) -> IO b) -> IO b)
-> (Ptr (SwapchainCreateInfo es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr (SwapchainCreateInfo es)
p -> Ptr (SwapchainCreateInfo es)
-> SwapchainCreateInfo es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (SwapchainCreateInfo es)
p SwapchainCreateInfo es
x (Ptr (SwapchainCreateInfo es) -> IO b
f Ptr (SwapchainCreateInfo es)
p)
  pokeCStruct :: Ptr (SwapchainCreateInfo es)
-> SwapchainCreateInfo es -> IO b -> IO b
pokeCStruct p :: Ptr (SwapchainCreateInfo es)
p SwapchainCreateInfo{..} 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 (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SWAPCHAIN_CREATE_INFO)
    Ptr ()
next'' <- (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 (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
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 SwapchainCreateFlags -> SwapchainCreateFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es) -> Int -> Ptr SwapchainCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr SwapchainCreateFlags)) (SwapchainCreateFlags
createFlags)
    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 SwapchainUsageFlags -> SwapchainUsageFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es) -> Int -> Ptr SwapchainUsageFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr SwapchainUsageFlags)) (SwapchainUsageFlags
usageFlags)
    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
$ ("formats" ::: Ptr Int64) -> Int64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es) -> Int -> "formats" ::: Ptr Int64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Int64)) (Int64
format)
    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
$ ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> ("formatCapacityInput" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es)
-> Int
-> "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Word32)) ("formatCapacityInput" ::: Word32
sampleCount)
    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
$ ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> ("formatCapacityInput" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es)
-> Int
-> "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 36 :: Ptr Word32)) ("formatCapacityInput" ::: Word32
width)
    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
$ ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> ("formatCapacityInput" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es)
-> Int
-> "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr Word32)) ("formatCapacityInput" ::: Word32
height)
    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
$ ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> ("formatCapacityInput" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es)
-> Int
-> "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 44 :: Ptr Word32)) ("formatCapacityInput" ::: Word32
faceCount)
    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
$ ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> ("formatCapacityInput" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es)
-> Int
-> "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48 :: Ptr Word32)) ("formatCapacityInput" ::: Word32
arraySize)
    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
$ ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> ("formatCapacityInput" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es)
-> Int
-> "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 52 :: Ptr Word32)) ("formatCapacityInput" ::: Word32
mipCount)
    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 = 56
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr (SwapchainCreateInfo es) -> IO b -> IO b
pokeZeroCStruct p :: Ptr (SwapchainCreateInfo 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 (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SWAPCHAIN_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 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 (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo 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
$ ("formats" ::: Ptr Int64) -> Int64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es) -> Int -> "formats" ::: Ptr Int64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Int64)) (Int64
forall a. Zero a => a
zero)
    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
$ ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> ("formatCapacityInput" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es)
-> Int
-> "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Word32)) ("formatCapacityInput" ::: Word32
forall a. Zero a => a
zero)
    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
$ ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> ("formatCapacityInput" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es)
-> Int
-> "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 36 :: Ptr Word32)) ("formatCapacityInput" ::: Word32
forall a. Zero a => a
zero)
    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
$ ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> ("formatCapacityInput" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es)
-> Int
-> "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr Word32)) ("formatCapacityInput" ::: Word32
forall a. Zero a => a
zero)
    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
$ ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> ("formatCapacityInput" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es)
-> Int
-> "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 44 :: Ptr Word32)) ("formatCapacityInput" ::: Word32
forall a. Zero a => a
zero)
    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
$ ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> ("formatCapacityInput" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es)
-> Int
-> "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48 :: Ptr Word32)) ("formatCapacityInput" ::: Word32
forall a. Zero a => a
zero)
    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
$ ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> ("formatCapacityInput" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es)
-> Int
-> "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 52 :: Ptr Word32)) ("formatCapacityInput" ::: Word32
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 SwapchainCreateInfo es, PeekChain es) => FromCStruct (SwapchainCreateInfo es) where
  peekCStruct :: Ptr (SwapchainCreateInfo es) -> IO (SwapchainCreateInfo es)
peekCStruct p :: Ptr (SwapchainCreateInfo es)
p = do
    Ptr ()
next <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo 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 ()
next)
    SwapchainCreateFlags
createFlags <- Ptr SwapchainCreateFlags -> IO SwapchainCreateFlags
forall a. Storable a => Ptr a -> IO a
peek @SwapchainCreateFlags ((Ptr (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es) -> Int -> Ptr SwapchainCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr SwapchainCreateFlags))
    SwapchainUsageFlags
usageFlags <- Ptr SwapchainUsageFlags -> IO SwapchainUsageFlags
forall a. Storable a => Ptr a -> IO a
peek @SwapchainUsageFlags ((Ptr (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es) -> Int -> Ptr SwapchainUsageFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr SwapchainUsageFlags))
    Int64
format <- ("formats" ::: Ptr Int64) -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek @Int64 ((Ptr (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es) -> Int -> "formats" ::: Ptr Int64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Int64))
    "formatCapacityInput" ::: Word32
sampleCount <- ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> IO ("formatCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es)
-> Int
-> "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Word32))
    "formatCapacityInput" ::: Word32
width <- ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> IO ("formatCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es)
-> Int
-> "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 36 :: Ptr Word32))
    "formatCapacityInput" ::: Word32
height <- ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> IO ("formatCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es)
-> Int
-> "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr Word32))
    "formatCapacityInput" ::: Word32
faceCount <- ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> IO ("formatCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es)
-> Int
-> "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 44 :: Ptr Word32))
    "formatCapacityInput" ::: Word32
arraySize <- ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> IO ("formatCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es)
-> Int
-> "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48 :: Ptr Word32))
    "formatCapacityInput" ::: Word32
mipCount <- ("formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32))
-> IO ("formatCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (SwapchainCreateInfo es)
p Ptr (SwapchainCreateInfo es)
-> Int
-> "formatCountOutput" ::: Ptr ("formatCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 52 :: Ptr Word32))
    SwapchainCreateInfo es -> IO (SwapchainCreateInfo es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SwapchainCreateInfo es -> IO (SwapchainCreateInfo es))
-> SwapchainCreateInfo es -> IO (SwapchainCreateInfo es)
forall a b. (a -> b) -> a -> b
$ Chain es
-> SwapchainCreateFlags
-> SwapchainUsageFlags
-> Int64
-> ("formatCapacityInput" ::: Word32)
-> ("formatCapacityInput" ::: Word32)
-> ("formatCapacityInput" ::: Word32)
-> ("formatCapacityInput" ::: Word32)
-> ("formatCapacityInput" ::: Word32)
-> ("formatCapacityInput" ::: Word32)
-> SwapchainCreateInfo es
forall (es :: [*]).
Chain es
-> SwapchainCreateFlags
-> SwapchainUsageFlags
-> Int64
-> ("formatCapacityInput" ::: Word32)
-> ("formatCapacityInput" ::: Word32)
-> ("formatCapacityInput" ::: Word32)
-> ("formatCapacityInput" ::: Word32)
-> ("formatCapacityInput" ::: Word32)
-> ("formatCapacityInput" ::: Word32)
-> SwapchainCreateInfo es
SwapchainCreateInfo
             Chain es
next' SwapchainCreateFlags
createFlags SwapchainUsageFlags
usageFlags Int64
format "formatCapacityInput" ::: Word32
sampleCount "formatCapacityInput" ::: Word32
width "formatCapacityInput" ::: Word32
height "formatCapacityInput" ::: Word32
faceCount "formatCapacityInput" ::: Word32
arraySize "formatCapacityInput" ::: Word32
mipCount

instance es ~ '[] => Zero (SwapchainCreateInfo es) where
  zero :: SwapchainCreateInfo es
zero = Chain es
-> SwapchainCreateFlags
-> SwapchainUsageFlags
-> Int64
-> ("formatCapacityInput" ::: Word32)
-> ("formatCapacityInput" ::: Word32)
-> ("formatCapacityInput" ::: Word32)
-> ("formatCapacityInput" ::: Word32)
-> ("formatCapacityInput" ::: Word32)
-> ("formatCapacityInput" ::: Word32)
-> SwapchainCreateInfo es
forall (es :: [*]).
Chain es
-> SwapchainCreateFlags
-> SwapchainUsageFlags
-> Int64
-> ("formatCapacityInput" ::: Word32)
-> ("formatCapacityInput" ::: Word32)
-> ("formatCapacityInput" ::: Word32)
-> ("formatCapacityInput" ::: Word32)
-> ("formatCapacityInput" ::: Word32)
-> ("formatCapacityInput" ::: Word32)
-> SwapchainCreateInfo es
SwapchainCreateInfo
           ()
           SwapchainCreateFlags
forall a. Zero a => a
zero
           SwapchainUsageFlags
forall a. Zero a => a
zero
           Int64
forall a. Zero a => a
zero
           "formatCapacityInput" ::: Word32
forall a. Zero a => a
zero
           "formatCapacityInput" ::: Word32
forall a. Zero a => a
zero
           "formatCapacityInput" ::: Word32
forall a. Zero a => a
zero
           "formatCapacityInput" ::: Word32
forall a. Zero a => a
zero
           "formatCapacityInput" ::: Word32
forall a. Zero a => a
zero
           "formatCapacityInput" ::: Word32
forall a. Zero a => a
zero


-- | XrSwapchainImageBaseHeader - Image base header for a swapchain image
--
-- == Member Descriptions
--
-- = Description
--
-- The 'SwapchainImageBaseHeader' is a base structure that can be
-- overridden by a graphics API-specific @XrSwapchainImage*@ child
-- structure.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'enumerateSwapchainImages'
data SwapchainImageBaseHeader = SwapchainImageBaseHeader
  { -- | @type@ is the 'OpenXR.Core10.Enums.StructureType.StructureType' of this
    -- structure. This base structure itself has no associated
    -- 'OpenXR.Core10.Enums.StructureType.StructureType' value.
    --
    -- #VUID-XrSwapchainImageBaseHeader-type-type# @type@ /must/ be one of the
    -- following XrStructureType values:
    -- 'OpenXR.Core10.Enums.StructureType.TYPE_SWAPCHAIN_IMAGE_D3D11_KHR',
    -- 'OpenXR.Core10.Enums.StructureType.TYPE_SWAPCHAIN_IMAGE_D3D12_KHR',
    -- 'OpenXR.Core10.Enums.StructureType.TYPE_SWAPCHAIN_IMAGE_OPENGL_ES_KHR',
    -- 'OpenXR.Core10.Enums.StructureType.TYPE_SWAPCHAIN_IMAGE_OPENGL_KHR',
    -- 'OpenXR.Core10.Enums.StructureType.TYPE_SWAPCHAIN_IMAGE_VULKAN_KHR'
    SwapchainImageBaseHeader -> StructureType
type' :: StructureType }
  deriving (Typeable, SwapchainImageBaseHeader -> SwapchainImageBaseHeader -> Bool
(SwapchainImageBaseHeader -> SwapchainImageBaseHeader -> Bool)
-> (SwapchainImageBaseHeader -> SwapchainImageBaseHeader -> Bool)
-> Eq SwapchainImageBaseHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SwapchainImageBaseHeader -> SwapchainImageBaseHeader -> Bool
$c/= :: SwapchainImageBaseHeader -> SwapchainImageBaseHeader -> Bool
== :: SwapchainImageBaseHeader -> SwapchainImageBaseHeader -> Bool
$c== :: SwapchainImageBaseHeader -> SwapchainImageBaseHeader -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SwapchainImageBaseHeader)
#endif
deriving instance Show SwapchainImageBaseHeader

class ToCStruct a => IsSwapchainImage a where
  toSwapchainImageBaseHeader :: a -> SwapchainImageBaseHeader

instance Inheritable SwapchainImageBaseHeader where
  peekSomeCChild :: Ptr (SomeChild SwapchainImageBaseHeader) -> IO (SomeChild SwapchainImageBaseHeader)
  peekSomeCChild :: ("images" ::: Ptr (SomeChild SwapchainImageBaseHeader))
-> IO (SomeChild SwapchainImageBaseHeader)
peekSomeCChild p :: "images" ::: Ptr (SomeChild SwapchainImageBaseHeader)
p = do
    StructureType
ty <- Ptr StructureType -> IO StructureType
forall a. Storable a => Ptr a -> IO a
peek @StructureType (("images" ::: Ptr (SomeChild SwapchainImageBaseHeader))
-> Ptr StructureType
forall a b. Ptr a -> Ptr b
castPtr @(SomeChild SwapchainImageBaseHeader) @StructureType "images" ::: Ptr (SomeChild SwapchainImageBaseHeader)
p)
    case StructureType
ty of
      TYPE_SWAPCHAIN_IMAGE_D3D12_KHR -> SwapchainImageD3D12KHR -> SomeChild SwapchainImageBaseHeader
forall a b.
(Inherits a b, Typeable b, ToCStruct b, Show b) =>
b -> SomeChild a
SomeChild (SwapchainImageD3D12KHR -> SomeChild SwapchainImageBaseHeader)
-> IO SwapchainImageD3D12KHR
-> IO (SomeChild SwapchainImageBaseHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr SwapchainImageD3D12KHR -> IO SwapchainImageD3D12KHR
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct (("images" ::: Ptr (SomeChild SwapchainImageBaseHeader))
-> Ptr SwapchainImageD3D12KHR
forall a b. Ptr a -> Ptr b
castPtr @(SomeChild SwapchainImageBaseHeader) @SwapchainImageD3D12KHR "images" ::: Ptr (SomeChild SwapchainImageBaseHeader)
p)
      TYPE_SWAPCHAIN_IMAGE_D3D11_KHR -> SwapchainImageD3D11KHR -> SomeChild SwapchainImageBaseHeader
forall a b.
(Inherits a b, Typeable b, ToCStruct b, Show b) =>
b -> SomeChild a
SomeChild (SwapchainImageD3D11KHR -> SomeChild SwapchainImageBaseHeader)
-> IO SwapchainImageD3D11KHR
-> IO (SomeChild SwapchainImageBaseHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr SwapchainImageD3D11KHR -> IO SwapchainImageD3D11KHR
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct (("images" ::: Ptr (SomeChild SwapchainImageBaseHeader))
-> Ptr SwapchainImageD3D11KHR
forall a b. Ptr a -> Ptr b
castPtr @(SomeChild SwapchainImageBaseHeader) @SwapchainImageD3D11KHR "images" ::: Ptr (SomeChild SwapchainImageBaseHeader)
p)
      TYPE_SWAPCHAIN_IMAGE_VULKAN_KHR -> SwapchainImageVulkanKHR -> SomeChild SwapchainImageBaseHeader
forall a b.
(Inherits a b, Typeable b, ToCStruct b, Show b) =>
b -> SomeChild a
SomeChild (SwapchainImageVulkanKHR -> SomeChild SwapchainImageBaseHeader)
-> IO SwapchainImageVulkanKHR
-> IO (SomeChild SwapchainImageBaseHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr SwapchainImageVulkanKHR -> IO SwapchainImageVulkanKHR
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct (("images" ::: Ptr (SomeChild SwapchainImageBaseHeader))
-> Ptr SwapchainImageVulkanKHR
forall a b. Ptr a -> Ptr b
castPtr @(SomeChild SwapchainImageBaseHeader) @SwapchainImageVulkanKHR "images" ::: Ptr (SomeChild SwapchainImageBaseHeader)
p)
      TYPE_SWAPCHAIN_IMAGE_OPENGL_ES_KHR -> SwapchainImageOpenGLESKHR -> SomeChild SwapchainImageBaseHeader
forall a b.
(Inherits a b, Typeable b, ToCStruct b, Show b) =>
b -> SomeChild a
SomeChild (SwapchainImageOpenGLESKHR -> SomeChild SwapchainImageBaseHeader)
-> IO SwapchainImageOpenGLESKHR
-> IO (SomeChild SwapchainImageBaseHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr SwapchainImageOpenGLESKHR -> IO SwapchainImageOpenGLESKHR
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct (("images" ::: Ptr (SomeChild SwapchainImageBaseHeader))
-> Ptr SwapchainImageOpenGLESKHR
forall a b. Ptr a -> Ptr b
castPtr @(SomeChild SwapchainImageBaseHeader) @SwapchainImageOpenGLESKHR "images" ::: Ptr (SomeChild SwapchainImageBaseHeader)
p)
      TYPE_SWAPCHAIN_IMAGE_OPENGL_KHR -> SwapchainImageOpenGLKHR -> SomeChild SwapchainImageBaseHeader
forall a b.
(Inherits a b, Typeable b, ToCStruct b, Show b) =>
b -> SomeChild a
SomeChild (SwapchainImageOpenGLKHR -> SomeChild SwapchainImageBaseHeader)
-> IO SwapchainImageOpenGLKHR
-> IO (SomeChild SwapchainImageBaseHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr SwapchainImageOpenGLKHR -> IO SwapchainImageOpenGLKHR
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct (("images" ::: Ptr (SomeChild SwapchainImageBaseHeader))
-> Ptr SwapchainImageOpenGLKHR
forall a b. Ptr a -> Ptr b
castPtr @(SomeChild SwapchainImageBaseHeader) @SwapchainImageOpenGLKHR "images" ::: Ptr (SomeChild SwapchainImageBaseHeader)
p)
      c :: StructureType
c -> IOException -> IO (SomeChild SwapchainImageBaseHeader)
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO (SomeChild SwapchainImageBaseHeader))
-> IOException -> IO (SomeChild SwapchainImageBaseHeader)
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
          "peekSomeCChild"
          ("Illegal struct inheritance of SwapchainImageBaseHeader with " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> StructureType -> String
forall a. Show a => a -> String
show StructureType
c)
          Maybe CInt
forall a. Maybe a
Nothing
          Maybe String
forall a. Maybe a
Nothing

instance ToCStruct SwapchainImageBaseHeader where
  withCStruct :: SwapchainImageBaseHeader
-> (Ptr SwapchainImageBaseHeader -> IO b) -> IO b
withCStruct x :: SwapchainImageBaseHeader
x f :: Ptr SwapchainImageBaseHeader -> IO b
f = Int -> Int -> (Ptr SwapchainImageBaseHeader -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 16 8 ((Ptr SwapchainImageBaseHeader -> IO b) -> IO b)
-> (Ptr SwapchainImageBaseHeader -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr SwapchainImageBaseHeader
p -> Ptr SwapchainImageBaseHeader
-> SwapchainImageBaseHeader -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SwapchainImageBaseHeader
p SwapchainImageBaseHeader
x (Ptr SwapchainImageBaseHeader -> IO b
f Ptr SwapchainImageBaseHeader
p)
  pokeCStruct :: Ptr SwapchainImageBaseHeader
-> SwapchainImageBaseHeader -> IO b -> IO b
pokeCStruct p :: Ptr SwapchainImageBaseHeader
p SwapchainImageBaseHeader{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainImageBaseHeader
p Ptr SwapchainImageBaseHeader -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
type')
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainImageBaseHeader
p Ptr SwapchainImageBaseHeader -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO b
f
  cStructSize :: Int
cStructSize = 16
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr SwapchainImageBaseHeader -> IO b -> IO b
pokeZeroCStruct p :: Ptr SwapchainImageBaseHeader
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainImageBaseHeader
p Ptr SwapchainImageBaseHeader -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
forall a. Zero a => a
zero)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainImageBaseHeader
p Ptr SwapchainImageBaseHeader -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO b
f

instance FromCStruct SwapchainImageBaseHeader where
  peekCStruct :: Ptr SwapchainImageBaseHeader -> IO SwapchainImageBaseHeader
peekCStruct p :: Ptr SwapchainImageBaseHeader
p = do
    StructureType
type' <- Ptr StructureType -> IO StructureType
forall a. Storable a => Ptr a -> IO a
peek @StructureType ((Ptr SwapchainImageBaseHeader
p Ptr SwapchainImageBaseHeader -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType))
    SwapchainImageBaseHeader -> IO SwapchainImageBaseHeader
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SwapchainImageBaseHeader -> IO SwapchainImageBaseHeader)
-> SwapchainImageBaseHeader -> IO SwapchainImageBaseHeader
forall a b. (a -> b) -> a -> b
$ StructureType -> SwapchainImageBaseHeader
SwapchainImageBaseHeader
             StructureType
type'

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

instance Zero SwapchainImageBaseHeader where
  zero :: SwapchainImageBaseHeader
zero = StructureType -> SwapchainImageBaseHeader
SwapchainImageBaseHeader
           StructureType
forall a. Zero a => a
zero


-- | XrSwapchainImageAcquireInfo - Describes a swapchain image acquisition
--
-- == Member Descriptions
--
-- = Description
--
-- Because this structure only exists to support extension-specific
-- structures, 'acquireSwapchainImage' will accept a @NULL@ argument for
-- @acquireInfo@ for applications that are not using any relevant
-- extensions.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'acquireSwapchainImage'
data SwapchainImageAcquireInfo = SwapchainImageAcquireInfo
  {}
  deriving (Typeable, SwapchainImageAcquireInfo -> SwapchainImageAcquireInfo -> Bool
(SwapchainImageAcquireInfo -> SwapchainImageAcquireInfo -> Bool)
-> (SwapchainImageAcquireInfo -> SwapchainImageAcquireInfo -> Bool)
-> Eq SwapchainImageAcquireInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SwapchainImageAcquireInfo -> SwapchainImageAcquireInfo -> Bool
$c/= :: SwapchainImageAcquireInfo -> SwapchainImageAcquireInfo -> Bool
== :: SwapchainImageAcquireInfo -> SwapchainImageAcquireInfo -> Bool
$c== :: SwapchainImageAcquireInfo -> SwapchainImageAcquireInfo -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SwapchainImageAcquireInfo)
#endif
deriving instance Show SwapchainImageAcquireInfo

instance ToCStruct SwapchainImageAcquireInfo where
  withCStruct :: SwapchainImageAcquireInfo
-> (Ptr SwapchainImageAcquireInfo -> IO b) -> IO b
withCStruct x :: SwapchainImageAcquireInfo
x f :: Ptr SwapchainImageAcquireInfo -> IO b
f = Int -> Int -> (Ptr SwapchainImageAcquireInfo -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 16 8 ((Ptr SwapchainImageAcquireInfo -> IO b) -> IO b)
-> (Ptr SwapchainImageAcquireInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr SwapchainImageAcquireInfo
p -> Ptr SwapchainImageAcquireInfo
-> SwapchainImageAcquireInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SwapchainImageAcquireInfo
p SwapchainImageAcquireInfo
x (Ptr SwapchainImageAcquireInfo -> IO b
f Ptr SwapchainImageAcquireInfo
p)
  pokeCStruct :: Ptr SwapchainImageAcquireInfo
-> SwapchainImageAcquireInfo -> IO b -> IO b
pokeCStruct p :: Ptr SwapchainImageAcquireInfo
p SwapchainImageAcquireInfo f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainImageAcquireInfo
p Ptr SwapchainImageAcquireInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SWAPCHAIN_IMAGE_ACQUIRE_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainImageAcquireInfo
p Ptr SwapchainImageAcquireInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO b
f
  cStructSize :: Int
cStructSize = 16
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr SwapchainImageAcquireInfo -> IO b -> IO b
pokeZeroCStruct p :: Ptr SwapchainImageAcquireInfo
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainImageAcquireInfo
p Ptr SwapchainImageAcquireInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SWAPCHAIN_IMAGE_ACQUIRE_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainImageAcquireInfo
p Ptr SwapchainImageAcquireInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO b
f

instance FromCStruct SwapchainImageAcquireInfo where
  peekCStruct :: Ptr SwapchainImageAcquireInfo -> IO SwapchainImageAcquireInfo
peekCStruct _ = SwapchainImageAcquireInfo -> IO SwapchainImageAcquireInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SwapchainImageAcquireInfo -> IO SwapchainImageAcquireInfo)
-> SwapchainImageAcquireInfo -> IO SwapchainImageAcquireInfo
forall a b. (a -> b) -> a -> b
$ SwapchainImageAcquireInfo
SwapchainImageAcquireInfo
                           

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

instance Zero SwapchainImageAcquireInfo where
  zero :: SwapchainImageAcquireInfo
zero = SwapchainImageAcquireInfo
SwapchainImageAcquireInfo
           


-- | XrSwapchainImageWaitInfo - Describes a swapchain image wait operation
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrDuration >,
-- 'OpenXR.Core10.Enums.StructureType.StructureType', 'waitSwapchainImage'
data SwapchainImageWaitInfo = SwapchainImageWaitInfo
  { -- | @timeout@ indicates how many nanoseconds the call should block waiting
    -- for the image to become available for writing.
    SwapchainImageWaitInfo -> Int64
timeout :: Duration }
  deriving (Typeable, SwapchainImageWaitInfo -> SwapchainImageWaitInfo -> Bool
(SwapchainImageWaitInfo -> SwapchainImageWaitInfo -> Bool)
-> (SwapchainImageWaitInfo -> SwapchainImageWaitInfo -> Bool)
-> Eq SwapchainImageWaitInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SwapchainImageWaitInfo -> SwapchainImageWaitInfo -> Bool
$c/= :: SwapchainImageWaitInfo -> SwapchainImageWaitInfo -> Bool
== :: SwapchainImageWaitInfo -> SwapchainImageWaitInfo -> Bool
$c== :: SwapchainImageWaitInfo -> SwapchainImageWaitInfo -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SwapchainImageWaitInfo)
#endif
deriving instance Show SwapchainImageWaitInfo

instance ToCStruct SwapchainImageWaitInfo where
  withCStruct :: SwapchainImageWaitInfo
-> (Ptr SwapchainImageWaitInfo -> IO b) -> IO b
withCStruct x :: SwapchainImageWaitInfo
x f :: Ptr SwapchainImageWaitInfo -> IO b
f = Int -> Int -> (Ptr SwapchainImageWaitInfo -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 24 8 ((Ptr SwapchainImageWaitInfo -> IO b) -> IO b)
-> (Ptr SwapchainImageWaitInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr SwapchainImageWaitInfo
p -> Ptr SwapchainImageWaitInfo
-> SwapchainImageWaitInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SwapchainImageWaitInfo
p SwapchainImageWaitInfo
x (Ptr SwapchainImageWaitInfo -> IO b
f Ptr SwapchainImageWaitInfo
p)
  pokeCStruct :: Ptr SwapchainImageWaitInfo
-> SwapchainImageWaitInfo -> IO b -> IO b
pokeCStruct p :: Ptr SwapchainImageWaitInfo
p SwapchainImageWaitInfo{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainImageWaitInfo
p Ptr SwapchainImageWaitInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SWAPCHAIN_IMAGE_WAIT_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainImageWaitInfo
p Ptr SwapchainImageWaitInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    ("formats" ::: Ptr Int64) -> Int64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainImageWaitInfo
p Ptr SwapchainImageWaitInfo -> Int -> "formats" ::: Ptr Int64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Duration)) (Int64
timeout)
    IO b
f
  cStructSize :: Int
cStructSize = 24
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr SwapchainImageWaitInfo -> IO b -> IO b
pokeZeroCStruct p :: Ptr SwapchainImageWaitInfo
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainImageWaitInfo
p Ptr SwapchainImageWaitInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SWAPCHAIN_IMAGE_WAIT_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainImageWaitInfo
p Ptr SwapchainImageWaitInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    ("formats" ::: Ptr Int64) -> Int64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainImageWaitInfo
p Ptr SwapchainImageWaitInfo -> Int -> "formats" ::: Ptr Int64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Duration)) (Int64
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct SwapchainImageWaitInfo where
  peekCStruct :: Ptr SwapchainImageWaitInfo -> IO SwapchainImageWaitInfo
peekCStruct p :: Ptr SwapchainImageWaitInfo
p = do
    Int64
timeout <- ("formats" ::: Ptr Int64) -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek @Duration ((Ptr SwapchainImageWaitInfo
p Ptr SwapchainImageWaitInfo -> Int -> "formats" ::: Ptr Int64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Duration))
    SwapchainImageWaitInfo -> IO SwapchainImageWaitInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SwapchainImageWaitInfo -> IO SwapchainImageWaitInfo)
-> SwapchainImageWaitInfo -> IO SwapchainImageWaitInfo
forall a b. (a -> b) -> a -> b
$ Int64 -> SwapchainImageWaitInfo
SwapchainImageWaitInfo
             Int64
timeout

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

instance Zero SwapchainImageWaitInfo where
  zero :: SwapchainImageWaitInfo
zero = Int64 -> SwapchainImageWaitInfo
SwapchainImageWaitInfo
           Int64
forall a. Zero a => a
zero


-- | XrSwapchainImageReleaseInfo - Describes a swapchain image release
--
-- == Member Descriptions
--
-- = Description
--
-- Because this structure only exists to support extension-specific
-- structures, 'releaseSwapchainImage' will accept a @NULL@ argument for
-- @releaseInfo@ for applications that are not using any relevant
-- extensions.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'releaseSwapchainImage'
data SwapchainImageReleaseInfo = SwapchainImageReleaseInfo
  {}
  deriving (Typeable, SwapchainImageReleaseInfo -> SwapchainImageReleaseInfo -> Bool
(SwapchainImageReleaseInfo -> SwapchainImageReleaseInfo -> Bool)
-> (SwapchainImageReleaseInfo -> SwapchainImageReleaseInfo -> Bool)
-> Eq SwapchainImageReleaseInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SwapchainImageReleaseInfo -> SwapchainImageReleaseInfo -> Bool
$c/= :: SwapchainImageReleaseInfo -> SwapchainImageReleaseInfo -> Bool
== :: SwapchainImageReleaseInfo -> SwapchainImageReleaseInfo -> Bool
$c== :: SwapchainImageReleaseInfo -> SwapchainImageReleaseInfo -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SwapchainImageReleaseInfo)
#endif
deriving instance Show SwapchainImageReleaseInfo

instance ToCStruct SwapchainImageReleaseInfo where
  withCStruct :: SwapchainImageReleaseInfo
-> (Ptr SwapchainImageReleaseInfo -> IO b) -> IO b
withCStruct x :: SwapchainImageReleaseInfo
x f :: Ptr SwapchainImageReleaseInfo -> IO b
f = Int -> Int -> (Ptr SwapchainImageReleaseInfo -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 16 8 ((Ptr SwapchainImageReleaseInfo -> IO b) -> IO b)
-> (Ptr SwapchainImageReleaseInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr SwapchainImageReleaseInfo
p -> Ptr SwapchainImageReleaseInfo
-> SwapchainImageReleaseInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SwapchainImageReleaseInfo
p SwapchainImageReleaseInfo
x (Ptr SwapchainImageReleaseInfo -> IO b
f Ptr SwapchainImageReleaseInfo
p)
  pokeCStruct :: Ptr SwapchainImageReleaseInfo
-> SwapchainImageReleaseInfo -> IO b -> IO b
pokeCStruct p :: Ptr SwapchainImageReleaseInfo
p SwapchainImageReleaseInfo f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainImageReleaseInfo
p Ptr SwapchainImageReleaseInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SWAPCHAIN_IMAGE_RELEASE_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainImageReleaseInfo
p Ptr SwapchainImageReleaseInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO b
f
  cStructSize :: Int
cStructSize = 16
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr SwapchainImageReleaseInfo -> IO b -> IO b
pokeZeroCStruct p :: Ptr SwapchainImageReleaseInfo
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainImageReleaseInfo
p Ptr SwapchainImageReleaseInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SWAPCHAIN_IMAGE_RELEASE_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainImageReleaseInfo
p Ptr SwapchainImageReleaseInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO b
f

instance FromCStruct SwapchainImageReleaseInfo where
  peekCStruct :: Ptr SwapchainImageReleaseInfo -> IO SwapchainImageReleaseInfo
peekCStruct _ = SwapchainImageReleaseInfo -> IO SwapchainImageReleaseInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SwapchainImageReleaseInfo -> IO SwapchainImageReleaseInfo)
-> SwapchainImageReleaseInfo -> IO SwapchainImageReleaseInfo
forall a b. (a -> b) -> a -> b
$ SwapchainImageReleaseInfo
SwapchainImageReleaseInfo
                           

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

instance Zero SwapchainImageReleaseInfo where
  zero :: SwapchainImageReleaseInfo
zero = SwapchainImageReleaseInfo
SwapchainImageReleaseInfo