{-# language CPP #-}
-- No documentation found for Chapter "Device"
module OpenXR.Core10.Device  ( getSystem
                             , getSystemProperties
                             , createSession
                             , withSession
                             , destroySession
                             , enumerateEnvironmentBlendModes
                             , SystemId(..)
                             , SystemGetInfo(..)
                             , SystemProperties(..)
                             , SystemGraphicsProperties(..)
                             , SystemTrackingProperties(..)
                             , SessionCreateInfo(..)
                             ) where

import OpenXR.CStruct.Utils (FixedArray)
import OpenXR.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (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 GHC.Show (showParen)
import Numeric (showHex)
import Data.ByteString (packCString)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
import OpenXR.CStruct (FromCStruct)
import OpenXR.CStruct (FromCStruct(..))
import OpenXR.CStruct (ToCStruct)
import OpenXR.CStruct (ToCStruct(..))
import OpenXR.Zero (Zero)
import OpenXR.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.Type.Equality ((:~:)(Refl))
import Data.Typeable (Typeable)
import Foreign.C.Types (CChar)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Word (Word64)
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import OpenXR.CStruct.Utils (advancePtrBytes)
import OpenXR.Core10.FundamentalTypes (bool32ToBool)
import OpenXR.Core10.FundamentalTypes (boolToBool32)
import OpenXR.CStruct.Extends (forgetExtensions)
import OpenXR.CStruct.Utils (lowerArrayPtr)
import OpenXR.CStruct.Utils (pokeFixedLengthNullTerminatedByteString)
import OpenXR.NamedType ((:::))
import OpenXR.Core10.FundamentalTypes (Bool32)
import OpenXR.CStruct.Extends (Chain)
import OpenXR.Core10.Enums.EnvironmentBlendMode (EnvironmentBlendMode)
import OpenXR.Core10.Enums.EnvironmentBlendMode (EnvironmentBlendMode(..))
import OpenXR.CStruct.Extends (Extends)
import OpenXR.CStruct.Extends (Extendss)
import OpenXR.CStruct.Extends (Extensible(..))
import OpenXR.Core10.Enums.FormFactor (FormFactor)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_D3D11_enable (GraphicsBindingD3D11KHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_D3D12_enable (GraphicsBindingD3D12KHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_MNDX_egl_enable (GraphicsBindingEGLMNDX)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_opengl_es_enable (GraphicsBindingOpenGLESAndroidKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_opengl_enable (GraphicsBindingOpenGLWaylandKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_opengl_enable (GraphicsBindingOpenGLWin32KHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_opengl_enable (GraphicsBindingOpenGLXcbKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_opengl_enable (GraphicsBindingOpenGLXlibKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_vulkan_enable (GraphicsBindingVulkanKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_holographic_window_attachment (HolographicWindowAttachmentMSFT)
import OpenXR.Core10.Handles (Instance)
import OpenXR.Core10.Handles (Instance(..))
import OpenXR.Dynamic (InstanceCmds(pXrCreateSession))
import OpenXR.Dynamic (InstanceCmds(pXrDestroySession))
import OpenXR.Dynamic (InstanceCmds(pXrEnumerateEnvironmentBlendModes))
import OpenXR.Dynamic (InstanceCmds(pXrGetSystem))
import OpenXR.Dynamic (InstanceCmds(pXrGetSystemProperties))
import OpenXR.Core10.Handles (Instance_T)
import OpenXR.Core10.APIConstants (MAX_SYSTEM_NAME_SIZE)
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 OpenXR.Core10.Handles (Session)
import OpenXR.Core10.Handles (Session(..))
import OpenXR.Core10.Handles (Session(Session))
import OpenXR.Core10.Enums.SessionCreateFlags (SessionCreateFlags)
import {-# SOURCE #-} OpenXR.Extensions.XR_EXTX_overlay (SessionCreateInfoOverlayEXTX)
import OpenXR.Core10.Handles (Session_T)
import OpenXR.CStruct.Extends (SomeStruct)
import OpenXR.Core10.Enums.StructureType (StructureType)
import {-# SOURCE #-} OpenXR.Extensions.XR_EXT_eye_gaze_interaction (SystemEyeGazeInteractionPropertiesEXT)
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_hand_tracking_mesh (SystemHandTrackingMeshPropertiesMSFT)
import {-# SOURCE #-} OpenXR.Extensions.XR_EXT_hand_tracking (SystemHandTrackingPropertiesEXT)
import OpenXR.Core10.Enums.ViewConfigurationType (ViewConfigurationType)
import OpenXR.Core10.Enums.ViewConfigurationType (ViewConfigurationType(..))
import OpenXR.Core10.Enums.Result (Result(SUCCESS))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_SESSION_CREATE_INFO))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_SYSTEM_GET_INFO))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_SYSTEM_PROPERTIES))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrGetSystem
  :: FunPtr (Ptr Instance_T -> Ptr SystemGetInfo -> Ptr SystemId -> IO Result) -> Ptr Instance_T -> Ptr SystemGetInfo -> Ptr SystemId -> IO Result

-- | xrGetSystem - Gets a system identifier
--
-- == Parameter Descriptions
--
-- = Description
--
-- To get an
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrSystemId >,
-- an application specifies its desired
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#form_factor_description form factor>
-- to 'getSystem' and gets the runtime’s
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrSystemId >
-- associated with that configuration.
--
-- If the form factor is supported but temporarily unavailable, 'getSystem'
-- /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_FORM_FACTOR_UNAVAILABLE'. A runtime
-- /may/ return 'OpenXR.Core10.Enums.Result.SUCCESS' on a subsequent call
-- for a form factor it previously returned
-- 'OpenXR.Core10.Enums.Result.ERROR_FORM_FACTOR_UNAVAILABLE'. For example,
-- connecting or warming up hardware might cause an unavailable form factor
-- to become available.
--
-- == 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'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_FORM_FACTOR_UNAVAILABLE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_FORM_FACTOR_UNSUPPORTED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
-- = See Also
--
-- 'OpenXR.Core10.APIConstants.NULL_SYSTEM_ID',
-- 'OpenXR.Core10.Handles.Instance', 'SystemGetInfo',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrSystemId >
getSystem :: forall io
           . (MonadIO io)
          => -- | @instance@ is the handle of the instance from which to get the
             -- information.
             --
             -- #VUID-xrGetSystem-instance-parameter# @instance@ /must/ be a valid
             -- 'OpenXR.Core10.Handles.Instance' handle
             Instance
          -> -- | @getInfo@ is a pointer to an 'SystemGetInfo' structure containing the
             -- application’s requests for a system.
             --
             -- #VUID-xrGetSystem-getInfo-parameter# @getInfo@ /must/ be a pointer to a
             -- valid 'SystemGetInfo' structure
             SystemGetInfo
          -> io (SystemId)
getSystem :: Instance -> SystemGetInfo -> io SystemId
getSystem instance' :: Instance
instance' getInfo :: SystemGetInfo
getInfo = IO SystemId -> io SystemId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SystemId -> io SystemId)
-> (ContT SystemId IO SystemId -> IO SystemId)
-> ContT SystemId IO SystemId
-> io SystemId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT SystemId IO SystemId -> IO SystemId
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT SystemId IO SystemId -> io SystemId)
-> ContT SystemId IO SystemId -> io SystemId
forall a b. (a -> b) -> a -> b
$ do
  let xrGetSystemPtr :: FunPtr
  (Ptr Instance_T -> Ptr SystemGetInfo -> Ptr SystemId -> IO Result)
xrGetSystemPtr = InstanceCmds
-> FunPtr
     (Ptr Instance_T -> Ptr SystemGetInfo -> Ptr SystemId -> IO Result)
pXrGetSystem (Instance -> InstanceCmds
instanceCmds (Instance
instance' :: Instance))
  IO () -> ContT SystemId IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT SystemId IO ()) -> IO () -> ContT SystemId IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Instance_T -> Ptr SystemGetInfo -> Ptr SystemId -> IO Result)
xrGetSystemPtr FunPtr
  (Ptr Instance_T -> Ptr SystemGetInfo -> Ptr SystemId -> IO Result)
-> FunPtr
     (Ptr Instance_T -> Ptr SystemGetInfo -> Ptr SystemId -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Instance_T -> Ptr SystemGetInfo -> Ptr SystemId -> 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 xrGetSystem is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrGetSystem' :: Ptr Instance_T -> Ptr SystemGetInfo -> Ptr SystemId -> IO Result
xrGetSystem' = FunPtr
  (Ptr Instance_T -> Ptr SystemGetInfo -> Ptr SystemId -> IO Result)
-> Ptr Instance_T -> Ptr SystemGetInfo -> Ptr SystemId -> IO Result
mkXrGetSystem FunPtr
  (Ptr Instance_T -> Ptr SystemGetInfo -> Ptr SystemId -> IO Result)
xrGetSystemPtr
  Ptr SystemGetInfo
getInfo' <- ((Ptr SystemGetInfo -> IO SystemId) -> IO SystemId)
-> ContT SystemId IO (Ptr SystemGetInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr SystemGetInfo -> IO SystemId) -> IO SystemId)
 -> ContT SystemId IO (Ptr SystemGetInfo))
-> ((Ptr SystemGetInfo -> IO SystemId) -> IO SystemId)
-> ContT SystemId IO (Ptr SystemGetInfo)
forall a b. (a -> b) -> a -> b
$ SystemGetInfo -> (Ptr SystemGetInfo -> IO SystemId) -> IO SystemId
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (SystemGetInfo
getInfo)
  Ptr SystemId
pSystemId <- ((Ptr SystemId -> IO SystemId) -> IO SystemId)
-> ContT SystemId IO (Ptr SystemId)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr SystemId -> IO SystemId) -> IO SystemId)
 -> ContT SystemId IO (Ptr SystemId))
-> ((Ptr SystemId -> IO SystemId) -> IO SystemId)
-> ContT SystemId IO (Ptr SystemId)
forall a b. (a -> b) -> a -> b
$ IO (Ptr SystemId)
-> (Ptr SystemId -> IO ())
-> (Ptr SystemId -> IO SystemId)
-> IO SystemId
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr SystemId)
forall a. Int -> IO (Ptr a)
callocBytes @SystemId 8) Ptr SystemId -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT SystemId IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT SystemId IO Result)
-> IO Result -> ContT SystemId IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrGetSystem" (Ptr Instance_T -> Ptr SystemGetInfo -> Ptr SystemId -> IO Result
xrGetSystem' (Instance -> Ptr Instance_T
instanceHandle (Instance
instance')) Ptr SystemGetInfo
getInfo' (Ptr SystemId
pSystemId))
  IO () -> ContT SystemId IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT SystemId IO ()) -> IO () -> ContT SystemId 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))
  SystemId
systemId <- IO SystemId -> ContT SystemId IO SystemId
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO SystemId -> ContT SystemId IO SystemId)
-> IO SystemId -> ContT SystemId IO SystemId
forall a b. (a -> b) -> a -> b
$ Ptr SystemId -> IO SystemId
forall a. Storable a => Ptr a -> IO a
peek @SystemId Ptr SystemId
pSystemId
  SystemId -> ContT SystemId IO SystemId
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SystemId -> ContT SystemId IO SystemId)
-> SystemId -> ContT SystemId IO SystemId
forall a b. (a -> b) -> a -> b
$ (SystemId
systemId)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrGetSystemProperties
  :: FunPtr (Ptr Instance_T -> SystemId -> Ptr (SomeStruct SystemProperties) -> IO Result) -> Ptr Instance_T -> SystemId -> Ptr (SomeStruct SystemProperties) -> IO Result

-- | xrGetSystemProperties - Gets the properties of a particular system
--
-- == Parameter Descriptions
--
-- = Description
--
-- An application /can/ call 'getSystemProperties' to retrieve information
-- about the system such as vendor ID, system name, and graphics and
-- tracking properties.
--
-- == 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'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_OUT_OF_MEMORY'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SYSTEM_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Instance',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrSystemId >,
-- 'SystemProperties'
getSystemProperties :: forall a io
                     . (Extendss SystemProperties a, PokeChain a, PeekChain a, MonadIO io)
                    => -- | @instance@ is the instance from which @systemId@ was retrieved.
                       --
                       -- #VUID-xrGetSystemProperties-instance-parameter# @instance@ /must/ be a
                       -- valid 'OpenXR.Core10.Handles.Instance' handle
                       Instance
                    -> -- | @systemId@ is the
                       -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrSystemId >
                       -- whose properties will be queried.
                       SystemId
                    -> io (SystemProperties a)
getSystemProperties :: Instance -> SystemId -> io (SystemProperties a)
getSystemProperties instance' :: Instance
instance' systemId :: SystemId
systemId = IO (SystemProperties a) -> io (SystemProperties a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SystemProperties a) -> io (SystemProperties a))
-> (ContT (SystemProperties a) IO (SystemProperties a)
    -> IO (SystemProperties a))
-> ContT (SystemProperties a) IO (SystemProperties a)
-> io (SystemProperties a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT (SystemProperties a) IO (SystemProperties a)
-> IO (SystemProperties a)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT (SystemProperties a) IO (SystemProperties a)
 -> io (SystemProperties a))
-> ContT (SystemProperties a) IO (SystemProperties a)
-> io (SystemProperties a)
forall a b. (a -> b) -> a -> b
$ do
  let xrGetSystemPropertiesPtr :: FunPtr
  (Ptr Instance_T
   -> SystemId
   -> ("properties" ::: Ptr (SomeStruct SystemProperties))
   -> IO Result)
xrGetSystemPropertiesPtr = InstanceCmds
-> FunPtr
     (Ptr Instance_T
      -> SystemId
      -> ("properties" ::: Ptr (SomeStruct SystemProperties))
      -> IO Result)
pXrGetSystemProperties (Instance -> InstanceCmds
instanceCmds (Instance
instance' :: Instance))
  IO () -> ContT (SystemProperties a) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (SystemProperties a) IO ())
-> IO () -> ContT (SystemProperties a) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Instance_T
   -> SystemId
   -> ("properties" ::: Ptr (SomeStruct SystemProperties))
   -> IO Result)
xrGetSystemPropertiesPtr FunPtr
  (Ptr Instance_T
   -> SystemId
   -> ("properties" ::: Ptr (SomeStruct SystemProperties))
   -> IO Result)
-> FunPtr
     (Ptr Instance_T
      -> SystemId
      -> ("properties" ::: Ptr (SomeStruct SystemProperties))
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Instance_T
   -> SystemId
   -> ("properties" ::: Ptr (SomeStruct SystemProperties))
   -> 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 xrGetSystemProperties is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrGetSystemProperties' :: Ptr Instance_T
-> SystemId
-> ("properties" ::: Ptr (SomeStruct SystemProperties))
-> IO Result
xrGetSystemProperties' = FunPtr
  (Ptr Instance_T
   -> SystemId
   -> ("properties" ::: Ptr (SomeStruct SystemProperties))
   -> IO Result)
-> Ptr Instance_T
-> SystemId
-> ("properties" ::: Ptr (SomeStruct SystemProperties))
-> IO Result
mkXrGetSystemProperties FunPtr
  (Ptr Instance_T
   -> SystemId
   -> ("properties" ::: Ptr (SomeStruct SystemProperties))
   -> IO Result)
xrGetSystemPropertiesPtr
  Ptr (SystemProperties a)
pProperties <- ((Ptr (SystemProperties a) -> IO (SystemProperties a))
 -> IO (SystemProperties a))
-> ContT (SystemProperties a) IO (Ptr (SystemProperties a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct (SystemProperties a) =>
(Ptr (SystemProperties a) -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @(SystemProperties _))
  Result
r <- IO Result -> ContT (SystemProperties a) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT (SystemProperties a) IO Result)
-> IO Result -> ContT (SystemProperties a) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrGetSystemProperties" (Ptr Instance_T
-> SystemId
-> ("properties" ::: Ptr (SomeStruct SystemProperties))
-> IO Result
xrGetSystemProperties' (Instance -> Ptr Instance_T
instanceHandle (Instance
instance')) (SystemId
systemId) (Ptr (SystemProperties a)
-> "properties" ::: Ptr (SomeStruct SystemProperties)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (SystemProperties a)
pProperties)))
  IO () -> ContT (SystemProperties a) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (SystemProperties a) IO ())
-> IO () -> ContT (SystemProperties 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))
  SystemProperties a
properties <- IO (SystemProperties a)
-> ContT (SystemProperties a) IO (SystemProperties a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (SystemProperties a)
 -> ContT (SystemProperties a) IO (SystemProperties a))
-> IO (SystemProperties a)
-> ContT (SystemProperties a) IO (SystemProperties a)
forall a b. (a -> b) -> a -> b
$ Ptr (SystemProperties a) -> IO (SystemProperties a)
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @(SystemProperties _) Ptr (SystemProperties a)
pProperties
  SystemProperties a
-> ContT (SystemProperties a) IO (SystemProperties a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SystemProperties a
 -> ContT (SystemProperties a) IO (SystemProperties a))
-> SystemProperties a
-> ContT (SystemProperties a) IO (SystemProperties a)
forall a b. (a -> b) -> a -> b
$ (SystemProperties a
properties)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrCreateSession
  :: FunPtr (Ptr Instance_T -> Ptr (SomeStruct SessionCreateInfo) -> Ptr (Ptr Session_T) -> IO Result) -> Ptr Instance_T -> Ptr (SomeStruct SessionCreateInfo) -> Ptr (Ptr Session_T) -> IO Result

-- | xrCreateSession - Creates an XrSession
--
-- == Parameter Descriptions
--
-- = Description
--
-- Creates a session using the provided @createInfo@ and returns a handle
-- to that session. This session is created in the
-- 'OpenXR.Core10.Enums.SessionState.SESSION_STATE_IDLE' state, and a
-- corresponding 'OpenXR.Core10.OtherTypes.EventDataSessionStateChanged'
-- event to the 'OpenXR.Core10.Enums.SessionState.SESSION_STATE_IDLE' state
-- /must/ be generated as the first such event for the new session.
--
-- == 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'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_OUT_OF_MEMORY'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_LIMIT_REACHED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INITIALIZATION_FAILED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SYSTEM_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_GRAPHICS_DEVICE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_GRAPHICS_REQUIREMENTS_CALL_MISSING'
--
-- = See Also
--
-- 'OpenXR.Core10.Instance.ExtensionProperties',
-- 'OpenXR.Core10.Handles.Instance', 'OpenXR.Core10.Handles.Session',
-- 'OpenXR.Core10.Enums.SessionCreateFlags.SessionCreateFlags',
-- 'SessionCreateInfo', 'OpenXR.Core10.Session.beginSession',
-- 'destroySession', 'OpenXR.Core10.Session.endSession'
createSession :: forall a io
               . (Extendss SessionCreateInfo a, PokeChain a, MonadIO io)
              => -- | @instance@ is the instance from which @systemId@ was retrieved.
                 --
                 -- #VUID-xrCreateSession-instance-parameter# @instance@ /must/ be a valid
                 -- 'OpenXR.Core10.Handles.Instance' handle
                 Instance
              -> -- | @createInfo@ is a pointer to an 'SessionCreateInfo' structure containing
                 -- information about how to create the session.
                 --
                 -- #VUID-xrCreateSession-createInfo-parameter# @createInfo@ /must/ be a
                 -- pointer to a valid 'SessionCreateInfo' structure
                 (SessionCreateInfo a)
              -> io (Session)
createSession :: Instance -> SessionCreateInfo a -> io Session
createSession instance' :: Instance
instance' createInfo :: SessionCreateInfo a
createInfo = IO Session -> io Session
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Session -> io Session)
-> (ContT Session IO Session -> IO Session)
-> ContT Session IO Session
-> io Session
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Session IO Session -> IO Session
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Session IO Session -> io Session)
-> ContT Session IO Session -> io Session
forall a b. (a -> b) -> a -> b
$ do
  let cmds :: InstanceCmds
cmds = Instance -> InstanceCmds
instanceCmds (Instance
instance' :: Instance)
  let xrCreateSessionPtr :: FunPtr
  (Ptr Instance_T
   -> ("createInfo" ::: Ptr (SomeStruct SessionCreateInfo))
   -> ("session" ::: Ptr (Ptr Session_T))
   -> IO Result)
xrCreateSessionPtr = InstanceCmds
-> FunPtr
     (Ptr Instance_T
      -> ("createInfo" ::: Ptr (SomeStruct SessionCreateInfo))
      -> ("session" ::: Ptr (Ptr Session_T))
      -> IO Result)
pXrCreateSession InstanceCmds
cmds
  IO () -> ContT Session IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Session IO ()) -> IO () -> ContT Session IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Instance_T
   -> ("createInfo" ::: Ptr (SomeStruct SessionCreateInfo))
   -> ("session" ::: Ptr (Ptr Session_T))
   -> IO Result)
xrCreateSessionPtr FunPtr
  (Ptr Instance_T
   -> ("createInfo" ::: Ptr (SomeStruct SessionCreateInfo))
   -> ("session" ::: Ptr (Ptr Session_T))
   -> IO Result)
-> FunPtr
     (Ptr Instance_T
      -> ("createInfo" ::: Ptr (SomeStruct SessionCreateInfo))
      -> ("session" ::: Ptr (Ptr Session_T))
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Instance_T
   -> ("createInfo" ::: Ptr (SomeStruct SessionCreateInfo))
   -> ("session" ::: Ptr (Ptr Session_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 xrCreateSession is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrCreateSession' :: Ptr Instance_T
-> ("createInfo" ::: Ptr (SomeStruct SessionCreateInfo))
-> ("session" ::: Ptr (Ptr Session_T))
-> IO Result
xrCreateSession' = FunPtr
  (Ptr Instance_T
   -> ("createInfo" ::: Ptr (SomeStruct SessionCreateInfo))
   -> ("session" ::: Ptr (Ptr Session_T))
   -> IO Result)
-> Ptr Instance_T
-> ("createInfo" ::: Ptr (SomeStruct SessionCreateInfo))
-> ("session" ::: Ptr (Ptr Session_T))
-> IO Result
mkXrCreateSession FunPtr
  (Ptr Instance_T
   -> ("createInfo" ::: Ptr (SomeStruct SessionCreateInfo))
   -> ("session" ::: Ptr (Ptr Session_T))
   -> IO Result)
xrCreateSessionPtr
  Ptr (SessionCreateInfo a)
createInfo' <- ((Ptr (SessionCreateInfo a) -> IO Session) -> IO Session)
-> ContT Session IO (Ptr (SessionCreateInfo a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (SessionCreateInfo a) -> IO Session) -> IO Session)
 -> ContT Session IO (Ptr (SessionCreateInfo a)))
-> ((Ptr (SessionCreateInfo a) -> IO Session) -> IO Session)
-> ContT Session IO (Ptr (SessionCreateInfo a))
forall a b. (a -> b) -> a -> b
$ SessionCreateInfo a
-> (Ptr (SessionCreateInfo a) -> IO Session) -> IO Session
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (SessionCreateInfo a
createInfo)
  "session" ::: Ptr (Ptr Session_T)
pSession <- ((("session" ::: Ptr (Ptr Session_T)) -> IO Session) -> IO Session)
-> ContT Session IO ("session" ::: Ptr (Ptr Session_T))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("session" ::: Ptr (Ptr Session_T)) -> IO Session)
  -> IO Session)
 -> ContT Session IO ("session" ::: Ptr (Ptr Session_T)))
-> ((("session" ::: Ptr (Ptr Session_T)) -> IO Session)
    -> IO Session)
-> ContT Session IO ("session" ::: Ptr (Ptr Session_T))
forall a b. (a -> b) -> a -> b
$ IO ("session" ::: Ptr (Ptr Session_T))
-> (("session" ::: Ptr (Ptr Session_T)) -> IO ())
-> (("session" ::: Ptr (Ptr Session_T)) -> IO Session)
-> IO Session
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("session" ::: Ptr (Ptr Session_T))
forall a. Int -> IO (Ptr a)
callocBytes @(Ptr Session_T) 8) ("session" ::: Ptr (Ptr Session_T)) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT Session IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT Session IO Result)
-> IO Result -> ContT Session IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrCreateSession" (Ptr Instance_T
-> ("createInfo" ::: Ptr (SomeStruct SessionCreateInfo))
-> ("session" ::: Ptr (Ptr Session_T))
-> IO Result
xrCreateSession' (Instance -> Ptr Instance_T
instanceHandle (Instance
instance')) (Ptr (SessionCreateInfo a)
-> "createInfo" ::: Ptr (SomeStruct SessionCreateInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (SessionCreateInfo a)
createInfo') ("session" ::: Ptr (Ptr Session_T)
pSession))
  IO () -> ContT Session IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Session IO ()) -> IO () -> ContT Session 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 Session_T
session <- IO (Ptr Session_T) -> ContT Session IO (Ptr Session_T)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Ptr Session_T) -> ContT Session IO (Ptr Session_T))
-> IO (Ptr Session_T) -> ContT Session IO (Ptr Session_T)
forall a b. (a -> b) -> a -> b
$ ("session" ::: Ptr (Ptr Session_T)) -> IO (Ptr Session_T)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Session_T) "session" ::: Ptr (Ptr Session_T)
pSession
  Session -> ContT Session IO Session
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Session -> ContT Session IO Session)
-> Session -> ContT Session IO Session
forall a b. (a -> b) -> a -> b
$ (((\h :: Ptr Session_T
h -> Ptr Session_T -> InstanceCmds -> Session
Session Ptr Session_T
h InstanceCmds
cmds ) Ptr Session_T
session))

-- | A convenience wrapper to make a compatible pair of calls to
-- 'createSession' and 'destroySession'
--
-- To ensure that 'destroySession' 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.
--
withSession :: forall a io r . (Extendss SessionCreateInfo a, PokeChain a, MonadIO io) => Instance -> SessionCreateInfo a -> (io Session -> (Session -> io ()) -> r) -> r
withSession :: Instance
-> SessionCreateInfo a
-> (io Session -> (Session -> io ()) -> r)
-> r
withSession instance' :: Instance
instance' createInfo :: SessionCreateInfo a
createInfo b :: io Session -> (Session -> io ()) -> r
b =
  io Session -> (Session -> io ()) -> r
b (Instance -> SessionCreateInfo a -> io Session
forall (a :: [*]) (io :: * -> *).
(Extendss SessionCreateInfo a, PokeChain a, MonadIO io) =>
Instance -> SessionCreateInfo a -> io Session
createSession Instance
instance' SessionCreateInfo a
createInfo)
    (\(Session
o0) -> Session -> io ()
forall (io :: * -> *). MonadIO io => Session -> io ()
destroySession Session
o0)


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

-- | xrDestroySession - Destroys an XrSession
--
-- == Parameter Descriptions
--
-- = Description
--
-- 'OpenXR.Core10.Handles.Session' handles are destroyed using
-- 'destroySession'. When an 'OpenXR.Core10.Handles.Session' is destroyed,
-- all handles that are children of that 'OpenXR.Core10.Handles.Session'
-- are also destroyed.
--
-- The application is responsible for ensuring that it has no calls using
-- @session@ in progress when the session is destroyed.
--
-- 'destroySession' can be called when the session is in any session state.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-xrDestroySession-session-parameter# @session@ /must/ be a
--     valid 'OpenXR.Core10.Handles.Session' handle
--
-- == Thread Safety
--
-- -   Access to @session@, 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.Session', 'OpenXR.Core10.Session.beginSession',
-- 'createSession', 'OpenXR.Core10.Session.endSession'
destroySession :: forall io
                . (MonadIO io)
               => -- | @session@ is the session to destroy.
                  Session
               -> io ()
destroySession :: Session -> io ()
destroySession session :: Session
session = 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 xrDestroySessionPtr :: FunPtr (Ptr Session_T -> IO Result)
xrDestroySessionPtr = InstanceCmds -> FunPtr (Ptr Session_T -> IO Result)
pXrDestroySession (Session -> InstanceCmds
instanceCmds (Session
session :: Session))
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr (Ptr Session_T -> IO Result)
xrDestroySessionPtr FunPtr (Ptr Session_T -> IO Result)
-> FunPtr (Ptr Session_T -> IO Result) -> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr (Ptr Session_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 xrDestroySession is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrDestroySession' :: Ptr Session_T -> IO Result
xrDestroySession' = FunPtr (Ptr Session_T -> IO Result) -> Ptr Session_T -> IO Result
mkXrDestroySession FunPtr (Ptr Session_T -> IO Result)
xrDestroySessionPtr
  Result
r <- String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrDestroySession" (Ptr Session_T -> IO Result
xrDestroySession' (Session -> Ptr Session_T
sessionHandle (Session
session)))
  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" mkXrEnumerateEnvironmentBlendModes
  :: FunPtr (Ptr Instance_T -> SystemId -> ViewConfigurationType -> Word32 -> Ptr Word32 -> Ptr EnvironmentBlendMode -> IO Result) -> Ptr Instance_T -> SystemId -> ViewConfigurationType -> Word32 -> Ptr Word32 -> Ptr EnvironmentBlendMode -> IO Result

-- | xrEnumerateEnvironmentBlendModes - Lists environment blend modes
--
-- == Parameter Descriptions
--
-- -   @instance@ is the instance from which @systemId@ was retrieved.
--
-- -   @systemId@ is the
--     <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrSystemId >
--     whose environment blend modes will be enumerated.
--
-- -   @viewConfigurationType@ is the
--     'OpenXR.Core10.Enums.ViewConfigurationType.ViewConfigurationType' to
--     enumerate.
--
-- -   @environmentBlendModeCapacityInput@ is the capacity of the
--     @environmentBlendModes@ array, or 0 to indicate a request to
--     retrieve the required capacity.
--
-- -   @environmentBlendModeCountOutput@ is a pointer to the count of
--     @environmentBlendModes@ written, or a pointer to the required
--     capacity in the case that @environmentBlendModeCapacityInput@ is 0.
--
-- -   @environmentBlendModes@ is a pointer to an array of
--     'OpenXR.Core10.Enums.EnvironmentBlendMode.EnvironmentBlendMode'
--     values, but /can/ be @NULL@ if @environmentBlendModeCapacityInput@
--     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
--     @environmentBlendModes@ size.
--
-- = Description
--
-- Enumerates the set of environment blend modes that this runtime supports
-- for a given view configuration of the system. Environment blend modes
-- /should/ be in order from highest to lowest runtime preference.
--
-- Runtimes /must/ always return identical buffer contents from this
-- enumeration for the given @systemId@ and @viewConfigurationType@ for the
-- lifetime of the instance.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-xrEnumerateEnvironmentBlendModes-instance-parameter#
--     @instance@ /must/ be a valid 'OpenXR.Core10.Handles.Instance' handle
--
-- -   #VUID-xrEnumerateEnvironmentBlendModes-viewConfigurationType-parameter#
--     @viewConfigurationType@ /must/ be a valid
--     'OpenXR.Core10.Enums.ViewConfigurationType.ViewConfigurationType'
--     value
--
-- -   #VUID-xrEnumerateEnvironmentBlendModes-environmentBlendModeCountOutput-parameter#
--     @environmentBlendModeCountOutput@ /must/ be a pointer to a
--     @uint32_t@ value
--
-- -   #VUID-xrEnumerateEnvironmentBlendModes-environmentBlendModes-parameter#
--     If @environmentBlendModeCapacityInput@ is not @0@,
--     @environmentBlendModes@ /must/ be a pointer to an array of
--     @environmentBlendModeCapacityInput@
--     'OpenXR.Core10.Enums.EnvironmentBlendMode.EnvironmentBlendMode'
--     values
--
-- == 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_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SYSTEM_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VIEW_CONFIGURATION_TYPE_UNSUPPORTED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SIZE_INSUFFICIENT'
--
-- = See Also
--
-- 'OpenXR.Core10.Enums.EnvironmentBlendMode.EnvironmentBlendMode',
-- 'OpenXR.Core10.Handles.Instance',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrSystemId >,
-- 'OpenXR.Core10.Enums.ViewConfigurationType.ViewConfigurationType'
enumerateEnvironmentBlendModes :: forall io
                                . (MonadIO io)
                               => -- No documentation found for Nested "xrEnumerateEnvironmentBlendModes" "instance"
                                  Instance
                               -> -- No documentation found for Nested "xrEnumerateEnvironmentBlendModes" "systemId"
                                  SystemId
                               -> -- No documentation found for Nested "xrEnumerateEnvironmentBlendModes" "viewConfigurationType"
                                  ViewConfigurationType
                               -> io (("environmentBlendModes" ::: Vector EnvironmentBlendMode))
enumerateEnvironmentBlendModes :: Instance
-> SystemId
-> ViewConfigurationType
-> io ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
enumerateEnvironmentBlendModes instance' :: Instance
instance' systemId :: SystemId
systemId viewConfigurationType :: ViewConfigurationType
viewConfigurationType = IO ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
-> io ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
 -> io ("environmentBlendModes" ::: Vector EnvironmentBlendMode))
-> (ContT
      ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
      IO
      ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
    -> IO ("environmentBlendModes" ::: Vector EnvironmentBlendMode))
-> ContT
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
     IO
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
-> io ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
  IO
  ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
-> IO ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
   IO
   ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
 -> io ("environmentBlendModes" ::: Vector EnvironmentBlendMode))
-> ContT
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
     IO
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
-> io ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
forall a b. (a -> b) -> a -> b
$ do
  let xrEnumerateEnvironmentBlendModesPtr :: FunPtr
  (Ptr Instance_T
   -> SystemId
   -> ViewConfigurationType
   -> ("environmentBlendModeCapacityInput" ::: Word32)
   -> ("environmentBlendModeCountOutput"
       ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
   -> ("environmentBlendModes" ::: Ptr EnvironmentBlendMode)
   -> IO Result)
xrEnumerateEnvironmentBlendModesPtr = InstanceCmds
-> FunPtr
     (Ptr Instance_T
      -> SystemId
      -> ViewConfigurationType
      -> ("environmentBlendModeCapacityInput" ::: Word32)
      -> ("environmentBlendModeCountOutput"
          ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
      -> ("environmentBlendModes" ::: Ptr EnvironmentBlendMode)
      -> IO Result)
pXrEnumerateEnvironmentBlendModes (Instance -> InstanceCmds
instanceCmds (Instance
instance' :: Instance))
  IO ()
-> ContT
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      ("environmentBlendModes" ::: Vector EnvironmentBlendMode) IO ())
-> IO ()
-> ContT
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Instance_T
   -> SystemId
   -> ViewConfigurationType
   -> ("environmentBlendModeCapacityInput" ::: Word32)
   -> ("environmentBlendModeCountOutput"
       ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
   -> ("environmentBlendModes" ::: Ptr EnvironmentBlendMode)
   -> IO Result)
xrEnumerateEnvironmentBlendModesPtr FunPtr
  (Ptr Instance_T
   -> SystemId
   -> ViewConfigurationType
   -> ("environmentBlendModeCapacityInput" ::: Word32)
   -> ("environmentBlendModeCountOutput"
       ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
   -> ("environmentBlendModes" ::: Ptr EnvironmentBlendMode)
   -> IO Result)
-> FunPtr
     (Ptr Instance_T
      -> SystemId
      -> ViewConfigurationType
      -> ("environmentBlendModeCapacityInput" ::: Word32)
      -> ("environmentBlendModeCountOutput"
          ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
      -> ("environmentBlendModes" ::: Ptr EnvironmentBlendMode)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Instance_T
   -> SystemId
   -> ViewConfigurationType
   -> ("environmentBlendModeCapacityInput" ::: Word32)
   -> ("environmentBlendModeCountOutput"
       ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
   -> ("environmentBlendModes" ::: Ptr EnvironmentBlendMode)
   -> 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 xrEnumerateEnvironmentBlendModes is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrEnumerateEnvironmentBlendModes' :: Ptr Instance_T
-> SystemId
-> ViewConfigurationType
-> ("environmentBlendModeCapacityInput" ::: Word32)
-> ("environmentBlendModeCountOutput"
    ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
-> ("environmentBlendModes" ::: Ptr EnvironmentBlendMode)
-> IO Result
xrEnumerateEnvironmentBlendModes' = FunPtr
  (Ptr Instance_T
   -> SystemId
   -> ViewConfigurationType
   -> ("environmentBlendModeCapacityInput" ::: Word32)
   -> ("environmentBlendModeCountOutput"
       ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
   -> ("environmentBlendModes" ::: Ptr EnvironmentBlendMode)
   -> IO Result)
-> Ptr Instance_T
-> SystemId
-> ViewConfigurationType
-> ("environmentBlendModeCapacityInput" ::: Word32)
-> ("environmentBlendModeCountOutput"
    ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
-> ("environmentBlendModes" ::: Ptr EnvironmentBlendMode)
-> IO Result
mkXrEnumerateEnvironmentBlendModes FunPtr
  (Ptr Instance_T
   -> SystemId
   -> ViewConfigurationType
   -> ("environmentBlendModeCapacityInput" ::: Word32)
   -> ("environmentBlendModeCountOutput"
       ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
   -> ("environmentBlendModes" ::: Ptr EnvironmentBlendMode)
   -> IO Result)
xrEnumerateEnvironmentBlendModesPtr
  let instance'' :: Ptr Instance_T
instance'' = Instance -> Ptr Instance_T
instanceHandle (Instance
instance')
  "environmentBlendModeCountOutput"
::: Ptr ("environmentBlendModeCapacityInput" ::: Word32)
pEnvironmentBlendModeCountOutput <- ((("environmentBlendModeCountOutput"
   ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
  -> IO ("environmentBlendModes" ::: Vector EnvironmentBlendMode))
 -> IO ("environmentBlendModes" ::: Vector EnvironmentBlendMode))
-> ContT
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
     IO
     ("environmentBlendModeCountOutput"
      ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("environmentBlendModeCountOutput"
    ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
   -> IO ("environmentBlendModes" ::: Vector EnvironmentBlendMode))
  -> IO ("environmentBlendModes" ::: Vector EnvironmentBlendMode))
 -> ContT
      ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
      IO
      ("environmentBlendModeCountOutput"
       ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32)))
-> ((("environmentBlendModeCountOutput"
      ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
     -> IO ("environmentBlendModes" ::: Vector EnvironmentBlendMode))
    -> IO ("environmentBlendModes" ::: Vector EnvironmentBlendMode))
-> ContT
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
     IO
     ("environmentBlendModeCountOutput"
      ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
forall a b. (a -> b) -> a -> b
$ IO
  ("environmentBlendModeCountOutput"
   ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
-> (("environmentBlendModeCountOutput"
     ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
    -> IO ())
-> (("environmentBlendModeCountOutput"
     ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
    -> IO ("environmentBlendModes" ::: Vector EnvironmentBlendMode))
-> IO ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int
-> IO
     ("environmentBlendModeCountOutput"
      ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
forall a. Int -> IO (Ptr a)
callocBytes @Word32 4) ("environmentBlendModeCountOutput"
 ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
-> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result
-> ContT
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT
      ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
      IO
      Result)
-> IO Result
-> ContT
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrEnumerateEnvironmentBlendModes" (Ptr Instance_T
-> SystemId
-> ViewConfigurationType
-> ("environmentBlendModeCapacityInput" ::: Word32)
-> ("environmentBlendModeCountOutput"
    ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
-> ("environmentBlendModes" ::: Ptr EnvironmentBlendMode)
-> IO Result
xrEnumerateEnvironmentBlendModes' Ptr Instance_T
instance'' (SystemId
systemId) (ViewConfigurationType
viewConfigurationType) (0) ("environmentBlendModeCountOutput"
::: Ptr ("environmentBlendModeCapacityInput" ::: Word32)
pEnvironmentBlendModeCountOutput) ("environmentBlendModes" ::: Ptr EnvironmentBlendMode
forall a. Ptr a
nullPtr))
  IO ()
-> ContT
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      ("environmentBlendModes" ::: Vector EnvironmentBlendMode) IO ())
-> IO ()
-> ContT
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode) 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))
  "environmentBlendModeCapacityInput" ::: Word32
environmentBlendModeCountOutput <- IO ("environmentBlendModeCapacityInput" ::: Word32)
-> ContT
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
     IO
     ("environmentBlendModeCapacityInput" ::: Word32)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("environmentBlendModeCapacityInput" ::: Word32)
 -> ContT
      ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
      IO
      ("environmentBlendModeCapacityInput" ::: Word32))
-> IO ("environmentBlendModeCapacityInput" ::: Word32)
-> ContT
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
     IO
     ("environmentBlendModeCapacityInput" ::: Word32)
forall a b. (a -> b) -> a -> b
$ ("environmentBlendModeCountOutput"
 ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
-> IO ("environmentBlendModeCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 "environmentBlendModeCountOutput"
::: Ptr ("environmentBlendModeCapacityInput" ::: Word32)
pEnvironmentBlendModeCountOutput
  "environmentBlendModes" ::: Ptr EnvironmentBlendMode
pEnvironmentBlendModes <- ((("environmentBlendModes" ::: Ptr EnvironmentBlendMode)
  -> IO ("environmentBlendModes" ::: Vector EnvironmentBlendMode))
 -> IO ("environmentBlendModes" ::: Vector EnvironmentBlendMode))
-> ContT
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
     IO
     ("environmentBlendModes" ::: Ptr EnvironmentBlendMode)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("environmentBlendModes" ::: Ptr EnvironmentBlendMode)
   -> IO ("environmentBlendModes" ::: Vector EnvironmentBlendMode))
  -> IO ("environmentBlendModes" ::: Vector EnvironmentBlendMode))
 -> ContT
      ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
      IO
      ("environmentBlendModes" ::: Ptr EnvironmentBlendMode))
-> ((("environmentBlendModes" ::: Ptr EnvironmentBlendMode)
     -> IO ("environmentBlendModes" ::: Vector EnvironmentBlendMode))
    -> IO ("environmentBlendModes" ::: Vector EnvironmentBlendMode))
-> ContT
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
     IO
     ("environmentBlendModes" ::: Ptr EnvironmentBlendMode)
forall a b. (a -> b) -> a -> b
$ IO ("environmentBlendModes" ::: Ptr EnvironmentBlendMode)
-> (("environmentBlendModes" ::: Ptr EnvironmentBlendMode)
    -> IO ())
-> (("environmentBlendModes" ::: Ptr EnvironmentBlendMode)
    -> IO ("environmentBlendModes" ::: Vector EnvironmentBlendMode))
-> IO ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("environmentBlendModes" ::: Ptr EnvironmentBlendMode)
forall a. Int -> IO (Ptr a)
callocBytes @EnvironmentBlendMode ((("environmentBlendModeCapacityInput" ::: Word32) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ("environmentBlendModeCapacityInput" ::: Word32
environmentBlendModeCountOutput)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 4)) ("environmentBlendModes" ::: Ptr EnvironmentBlendMode) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r' <- IO Result
-> ContT
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT
      ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
      IO
      Result)
-> IO Result
-> ContT
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrEnumerateEnvironmentBlendModes" (Ptr Instance_T
-> SystemId
-> ViewConfigurationType
-> ("environmentBlendModeCapacityInput" ::: Word32)
-> ("environmentBlendModeCountOutput"
    ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
-> ("environmentBlendModes" ::: Ptr EnvironmentBlendMode)
-> IO Result
xrEnumerateEnvironmentBlendModes' Ptr Instance_T
instance'' (SystemId
systemId) (ViewConfigurationType
viewConfigurationType) (("environmentBlendModeCapacityInput" ::: Word32
environmentBlendModeCountOutput)) ("environmentBlendModeCountOutput"
::: Ptr ("environmentBlendModeCapacityInput" ::: Word32)
pEnvironmentBlendModeCountOutput) ("environmentBlendModes" ::: Ptr EnvironmentBlendMode
pEnvironmentBlendModes))
  IO ()
-> ContT
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      ("environmentBlendModes" ::: Vector EnvironmentBlendMode) IO ())
-> IO ()
-> ContT
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode) 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'))
  "environmentBlendModeCapacityInput" ::: Word32
environmentBlendModeCountOutput' <- IO ("environmentBlendModeCapacityInput" ::: Word32)
-> ContT
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
     IO
     ("environmentBlendModeCapacityInput" ::: Word32)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("environmentBlendModeCapacityInput" ::: Word32)
 -> ContT
      ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
      IO
      ("environmentBlendModeCapacityInput" ::: Word32))
-> IO ("environmentBlendModeCapacityInput" ::: Word32)
-> ContT
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
     IO
     ("environmentBlendModeCapacityInput" ::: Word32)
forall a b. (a -> b) -> a -> b
$ ("environmentBlendModeCountOutput"
 ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
-> IO ("environmentBlendModeCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 "environmentBlendModeCountOutput"
::: Ptr ("environmentBlendModeCapacityInput" ::: Word32)
pEnvironmentBlendModeCountOutput
  "environmentBlendModes" ::: Vector EnvironmentBlendMode
environmentBlendModes' <- IO ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
-> ContT
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
     IO
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
 -> ContT
      ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
      IO
      ("environmentBlendModes" ::: Vector EnvironmentBlendMode))
-> IO ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
-> ContT
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
     IO
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
forall a b. (a -> b) -> a -> b
$ Int
-> (Int -> IO EnvironmentBlendMode)
-> IO ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (("environmentBlendModeCapacityInput" ::: Word32) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ("environmentBlendModeCapacityInput" ::: Word32
environmentBlendModeCountOutput')) (\i :: Int
i -> ("environmentBlendModes" ::: Ptr EnvironmentBlendMode)
-> IO EnvironmentBlendMode
forall a. Storable a => Ptr a -> IO a
peek @EnvironmentBlendMode (("environmentBlendModes" ::: Ptr EnvironmentBlendMode
pEnvironmentBlendModes ("environmentBlendModes" ::: Ptr EnvironmentBlendMode)
-> Int -> "environmentBlendModes" ::: Ptr EnvironmentBlendMode
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr EnvironmentBlendMode)))
  ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
-> ContT
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
     IO
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("environmentBlendModes" ::: Vector EnvironmentBlendMode)
 -> ContT
      ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
      IO
      ("environmentBlendModes" ::: Vector EnvironmentBlendMode))
-> ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
-> ContT
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
     IO
     ("environmentBlendModes" ::: Vector EnvironmentBlendMode)
forall a b. (a -> b) -> a -> b
$ ("environmentBlendModes" ::: Vector EnvironmentBlendMode
environmentBlendModes')


-- | XrSystemId - Identifier for a system
--
-- = Description
--
-- An
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrSystemId >
-- is an opaque atom used by the runtime to identify a system. The value
-- 'OpenXR.Core10.APIConstants.NULL_SYSTEM_ID' is considered an invalid
-- system.
--
-- = See Also
--
-- 'OpenXR.Core10.APIConstants.NULL_SYSTEM_ID', 'SessionCreateInfo',
-- 'SystemProperties',
-- 'OpenXR.Extensions.XR_KHR_vulkan_enable2.VulkanDeviceCreateInfoKHR',
-- 'OpenXR.Extensions.XR_KHR_vulkan_enable2.VulkanGraphicsDeviceGetInfoKHR',
-- 'OpenXR.Extensions.XR_KHR_vulkan_enable2.VulkanInstanceCreateInfoKHR',
-- 'enumerateEnvironmentBlendModes',
-- 'OpenXR.Core10.ViewConfigurations.enumerateViewConfigurationViews',
-- 'OpenXR.Core10.ViewConfigurations.enumerateViewConfigurations',
-- 'OpenXR.Extensions.XR_KHR_D3D11_enable.getD3D11GraphicsRequirementsKHR',
-- 'OpenXR.Extensions.XR_KHR_D3D12_enable.getD3D12GraphicsRequirementsKHR',
-- 'OpenXR.Extensions.XR_KHR_opengl_es_enable.getOpenGLESGraphicsRequirementsKHR',
-- 'OpenXR.Extensions.XR_KHR_opengl_enable.getOpenGLGraphicsRequirementsKHR',
-- 'getSystem', 'getSystemProperties',
-- 'OpenXR.Core10.ViewConfigurations.getViewConfigurationProperties',
-- 'OpenXR.Extensions.XR_KHR_vulkan_enable.getVulkanDeviceExtensionsKHR',
-- 'OpenXR.Extensions.XR_KHR_vulkan_enable.getVulkanGraphicsDeviceKHR',
-- 'OpenXR.Extensions.XR_KHR_vulkan_enable2.getVulkanGraphicsRequirements2KHR',
-- 'OpenXR.Extensions.XR_KHR_vulkan_enable.getVulkanGraphicsRequirementsKHR',
-- 'OpenXR.Extensions.XR_KHR_vulkan_enable.getVulkanInstanceExtensionsKHR'
newtype SystemId = SystemId Word64
  deriving newtype (SystemId -> SystemId -> Bool
(SystemId -> SystemId -> Bool)
-> (SystemId -> SystemId -> Bool) -> Eq SystemId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemId -> SystemId -> Bool
$c/= :: SystemId -> SystemId -> Bool
== :: SystemId -> SystemId -> Bool
$c== :: SystemId -> SystemId -> Bool
Eq, Eq SystemId
Eq SystemId =>
(SystemId -> SystemId -> Ordering)
-> (SystemId -> SystemId -> Bool)
-> (SystemId -> SystemId -> Bool)
-> (SystemId -> SystemId -> Bool)
-> (SystemId -> SystemId -> Bool)
-> (SystemId -> SystemId -> SystemId)
-> (SystemId -> SystemId -> SystemId)
-> Ord SystemId
SystemId -> SystemId -> Bool
SystemId -> SystemId -> Ordering
SystemId -> SystemId -> SystemId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SystemId -> SystemId -> SystemId
$cmin :: SystemId -> SystemId -> SystemId
max :: SystemId -> SystemId -> SystemId
$cmax :: SystemId -> SystemId -> SystemId
>= :: SystemId -> SystemId -> Bool
$c>= :: SystemId -> SystemId -> Bool
> :: SystemId -> SystemId -> Bool
$c> :: SystemId -> SystemId -> Bool
<= :: SystemId -> SystemId -> Bool
$c<= :: SystemId -> SystemId -> Bool
< :: SystemId -> SystemId -> Bool
$c< :: SystemId -> SystemId -> Bool
compare :: SystemId -> SystemId -> Ordering
$ccompare :: SystemId -> SystemId -> Ordering
$cp1Ord :: Eq SystemId
Ord, Ptr b -> Int -> IO SystemId
Ptr b -> Int -> SystemId -> IO ()
Ptr SystemId -> IO SystemId
Ptr SystemId -> Int -> IO SystemId
Ptr SystemId -> Int -> SystemId -> IO ()
Ptr SystemId -> SystemId -> IO ()
SystemId -> Int
(SystemId -> Int)
-> (SystemId -> Int)
-> (Ptr SystemId -> Int -> IO SystemId)
-> (Ptr SystemId -> Int -> SystemId -> IO ())
-> (forall b. Ptr b -> Int -> IO SystemId)
-> (forall b. Ptr b -> Int -> SystemId -> IO ())
-> (Ptr SystemId -> IO SystemId)
-> (Ptr SystemId -> SystemId -> IO ())
-> Storable SystemId
forall b. Ptr b -> Int -> IO SystemId
forall b. Ptr b -> Int -> SystemId -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr SystemId -> SystemId -> IO ()
$cpoke :: Ptr SystemId -> SystemId -> IO ()
peek :: Ptr SystemId -> IO SystemId
$cpeek :: Ptr SystemId -> IO SystemId
pokeByteOff :: Ptr b -> Int -> SystemId -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> SystemId -> IO ()
peekByteOff :: Ptr b -> Int -> IO SystemId
$cpeekByteOff :: forall b. Ptr b -> Int -> IO SystemId
pokeElemOff :: Ptr SystemId -> Int -> SystemId -> IO ()
$cpokeElemOff :: Ptr SystemId -> Int -> SystemId -> IO ()
peekElemOff :: Ptr SystemId -> Int -> IO SystemId
$cpeekElemOff :: Ptr SystemId -> Int -> IO SystemId
alignment :: SystemId -> Int
$calignment :: SystemId -> Int
sizeOf :: SystemId -> Int
$csizeOf :: SystemId -> Int
Storable, SystemId
SystemId -> Zero SystemId
forall a. a -> Zero a
zero :: SystemId
$czero :: SystemId
Zero)
instance Show SystemId where
  showsPrec :: Int -> SystemId -> ShowS
showsPrec p :: Int
p (SystemId x :: Word64
x) = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 11) (String -> ShowS
showString "SystemId 0x" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Word64
x)


-- | XrSystemGetInfo - Specifies desired attributes of the system
--
-- == Member Descriptions
--
-- = Description
--
-- The 'SystemGetInfo' structure specifies attributes about a system as
-- desired by an application.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'OpenXR.Core10.Enums.FormFactor.FormFactor',
-- 'OpenXR.Core10.Enums.StructureType.StructureType', 'getSystem'
data SystemGetInfo = SystemGetInfo
  { -- | @formFactor@ is the 'OpenXR.Core10.Enums.FormFactor.FormFactor'
    -- requested by the application.
    --
    -- #VUID-XrSystemGetInfo-formFactor-parameter# @formFactor@ /must/ be a
    -- valid 'OpenXR.Core10.Enums.FormFactor.FormFactor' value
    SystemGetInfo -> FormFactor
formFactor :: FormFactor }
  deriving (Typeable, SystemGetInfo -> SystemGetInfo -> Bool
(SystemGetInfo -> SystemGetInfo -> Bool)
-> (SystemGetInfo -> SystemGetInfo -> Bool) -> Eq SystemGetInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemGetInfo -> SystemGetInfo -> Bool
$c/= :: SystemGetInfo -> SystemGetInfo -> Bool
== :: SystemGetInfo -> SystemGetInfo -> Bool
$c== :: SystemGetInfo -> SystemGetInfo -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SystemGetInfo)
#endif
deriving instance Show SystemGetInfo

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

instance FromCStruct SystemGetInfo where
  peekCStruct :: Ptr SystemGetInfo -> IO SystemGetInfo
peekCStruct p :: Ptr SystemGetInfo
p = do
    FormFactor
formFactor <- Ptr FormFactor -> IO FormFactor
forall a. Storable a => Ptr a -> IO a
peek @FormFactor ((Ptr SystemGetInfo
p Ptr SystemGetInfo -> Int -> Ptr FormFactor
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr FormFactor))
    SystemGetInfo -> IO SystemGetInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SystemGetInfo -> IO SystemGetInfo)
-> SystemGetInfo -> IO SystemGetInfo
forall a b. (a -> b) -> a -> b
$ FormFactor -> SystemGetInfo
SystemGetInfo
             FormFactor
formFactor

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

instance Zero SystemGetInfo where
  zero :: SystemGetInfo
zero = FormFactor -> SystemGetInfo
SystemGetInfo
           FormFactor
forall a. Zero a => a
zero


-- | XrSystemProperties - Properties of a particular system
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'SystemGraphicsProperties',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrSystemId >,
-- 'SystemTrackingProperties', 'getSystem', 'getSystemProperties'
data SystemProperties (es :: [Type]) = SystemProperties
  { -- | @next@ is @NULL@ or a pointer to the next structure in a structure
    -- chain. No such structures are defined in core OpenXR.
    --
    -- #VUID-XrSystemProperties-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_EXT_eye_gaze_interaction.SystemEyeGazeInteractionPropertiesEXT',
    -- 'OpenXR.Extensions.XR_MSFT_hand_tracking_mesh.SystemHandTrackingMeshPropertiesMSFT',
    -- 'OpenXR.Extensions.XR_EXT_hand_tracking.SystemHandTrackingPropertiesEXT'
    SystemProperties es -> Chain es
next :: Chain es
  , -- | @systemId@ is the
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrSystemId >
    -- identifying the system.
    SystemProperties es -> SystemId
systemId :: SystemId
  , -- | @vendorId@ is a unique identifier for the vendor of the system.
    SystemProperties es
-> "environmentBlendModeCapacityInput" ::: Word32
vendorId :: Word32
  , -- | @systemName@ is a string containing the name of the system.
    SystemProperties es -> ByteString
systemName :: ByteString
  , -- | @graphicsProperties@ is an 'SystemGraphicsProperties' structure
    -- specifying the system graphics properties.
    SystemProperties es -> SystemGraphicsProperties
graphicsProperties :: SystemGraphicsProperties
  , -- | @trackingProperties@ is an 'SystemTrackingProperties' structure
    -- specifying system tracking properties.
    SystemProperties es -> SystemTrackingProperties
trackingProperties :: SystemTrackingProperties
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SystemProperties (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (SystemProperties es)

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

instance (Extendss SystemProperties es, PokeChain es) => ToCStruct (SystemProperties es) where
  withCStruct :: SystemProperties es -> (Ptr (SystemProperties es) -> IO b) -> IO b
withCStruct x :: SystemProperties es
x f :: Ptr (SystemProperties es) -> IO b
f = Int -> Int -> (Ptr (SystemProperties es) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 304 8 ((Ptr (SystemProperties es) -> IO b) -> IO b)
-> (Ptr (SystemProperties es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr (SystemProperties es)
p -> Ptr (SystemProperties es) -> SystemProperties es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (SystemProperties es)
p SystemProperties es
x (Ptr (SystemProperties es) -> IO b
f Ptr (SystemProperties es)
p)
  pokeCStruct :: Ptr (SystemProperties es) -> SystemProperties es -> IO b -> IO b
pokeCStruct p :: Ptr (SystemProperties es)
p SystemProperties{..} 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 (SystemProperties es)
p Ptr (SystemProperties es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SYSTEM_PROPERTIES)
    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 (SystemProperties es)
p Ptr (SystemProperties 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 SystemId -> SystemId -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SystemProperties es)
p Ptr (SystemProperties es) -> Int -> Ptr SystemId
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr SystemId)) (SystemId
systemId)
    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
$ ("environmentBlendModeCountOutput"
 ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
-> ("environmentBlendModeCapacityInput" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SystemProperties es)
p Ptr (SystemProperties es)
-> Int
-> "environmentBlendModeCountOutput"
   ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word32)) ("environmentBlendModeCapacityInput" ::: Word32
vendorId)
    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 (FixedArray MAX_SYSTEM_NAME_SIZE CChar) -> ByteString -> IO ()
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString ((Ptr (SystemProperties es)
p Ptr (SystemProperties es)
-> Int -> Ptr (FixedArray MAX_SYSTEM_NAME_SIZE CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 28 :: Ptr (FixedArray MAX_SYSTEM_NAME_SIZE CChar))) (ByteString
systemName)
    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 SystemGraphicsProperties -> SystemGraphicsProperties -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SystemProperties es)
p Ptr (SystemProperties es) -> Int -> Ptr SystemGraphicsProperties
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 284 :: Ptr SystemGraphicsProperties)) (SystemGraphicsProperties
graphicsProperties)
    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 SystemTrackingProperties -> SystemTrackingProperties -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SystemProperties es)
p Ptr (SystemProperties es) -> Int -> Ptr SystemTrackingProperties
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 296 :: Ptr SystemTrackingProperties)) (SystemTrackingProperties
trackingProperties)
    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 = 304
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr (SystemProperties es) -> IO b -> IO b
pokeZeroCStruct p :: Ptr (SystemProperties 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 (SystemProperties es)
p Ptr (SystemProperties es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SYSTEM_PROPERTIES)
    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 (SystemProperties es)
p Ptr (SystemProperties es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext'
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SystemId -> SystemId -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SystemProperties es)
p Ptr (SystemProperties es) -> Int -> Ptr SystemId
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr SystemId)) (SystemId
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
$ ("environmentBlendModeCountOutput"
 ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
-> ("environmentBlendModeCapacityInput" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SystemProperties es)
p Ptr (SystemProperties es)
-> Int
-> "environmentBlendModeCountOutput"
   ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word32)) ("environmentBlendModeCapacityInput" ::: 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
$ Ptr (FixedArray MAX_SYSTEM_NAME_SIZE CChar) -> ByteString -> IO ()
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString ((Ptr (SystemProperties es)
p Ptr (SystemProperties es)
-> Int -> Ptr (FixedArray MAX_SYSTEM_NAME_SIZE CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 28 :: Ptr (FixedArray MAX_SYSTEM_NAME_SIZE CChar))) (ByteString
forall a. Monoid a => a
mempty)
    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 SystemGraphicsProperties -> SystemGraphicsProperties -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SystemProperties es)
p Ptr (SystemProperties es) -> Int -> Ptr SystemGraphicsProperties
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 284 :: Ptr SystemGraphicsProperties)) (SystemGraphicsProperties
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
$ Ptr SystemTrackingProperties -> SystemTrackingProperties -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SystemProperties es)
p Ptr (SystemProperties es) -> Int -> Ptr SystemTrackingProperties
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 296 :: Ptr SystemTrackingProperties)) (SystemTrackingProperties
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 SystemProperties es, PeekChain es) => FromCStruct (SystemProperties es) where
  peekCStruct :: Ptr (SystemProperties es) -> IO (SystemProperties es)
peekCStruct p :: Ptr (SystemProperties es)
p = do
    Ptr ()
next <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (SystemProperties es)
p Ptr (SystemProperties 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)
    SystemId
systemId <- Ptr SystemId -> IO SystemId
forall a. Storable a => Ptr a -> IO a
peek @SystemId ((Ptr (SystemProperties es)
p Ptr (SystemProperties es) -> Int -> Ptr SystemId
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr SystemId))
    "environmentBlendModeCapacityInput" ::: Word32
vendorId <- ("environmentBlendModeCountOutput"
 ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
-> IO ("environmentBlendModeCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (SystemProperties es)
p Ptr (SystemProperties es)
-> Int
-> "environmentBlendModeCountOutput"
   ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word32))
    ByteString
systemName <- CString -> IO ByteString
packCString (Ptr (FixedArray MAX_SYSTEM_NAME_SIZE CChar) -> CString
forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr ((Ptr (SystemProperties es)
p Ptr (SystemProperties es)
-> Int -> Ptr (FixedArray MAX_SYSTEM_NAME_SIZE CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 28 :: Ptr (FixedArray MAX_SYSTEM_NAME_SIZE CChar))))
    SystemGraphicsProperties
graphicsProperties <- Ptr SystemGraphicsProperties -> IO SystemGraphicsProperties
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @SystemGraphicsProperties ((Ptr (SystemProperties es)
p Ptr (SystemProperties es) -> Int -> Ptr SystemGraphicsProperties
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 284 :: Ptr SystemGraphicsProperties))
    SystemTrackingProperties
trackingProperties <- Ptr SystemTrackingProperties -> IO SystemTrackingProperties
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @SystemTrackingProperties ((Ptr (SystemProperties es)
p Ptr (SystemProperties es) -> Int -> Ptr SystemTrackingProperties
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 296 :: Ptr SystemTrackingProperties))
    SystemProperties es -> IO (SystemProperties es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SystemProperties es -> IO (SystemProperties es))
-> SystemProperties es -> IO (SystemProperties es)
forall a b. (a -> b) -> a -> b
$ Chain es
-> SystemId
-> ("environmentBlendModeCapacityInput" ::: Word32)
-> ByteString
-> SystemGraphicsProperties
-> SystemTrackingProperties
-> SystemProperties es
forall (es :: [*]).
Chain es
-> SystemId
-> ("environmentBlendModeCapacityInput" ::: Word32)
-> ByteString
-> SystemGraphicsProperties
-> SystemTrackingProperties
-> SystemProperties es
SystemProperties
             Chain es
next' SystemId
systemId "environmentBlendModeCapacityInput" ::: Word32
vendorId ByteString
systemName SystemGraphicsProperties
graphicsProperties SystemTrackingProperties
trackingProperties

instance es ~ '[] => Zero (SystemProperties es) where
  zero :: SystemProperties es
zero = Chain es
-> SystemId
-> ("environmentBlendModeCapacityInput" ::: Word32)
-> ByteString
-> SystemGraphicsProperties
-> SystemTrackingProperties
-> SystemProperties es
forall (es :: [*]).
Chain es
-> SystemId
-> ("environmentBlendModeCapacityInput" ::: Word32)
-> ByteString
-> SystemGraphicsProperties
-> SystemTrackingProperties
-> SystemProperties es
SystemProperties
           ()
           SystemId
forall a. Zero a => a
zero
           "environmentBlendModeCapacityInput" ::: Word32
forall a. Zero a => a
zero
           ByteString
forall a. Monoid a => a
mempty
           SystemGraphicsProperties
forall a. Zero a => a
zero
           SystemTrackingProperties
forall a. Zero a => a
zero


-- | XrSystemGraphicsProperties - Graphics-related properties of a particular
-- system
--
-- == Member Descriptions
--
-- = See Also
--
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrSystemId >,
-- 'SystemProperties', 'SystemTrackingProperties', 'getSystem',
-- 'getSystemProperties'
data SystemGraphicsProperties = SystemGraphicsProperties
  { -- | @maxSwapchainImageHeight@ is the maximum swapchain image pixel height
    -- supported by this system.
    SystemGraphicsProperties
-> "environmentBlendModeCapacityInput" ::: Word32
maxSwapchainImageHeight :: Word32
  , -- | @maxSwapchainImageWidth@ is the maximum swapchain image pixel width
    -- supported by this system.
    SystemGraphicsProperties
-> "environmentBlendModeCapacityInput" ::: Word32
maxSwapchainImageWidth :: Word32
  , -- | @maxLayerCount@ is the maximum number of composition layers supported by
    -- this system. The runtime /must/ support at least
    -- 'OpenXR.Core10.APIConstants.MIN_COMPOSITION_LAYERS_SUPPORTED' layers.
    SystemGraphicsProperties
-> "environmentBlendModeCapacityInput" ::: Word32
maxLayerCount :: Word32
  }
  deriving (Typeable, SystemGraphicsProperties -> SystemGraphicsProperties -> Bool
(SystemGraphicsProperties -> SystemGraphicsProperties -> Bool)
-> (SystemGraphicsProperties -> SystemGraphicsProperties -> Bool)
-> Eq SystemGraphicsProperties
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemGraphicsProperties -> SystemGraphicsProperties -> Bool
$c/= :: SystemGraphicsProperties -> SystemGraphicsProperties -> Bool
== :: SystemGraphicsProperties -> SystemGraphicsProperties -> Bool
$c== :: SystemGraphicsProperties -> SystemGraphicsProperties -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SystemGraphicsProperties)
#endif
deriving instance Show SystemGraphicsProperties

instance ToCStruct SystemGraphicsProperties where
  withCStruct :: SystemGraphicsProperties
-> (Ptr SystemGraphicsProperties -> IO b) -> IO b
withCStruct x :: SystemGraphicsProperties
x f :: Ptr SystemGraphicsProperties -> IO b
f = Int -> Int -> (Ptr SystemGraphicsProperties -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 12 4 ((Ptr SystemGraphicsProperties -> IO b) -> IO b)
-> (Ptr SystemGraphicsProperties -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr SystemGraphicsProperties
p -> Ptr SystemGraphicsProperties
-> SystemGraphicsProperties -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SystemGraphicsProperties
p SystemGraphicsProperties
x (Ptr SystemGraphicsProperties -> IO b
f Ptr SystemGraphicsProperties
p)
  pokeCStruct :: Ptr SystemGraphicsProperties
-> SystemGraphicsProperties -> IO b -> IO b
pokeCStruct p :: Ptr SystemGraphicsProperties
p SystemGraphicsProperties{..} f :: IO b
f = do
    ("environmentBlendModeCountOutput"
 ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
-> ("environmentBlendModeCapacityInput" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SystemGraphicsProperties
p Ptr SystemGraphicsProperties
-> Int
-> "environmentBlendModeCountOutput"
   ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32)) ("environmentBlendModeCapacityInput" ::: Word32
maxSwapchainImageHeight)
    ("environmentBlendModeCountOutput"
 ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
-> ("environmentBlendModeCapacityInput" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SystemGraphicsProperties
p Ptr SystemGraphicsProperties
-> Int
-> "environmentBlendModeCountOutput"
   ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32)) ("environmentBlendModeCapacityInput" ::: Word32
maxSwapchainImageWidth)
    ("environmentBlendModeCountOutput"
 ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
-> ("environmentBlendModeCapacityInput" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SystemGraphicsProperties
p Ptr SystemGraphicsProperties
-> Int
-> "environmentBlendModeCountOutput"
   ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Word32)) ("environmentBlendModeCapacityInput" ::: Word32
maxLayerCount)
    IO b
f
  cStructSize :: Int
cStructSize = 12
  cStructAlignment :: Int
cStructAlignment = 4
  pokeZeroCStruct :: Ptr SystemGraphicsProperties -> IO b -> IO b
pokeZeroCStruct p :: Ptr SystemGraphicsProperties
p f :: IO b
f = do
    ("environmentBlendModeCountOutput"
 ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
-> ("environmentBlendModeCapacityInput" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SystemGraphicsProperties
p Ptr SystemGraphicsProperties
-> Int
-> "environmentBlendModeCountOutput"
   ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32)) ("environmentBlendModeCapacityInput" ::: Word32
forall a. Zero a => a
zero)
    ("environmentBlendModeCountOutput"
 ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
-> ("environmentBlendModeCapacityInput" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SystemGraphicsProperties
p Ptr SystemGraphicsProperties
-> Int
-> "environmentBlendModeCountOutput"
   ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32)) ("environmentBlendModeCapacityInput" ::: Word32
forall a. Zero a => a
zero)
    ("environmentBlendModeCountOutput"
 ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
-> ("environmentBlendModeCapacityInput" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SystemGraphicsProperties
p Ptr SystemGraphicsProperties
-> Int
-> "environmentBlendModeCountOutput"
   ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Word32)) ("environmentBlendModeCapacityInput" ::: Word32
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct SystemGraphicsProperties where
  peekCStruct :: Ptr SystemGraphicsProperties -> IO SystemGraphicsProperties
peekCStruct p :: Ptr SystemGraphicsProperties
p = do
    "environmentBlendModeCapacityInput" ::: Word32
maxSwapchainImageHeight <- ("environmentBlendModeCountOutput"
 ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
-> IO ("environmentBlendModeCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr SystemGraphicsProperties
p Ptr SystemGraphicsProperties
-> Int
-> "environmentBlendModeCountOutput"
   ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32))
    "environmentBlendModeCapacityInput" ::: Word32
maxSwapchainImageWidth <- ("environmentBlendModeCountOutput"
 ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
-> IO ("environmentBlendModeCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr SystemGraphicsProperties
p Ptr SystemGraphicsProperties
-> Int
-> "environmentBlendModeCountOutput"
   ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32))
    "environmentBlendModeCapacityInput" ::: Word32
maxLayerCount <- ("environmentBlendModeCountOutput"
 ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32))
-> IO ("environmentBlendModeCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr SystemGraphicsProperties
p Ptr SystemGraphicsProperties
-> Int
-> "environmentBlendModeCountOutput"
   ::: Ptr ("environmentBlendModeCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Word32))
    SystemGraphicsProperties -> IO SystemGraphicsProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SystemGraphicsProperties -> IO SystemGraphicsProperties)
-> SystemGraphicsProperties -> IO SystemGraphicsProperties
forall a b. (a -> b) -> a -> b
$ ("environmentBlendModeCapacityInput" ::: Word32)
-> ("environmentBlendModeCapacityInput" ::: Word32)
-> ("environmentBlendModeCapacityInput" ::: Word32)
-> SystemGraphicsProperties
SystemGraphicsProperties
             "environmentBlendModeCapacityInput" ::: Word32
maxSwapchainImageHeight "environmentBlendModeCapacityInput" ::: Word32
maxSwapchainImageWidth "environmentBlendModeCapacityInput" ::: Word32
maxLayerCount

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

instance Zero SystemGraphicsProperties where
  zero :: SystemGraphicsProperties
zero = ("environmentBlendModeCapacityInput" ::: Word32)
-> ("environmentBlendModeCapacityInput" ::: Word32)
-> ("environmentBlendModeCapacityInput" ::: Word32)
-> SystemGraphicsProperties
SystemGraphicsProperties
           "environmentBlendModeCapacityInput" ::: Word32
forall a. Zero a => a
zero
           "environmentBlendModeCapacityInput" ::: Word32
forall a. Zero a => a
zero
           "environmentBlendModeCapacityInput" ::: Word32
forall a. Zero a => a
zero


-- | XrSystemTrackingProperties - Tracking-related properties of a particular
-- system
--
-- == Member Descriptions
--
-- = See Also
--
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrBool32 >,
-- 'SystemGraphicsProperties',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrSystemId >,
-- 'SystemProperties', 'getSystem', 'getSystemProperties'
data SystemTrackingProperties = SystemTrackingProperties
  { -- | @orientationTracking@ is set to 'OpenXR.Core10.FundamentalTypes.TRUE' to
    -- indicate the system supports orientational tracking of the view pose(s),
    -- 'OpenXR.Core10.FundamentalTypes.FALSE' otherwise.
    SystemTrackingProperties -> Bool
orientationTracking :: Bool
  , -- | @positionTracking@ is set to 'OpenXR.Core10.FundamentalTypes.TRUE' to
    -- indicate the system supports positional tracking of the view pose(s),
    -- 'OpenXR.Core10.FundamentalTypes.FALSE' otherwise.
    SystemTrackingProperties -> Bool
positionTracking :: Bool
  }
  deriving (Typeable, SystemTrackingProperties -> SystemTrackingProperties -> Bool
(SystemTrackingProperties -> SystemTrackingProperties -> Bool)
-> (SystemTrackingProperties -> SystemTrackingProperties -> Bool)
-> Eq SystemTrackingProperties
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemTrackingProperties -> SystemTrackingProperties -> Bool
$c/= :: SystemTrackingProperties -> SystemTrackingProperties -> Bool
== :: SystemTrackingProperties -> SystemTrackingProperties -> Bool
$c== :: SystemTrackingProperties -> SystemTrackingProperties -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SystemTrackingProperties)
#endif
deriving instance Show SystemTrackingProperties

instance ToCStruct SystemTrackingProperties where
  withCStruct :: SystemTrackingProperties
-> (Ptr SystemTrackingProperties -> IO b) -> IO b
withCStruct x :: SystemTrackingProperties
x f :: Ptr SystemTrackingProperties -> IO b
f = Int -> Int -> (Ptr SystemTrackingProperties -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 8 4 ((Ptr SystemTrackingProperties -> IO b) -> IO b)
-> (Ptr SystemTrackingProperties -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr SystemTrackingProperties
p -> Ptr SystemTrackingProperties
-> SystemTrackingProperties -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SystemTrackingProperties
p SystemTrackingProperties
x (Ptr SystemTrackingProperties -> IO b
f Ptr SystemTrackingProperties
p)
  pokeCStruct :: Ptr SystemTrackingProperties
-> SystemTrackingProperties -> IO b -> IO b
pokeCStruct p :: Ptr SystemTrackingProperties
p SystemTrackingProperties{..} f :: IO b
f = do
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SystemTrackingProperties
p Ptr SystemTrackingProperties -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
orientationTracking))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SystemTrackingProperties
p Ptr SystemTrackingProperties -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
positionTracking))
    IO b
f
  cStructSize :: Int
cStructSize = 8
  cStructAlignment :: Int
cStructAlignment = 4
  pokeZeroCStruct :: Ptr SystemTrackingProperties -> IO b -> IO b
pokeZeroCStruct p :: Ptr SystemTrackingProperties
p f :: IO b
f = do
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SystemTrackingProperties
p Ptr SystemTrackingProperties -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SystemTrackingProperties
p Ptr SystemTrackingProperties -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct SystemTrackingProperties where
  peekCStruct :: Ptr SystemTrackingProperties -> IO SystemTrackingProperties
peekCStruct p :: Ptr SystemTrackingProperties
p = do
    Bool32
orientationTracking <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr SystemTrackingProperties
p Ptr SystemTrackingProperties -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Bool32))
    Bool32
positionTracking <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr SystemTrackingProperties
p Ptr SystemTrackingProperties -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Bool32))
    SystemTrackingProperties -> IO SystemTrackingProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SystemTrackingProperties -> IO SystemTrackingProperties)
-> SystemTrackingProperties -> IO SystemTrackingProperties
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> SystemTrackingProperties
SystemTrackingProperties
             (Bool32 -> Bool
bool32ToBool Bool32
orientationTracking) (Bool32 -> Bool
bool32ToBool Bool32
positionTracking)

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

instance Zero SystemTrackingProperties where
  zero :: SystemTrackingProperties
zero = Bool -> Bool -> SystemTrackingProperties
SystemTrackingProperties
           Bool
forall a. Zero a => a
zero
           Bool
forall a. Zero a => a
zero


-- | XrSessionCreateInfo - Creates a session
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'OpenXR.Core10.Enums.SessionCreateFlags.SessionCreateFlags',
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrSystemId >,
-- 'createSession'
data SessionCreateInfo (es :: [Type]) = SessionCreateInfo
  { -- | @next@ is @NULL@ or a pointer to the next structure in a structure
    -- chain. No such structures are defined in core OpenXR. Note that in most
    -- cases one graphics API extension specific struct needs to be in this
    -- next chain.
    --
    -- @next@, unless otherwise specified via an extension, /must/ contain
    -- exactly one graphics API binding structure (a structure whose name
    -- begins with @\"XrGraphicsBinding\"@) or
    -- 'OpenXR.Core10.Enums.Result.ERROR_GRAPHICS_DEVICE_INVALID' /must/ be
    -- returned.
    --
    -- #VUID-XrSessionCreateInfo-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_KHR_D3D11_enable.GraphicsBindingD3D11KHR',
    -- 'OpenXR.Extensions.XR_KHR_D3D12_enable.GraphicsBindingD3D12KHR',
    -- 'OpenXR.Extensions.XR_MNDX_egl_enable.GraphicsBindingEGLMNDX',
    -- 'OpenXR.Extensions.XR_KHR_opengl_es_enable.GraphicsBindingOpenGLESAndroidKHR',
    -- 'OpenXR.Extensions.XR_KHR_opengl_enable.GraphicsBindingOpenGLWaylandKHR',
    -- 'OpenXR.Extensions.XR_KHR_opengl_enable.GraphicsBindingOpenGLWin32KHR',
    -- 'OpenXR.Extensions.XR_KHR_opengl_enable.GraphicsBindingOpenGLXcbKHR',
    -- 'OpenXR.Extensions.XR_KHR_opengl_enable.GraphicsBindingOpenGLXlibKHR',
    -- 'OpenXR.Extensions.XR_KHR_vulkan_enable.GraphicsBindingVulkanKHR',
    -- 'OpenXR.Extensions.XR_MSFT_holographic_window_attachment.HolographicWindowAttachmentMSFT',
    -- 'OpenXR.Extensions.XR_EXTX_overlay.SessionCreateInfoOverlayEXTX'
    SessionCreateInfo es -> Chain es
next :: Chain es
  , -- | @createFlags@ identifies
    -- 'OpenXR.Core10.Enums.SessionCreateFlags.SessionCreateFlags' that apply
    -- to the creation.
    --
    -- #VUID-XrSessionCreateInfo-createFlags-zerobitmask# @createFlags@ /must/
    -- be @0@
    SessionCreateInfo es -> SessionCreateFlags
createFlags :: SessionCreateFlags
  , -- | @systemId@ is the
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrSystemId >
    -- representing the system of devices to be used by this session.
    --
    -- @systemId@ /must/ be a valid
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrSystemId >
    -- or 'OpenXR.Core10.Enums.Result.ERROR_SYSTEM_INVALID' /must/ be returned.
    SessionCreateInfo es -> SystemId
systemId :: SystemId
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SessionCreateInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (SessionCreateInfo es)

instance Extensible SessionCreateInfo where
  extensibleTypeName :: String
extensibleTypeName = "SessionCreateInfo"
  setNext :: SessionCreateInfo ds -> Chain es -> SessionCreateInfo es
setNext x :: SessionCreateInfo ds
x next :: Chain es
next = SessionCreateInfo ds
x{$sel:next:SessionCreateInfo :: Chain es
next = Chain es
next}
  getNext :: SessionCreateInfo es -> Chain es
getNext SessionCreateInfo{..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends SessionCreateInfo e => b) -> Maybe b
  extends :: proxy e -> (Extends SessionCreateInfo e => b) -> Maybe b
extends _ f :: Extends SessionCreateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable HolographicWindowAttachmentMSFT) =>
Maybe (e :~: HolographicWindowAttachmentMSFT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @HolographicWindowAttachmentMSFT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SessionCreateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable GraphicsBindingEGLMNDX) =>
Maybe (e :~: GraphicsBindingEGLMNDX)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @GraphicsBindingEGLMNDX = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SessionCreateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable SessionCreateInfoOverlayEXTX) =>
Maybe (e :~: SessionCreateInfoOverlayEXTX)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @SessionCreateInfoOverlayEXTX = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SessionCreateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable GraphicsBindingVulkanKHR) =>
Maybe (e :~: GraphicsBindingVulkanKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @GraphicsBindingVulkanKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SessionCreateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable GraphicsBindingOpenGLESAndroidKHR) =>
Maybe (e :~: GraphicsBindingOpenGLESAndroidKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @GraphicsBindingOpenGLESAndroidKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SessionCreateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable GraphicsBindingD3D12KHR) =>
Maybe (e :~: GraphicsBindingD3D12KHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @GraphicsBindingD3D12KHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SessionCreateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable GraphicsBindingD3D11KHR) =>
Maybe (e :~: GraphicsBindingD3D11KHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @GraphicsBindingD3D11KHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SessionCreateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable GraphicsBindingOpenGLWaylandKHR) =>
Maybe (e :~: GraphicsBindingOpenGLWaylandKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @GraphicsBindingOpenGLWaylandKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SessionCreateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable GraphicsBindingOpenGLXcbKHR) =>
Maybe (e :~: GraphicsBindingOpenGLXcbKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @GraphicsBindingOpenGLXcbKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SessionCreateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable GraphicsBindingOpenGLXlibKHR) =>
Maybe (e :~: GraphicsBindingOpenGLXlibKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @GraphicsBindingOpenGLXlibKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SessionCreateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable GraphicsBindingOpenGLWin32KHR) =>
Maybe (e :~: GraphicsBindingOpenGLWin32KHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @GraphicsBindingOpenGLWin32KHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SessionCreateInfo e => b
f
    | Bool
otherwise = Maybe b
forall a. Maybe a
Nothing

instance (Extendss SessionCreateInfo es, PokeChain es) => ToCStruct (SessionCreateInfo es) where
  withCStruct :: SessionCreateInfo es
-> (Ptr (SessionCreateInfo es) -> IO b) -> IO b
withCStruct x :: SessionCreateInfo es
x f :: Ptr (SessionCreateInfo es) -> IO b
f = Int -> Int -> (Ptr (SessionCreateInfo es) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((Ptr (SessionCreateInfo es) -> IO b) -> IO b)
-> (Ptr (SessionCreateInfo es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr (SessionCreateInfo es)
p -> Ptr (SessionCreateInfo es) -> SessionCreateInfo es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (SessionCreateInfo es)
p SessionCreateInfo es
x (Ptr (SessionCreateInfo es) -> IO b
f Ptr (SessionCreateInfo es)
p)
  pokeCStruct :: Ptr (SessionCreateInfo es) -> SessionCreateInfo es -> IO b -> IO b
pokeCStruct p :: Ptr (SessionCreateInfo es)
p SessionCreateInfo{..} 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 (SessionCreateInfo es)
p Ptr (SessionCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SESSION_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 (SessionCreateInfo es)
p Ptr (SessionCreateInfo 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 SessionCreateFlags -> SessionCreateFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SessionCreateInfo es)
p Ptr (SessionCreateInfo es) -> Int -> Ptr SessionCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr SessionCreateFlags)) (SessionCreateFlags
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 SystemId -> SystemId -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SessionCreateInfo es)
p Ptr (SessionCreateInfo es) -> Int -> Ptr SystemId
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr SystemId)) (SystemId
systemId)
    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 = 32
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr (SessionCreateInfo es) -> IO b -> IO b
pokeZeroCStruct p :: Ptr (SessionCreateInfo 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 (SessionCreateInfo es)
p Ptr (SessionCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SESSION_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 (SessionCreateInfo es)
p Ptr (SessionCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext'
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SystemId -> SystemId -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SessionCreateInfo es)
p Ptr (SessionCreateInfo es) -> Int -> Ptr SystemId
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr SystemId)) (SystemId
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 SessionCreateInfo es, PeekChain es) => FromCStruct (SessionCreateInfo es) where
  peekCStruct :: Ptr (SessionCreateInfo es) -> IO (SessionCreateInfo es)
peekCStruct p :: Ptr (SessionCreateInfo es)
p = do
    Ptr ()
next <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (SessionCreateInfo es)
p Ptr (SessionCreateInfo 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)
    SessionCreateFlags
createFlags <- Ptr SessionCreateFlags -> IO SessionCreateFlags
forall a. Storable a => Ptr a -> IO a
peek @SessionCreateFlags ((Ptr (SessionCreateInfo es)
p Ptr (SessionCreateInfo es) -> Int -> Ptr SessionCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr SessionCreateFlags))
    SystemId
systemId <- Ptr SystemId -> IO SystemId
forall a. Storable a => Ptr a -> IO a
peek @SystemId ((Ptr (SessionCreateInfo es)
p Ptr (SessionCreateInfo es) -> Int -> Ptr SystemId
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr SystemId))
    SessionCreateInfo es -> IO (SessionCreateInfo es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SessionCreateInfo es -> IO (SessionCreateInfo es))
-> SessionCreateInfo es -> IO (SessionCreateInfo es)
forall a b. (a -> b) -> a -> b
$ Chain es -> SessionCreateFlags -> SystemId -> SessionCreateInfo es
forall (es :: [*]).
Chain es -> SessionCreateFlags -> SystemId -> SessionCreateInfo es
SessionCreateInfo
             Chain es
next' SessionCreateFlags
createFlags SystemId
systemId

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