{-# language CPP #-}
-- | = Name
--
-- XR_KHR_D3D11_enable - instance extension
--
-- = Specification
--
-- See
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_KHR_D3D11_enable  XR_KHR_D3D11_enable>
-- in the main specification for complete information.
--
-- = Registered Extension Number
--
-- 28
--
-- = Revision
--
-- 5
--
-- = Extension and Version Dependencies
--
-- -   Requires OpenXR 1.0
--
-- = See Also
--
-- 'GraphicsBindingD3D11KHR', 'GraphicsRequirementsD3D11KHR',
-- 'SwapchainImageD3D11KHR', 'getD3D11GraphicsRequirementsKHR'
--
-- = Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_KHR_D3D11_enable OpenXR Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module OpenXR.Extensions.XR_KHR_D3D11_enable  ( getD3D11GraphicsRequirementsKHR
                                              , GraphicsBindingD3D11KHR(..)
                                              , SwapchainImageD3D11KHR(..)
                                              , GraphicsRequirementsD3D11KHR(..)
                                              , KHR_D3D11_enable_SPEC_VERSION
                                              , pattern KHR_D3D11_enable_SPEC_VERSION
                                              , KHR_D3D11_ENABLE_EXTENSION_NAME
                                              , pattern KHR_D3D11_ENABLE_EXTENSION_NAME
                                              , LUID
                                              , D3D_FEATURE_LEVEL
                                              , ID3D11Device
                                              , ID3D11Texture2D
                                              ) where

import OpenXR.Internal.Utils (traceAroundEvent)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytesAligned)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import OpenXR.CStruct (FromCStruct)
import OpenXR.CStruct (FromCStruct(..))
import OpenXR.CStruct (ToCStruct)
import OpenXR.CStruct (ToCStruct(..))
import OpenXR.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Word (Word64)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import OpenXR.Core10.Handles (Instance)
import OpenXR.Core10.Handles (Instance(..))
import OpenXR.Dynamic (InstanceCmds(pXrGetD3D11GraphicsRequirementsKHR))
import OpenXR.Core10.Handles (Instance_T)
import OpenXR.Core10.Image (IsSwapchainImage(..))
import OpenXR.Exception (OpenXrException(..))
import OpenXR.Core10.Enums.Result (Result)
import OpenXR.Core10.Enums.Result (Result(..))
import OpenXR.Core10.Enums.StructureType (StructureType)
import OpenXR.Core10.Image (SwapchainImageBaseHeader(..))
import OpenXR.Core10.Device (SystemId)
import OpenXR.Core10.Device (SystemId(..))
import OpenXR.Core10.Enums.Result (Result(SUCCESS))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_GRAPHICS_BINDING_D3D11_KHR))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_GRAPHICS_REQUIREMENTS_D3D11_KHR))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_SWAPCHAIN_IMAGE_D3D11_KHR))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrGetD3D11GraphicsRequirementsKHR
  :: FunPtr (Ptr Instance_T -> SystemId -> Ptr GraphicsRequirementsD3D11KHR -> IO Result) -> Ptr Instance_T -> SystemId -> Ptr GraphicsRequirementsD3D11KHR -> IO Result

-- | xrGetD3D11GraphicsRequirementsKHR - Retrieve the D3D11 feature level and
-- graphics device requirements for an instance and system
--
-- == Parameter Descriptions
--
-- = Description
--
-- The 'getD3D11GraphicsRequirementsKHR' function identifies to the
-- application what graphics device (Windows LUID) needs to be used and the
-- minimum feature level to use. The runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_GRAPHICS_REQUIREMENTS_CALL_MISSING'
-- ('OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE' /may/ be returned
-- due to legacy behavior) on calls to 'OpenXR.Core10.Device.createSession'
-- if 'getD3D11GraphicsRequirementsKHR' has not been called for the same
-- @instance@ and @systemId@. The LUID and feature level that
-- 'getD3D11GraphicsRequirementsKHR' returns should be used to create the
-- 'ID3D11Device' that the application passes to
-- 'OpenXR.Core10.Device.createSession' in the 'GraphicsBindingD3D11KHR'.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-xrGetD3D11GraphicsRequirementsKHR-extension-notenabled# The @@
--     extension /must/ be enabled prior to calling
--     'getD3D11GraphicsRequirementsKHR'
--
-- -   #VUID-xrGetD3D11GraphicsRequirementsKHR-instance-parameter#
--     @instance@ /must/ be a valid 'OpenXR.Core10.Handles.Instance' handle
--
-- -   #VUID-xrGetD3D11GraphicsRequirementsKHR-graphicsRequirements-parameter#
--     @graphicsRequirements@ /must/ be a pointer to an
--     'GraphicsRequirementsD3D11KHR' structure
--
-- == 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_SYSTEM_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_FUNCTION_UNSUPPORTED'
--
-- = See Also
--
-- 'GraphicsRequirementsD3D11KHR', 'OpenXR.Core10.Handles.Instance',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrSystemId >,
-- 'OpenXR.Core10.Device.createSession'
getD3D11GraphicsRequirementsKHR :: forall io
                                 . (MonadIO io)
                                => -- | @instance@ is an 'OpenXR.Core10.Handles.Instance' handle previously
                                   -- created with 'OpenXR.Core10.Instance.createInstance'.
                                   Instance
                                -> -- | @systemId@ is an
                                   -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrSystemId >
                                   -- handle for the system which will be used to create a session.
                                   SystemId
                                -> io (GraphicsRequirementsD3D11KHR)
getD3D11GraphicsRequirementsKHR :: Instance -> SystemId -> io GraphicsRequirementsD3D11KHR
getD3D11GraphicsRequirementsKHR instance' :: Instance
instance' systemId :: SystemId
systemId = IO GraphicsRequirementsD3D11KHR -> io GraphicsRequirementsD3D11KHR
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GraphicsRequirementsD3D11KHR
 -> io GraphicsRequirementsD3D11KHR)
-> (ContT
      GraphicsRequirementsD3D11KHR IO GraphicsRequirementsD3D11KHR
    -> IO GraphicsRequirementsD3D11KHR)
-> ContT
     GraphicsRequirementsD3D11KHR IO GraphicsRequirementsD3D11KHR
-> io GraphicsRequirementsD3D11KHR
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT GraphicsRequirementsD3D11KHR IO GraphicsRequirementsD3D11KHR
-> IO GraphicsRequirementsD3D11KHR
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT GraphicsRequirementsD3D11KHR IO GraphicsRequirementsD3D11KHR
 -> io GraphicsRequirementsD3D11KHR)
-> ContT
     GraphicsRequirementsD3D11KHR IO GraphicsRequirementsD3D11KHR
-> io GraphicsRequirementsD3D11KHR
forall a b. (a -> b) -> a -> b
$ do
  let xrGetD3D11GraphicsRequirementsKHRPtr :: FunPtr
  (Ptr Instance_T
   -> SystemId -> Ptr GraphicsRequirementsD3D11KHR -> IO Result)
xrGetD3D11GraphicsRequirementsKHRPtr = InstanceCmds
-> FunPtr
     (Ptr Instance_T
      -> SystemId -> Ptr GraphicsRequirementsD3D11KHR -> IO Result)
pXrGetD3D11GraphicsRequirementsKHR (Instance -> InstanceCmds
instanceCmds (Instance
instance' :: Instance))
  IO () -> ContT GraphicsRequirementsD3D11KHR IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT GraphicsRequirementsD3D11KHR IO ())
-> IO () -> ContT GraphicsRequirementsD3D11KHR IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Instance_T
   -> SystemId -> Ptr GraphicsRequirementsD3D11KHR -> IO Result)
xrGetD3D11GraphicsRequirementsKHRPtr FunPtr
  (Ptr Instance_T
   -> SystemId -> Ptr GraphicsRequirementsD3D11KHR -> IO Result)
-> FunPtr
     (Ptr Instance_T
      -> SystemId -> Ptr GraphicsRequirementsD3D11KHR -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Instance_T
   -> SystemId -> Ptr GraphicsRequirementsD3D11KHR -> 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 xrGetD3D11GraphicsRequirementsKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrGetD3D11GraphicsRequirementsKHR' :: Ptr Instance_T
-> SystemId -> Ptr GraphicsRequirementsD3D11KHR -> IO Result
xrGetD3D11GraphicsRequirementsKHR' = FunPtr
  (Ptr Instance_T
   -> SystemId -> Ptr GraphicsRequirementsD3D11KHR -> IO Result)
-> Ptr Instance_T
-> SystemId
-> Ptr GraphicsRequirementsD3D11KHR
-> IO Result
mkXrGetD3D11GraphicsRequirementsKHR FunPtr
  (Ptr Instance_T
   -> SystemId -> Ptr GraphicsRequirementsD3D11KHR -> IO Result)
xrGetD3D11GraphicsRequirementsKHRPtr
  Ptr GraphicsRequirementsD3D11KHR
pGraphicsRequirements <- ((Ptr GraphicsRequirementsD3D11KHR
  -> IO GraphicsRequirementsD3D11KHR)
 -> IO GraphicsRequirementsD3D11KHR)
-> ContT
     GraphicsRequirementsD3D11KHR IO (Ptr GraphicsRequirementsD3D11KHR)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct GraphicsRequirementsD3D11KHR =>
(Ptr GraphicsRequirementsD3D11KHR -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @GraphicsRequirementsD3D11KHR)
  Result
r <- IO Result -> ContT GraphicsRequirementsD3D11KHR IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT GraphicsRequirementsD3D11KHR IO Result)
-> IO Result -> ContT GraphicsRequirementsD3D11KHR IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrGetD3D11GraphicsRequirementsKHR" (Ptr Instance_T
-> SystemId -> Ptr GraphicsRequirementsD3D11KHR -> IO Result
xrGetD3D11GraphicsRequirementsKHR' (Instance -> Ptr Instance_T
instanceHandle (Instance
instance')) (SystemId
systemId) (Ptr GraphicsRequirementsD3D11KHR
pGraphicsRequirements))
  IO () -> ContT GraphicsRequirementsD3D11KHR IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT GraphicsRequirementsD3D11KHR IO ())
-> IO () -> ContT GraphicsRequirementsD3D11KHR 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))
  GraphicsRequirementsD3D11KHR
graphicsRequirements <- IO GraphicsRequirementsD3D11KHR
-> ContT
     GraphicsRequirementsD3D11KHR IO GraphicsRequirementsD3D11KHR
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO GraphicsRequirementsD3D11KHR
 -> ContT
      GraphicsRequirementsD3D11KHR IO GraphicsRequirementsD3D11KHR)
-> IO GraphicsRequirementsD3D11KHR
-> ContT
     GraphicsRequirementsD3D11KHR IO GraphicsRequirementsD3D11KHR
forall a b. (a -> b) -> a -> b
$ Ptr GraphicsRequirementsD3D11KHR -> IO GraphicsRequirementsD3D11KHR
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @GraphicsRequirementsD3D11KHR Ptr GraphicsRequirementsD3D11KHR
pGraphicsRequirements
  GraphicsRequirementsD3D11KHR
-> ContT
     GraphicsRequirementsD3D11KHR IO GraphicsRequirementsD3D11KHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GraphicsRequirementsD3D11KHR
 -> ContT
      GraphicsRequirementsD3D11KHR IO GraphicsRequirementsD3D11KHR)
-> GraphicsRequirementsD3D11KHR
-> ContT
     GraphicsRequirementsD3D11KHR IO GraphicsRequirementsD3D11KHR
forall a b. (a -> b) -> a -> b
$ (GraphicsRequirementsD3D11KHR
graphicsRequirements)


-- | XrGraphicsBindingD3D11KHR - The graphics binding structure to be passed
-- at session creation to use D3D11
--
-- == Member Descriptions
--
-- = Description
--
-- When creating a D3D11-backed 'OpenXR.Core10.Handles.Session', the
-- application will provide a pointer to an 'GraphicsBindingD3D11KHR' in
-- the @next@ chain of the 'OpenXR.Core10.Device.SessionCreateInfo'.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrGraphicsBindingD3D11KHR-extension-notenabled# The @@
--     extension /must/ be enabled prior to using 'GraphicsBindingD3D11KHR'
--
-- -   #VUID-XrGraphicsBindingD3D11KHR-type-type# @type@ /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_GRAPHICS_BINDING_D3D11_KHR'
--
-- -   #VUID-XrGraphicsBindingD3D11KHR-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>
--
-- -   #VUID-XrGraphicsBindingD3D11KHR-device-parameter# @device@ /must/ be
--     a pointer to an 'ID3D11Device' value
--
-- = See Also
--
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'OpenXR.Core10.Device.createSession'
data GraphicsBindingD3D11KHR = GraphicsBindingD3D11KHR
  { -- | @device@ is a pointer to a valid 'ID3D11Device' to use.
    GraphicsBindingD3D11KHR -> Ptr ID3D11Device
device :: Ptr ID3D11Device }
  deriving (Typeable, GraphicsBindingD3D11KHR -> GraphicsBindingD3D11KHR -> Bool
(GraphicsBindingD3D11KHR -> GraphicsBindingD3D11KHR -> Bool)
-> (GraphicsBindingD3D11KHR -> GraphicsBindingD3D11KHR -> Bool)
-> Eq GraphicsBindingD3D11KHR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GraphicsBindingD3D11KHR -> GraphicsBindingD3D11KHR -> Bool
$c/= :: GraphicsBindingD3D11KHR -> GraphicsBindingD3D11KHR -> Bool
== :: GraphicsBindingD3D11KHR -> GraphicsBindingD3D11KHR -> Bool
$c== :: GraphicsBindingD3D11KHR -> GraphicsBindingD3D11KHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (GraphicsBindingD3D11KHR)
#endif
deriving instance Show GraphicsBindingD3D11KHR

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

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

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

instance Zero GraphicsBindingD3D11KHR where
  zero :: GraphicsBindingD3D11KHR
zero = Ptr ID3D11Device -> GraphicsBindingD3D11KHR
GraphicsBindingD3D11KHR
           Ptr ID3D11Device
forall a. Zero a => a
zero


-- | XrSwapchainImageD3D11KHR - D3D11-specific swapchain image structure
--
-- == Member Descriptions
--
-- = Description
--
-- If a given session was created with 'GraphicsBindingD3D11KHR', the
-- following conditions /must/ apply.
--
-- -   Calls to 'OpenXR.Core10.Image.enumerateSwapchainImages' on an
--     'OpenXR.Core10.Handles.Swapchain' in that session /must/ return an
--     array of 'SwapchainImageD3D11KHR' structures.
--
-- -   Whenever an OpenXR function accepts an
--     'OpenXR.Core10.Image.SwapchainImageBaseHeader' pointer as a
--     parameter in that session, the runtime /must/ also accept a pointer
--     to an 'SwapchainImageD3D11KHR'.
--
-- The OpenXR runtime /must/ interpret the top-left corner of the swapchain
-- image as the coordinate origin unless specified otherwise by extension
-- functionality.
--
-- The OpenXR runtime /must/ interpret the swapchain images in a clip space
-- of positive Y pointing up, near Z plane at 0, and far Z plane at 1.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrSwapchainImageD3D11KHR-extension-notenabled# The @@
--     extension /must/ be enabled prior to using 'SwapchainImageD3D11KHR'
--
-- -   #VUID-XrSwapchainImageD3D11KHR-type-type# @type@ /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_SWAPCHAIN_IMAGE_D3D11_KHR'
--
-- -   #VUID-XrSwapchainImageD3D11KHR-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>
--
-- -   #VUID-XrSwapchainImageD3D11KHR-texture-parameter# @texture@ /must/
--     be a pointer to an 'ID3D11Texture2D' value
--
-- = See Also
--
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'OpenXR.Core10.Image.SwapchainImageBaseHeader'
data SwapchainImageD3D11KHR = SwapchainImageD3D11KHR
  { -- | @texture@ is a pointer to a valid 'ID3D11Texture2D' to use.
    SwapchainImageD3D11KHR -> Ptr ID3D11Texture2D
texture :: Ptr ID3D11Texture2D }
  deriving (Typeable, SwapchainImageD3D11KHR -> SwapchainImageD3D11KHR -> Bool
(SwapchainImageD3D11KHR -> SwapchainImageD3D11KHR -> Bool)
-> (SwapchainImageD3D11KHR -> SwapchainImageD3D11KHR -> Bool)
-> Eq SwapchainImageD3D11KHR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SwapchainImageD3D11KHR -> SwapchainImageD3D11KHR -> Bool
$c/= :: SwapchainImageD3D11KHR -> SwapchainImageD3D11KHR -> Bool
== :: SwapchainImageD3D11KHR -> SwapchainImageD3D11KHR -> Bool
$c== :: SwapchainImageD3D11KHR -> SwapchainImageD3D11KHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SwapchainImageD3D11KHR)
#endif
deriving instance Show SwapchainImageD3D11KHR

instance IsSwapchainImage SwapchainImageD3D11KHR where
  toSwapchainImageBaseHeader :: SwapchainImageD3D11KHR -> SwapchainImageBaseHeader
toSwapchainImageBaseHeader SwapchainImageD3D11KHR{} = $WSwapchainImageBaseHeader :: StructureType -> SwapchainImageBaseHeader
SwapchainImageBaseHeader{$sel:type':SwapchainImageBaseHeader :: StructureType
type' = StructureType
TYPE_SWAPCHAIN_IMAGE_D3D11_KHR}

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

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

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

instance Zero SwapchainImageD3D11KHR where
  zero :: SwapchainImageD3D11KHR
zero = Ptr ID3D11Texture2D -> SwapchainImageD3D11KHR
SwapchainImageD3D11KHR
           Ptr ID3D11Texture2D
forall a. Zero a => a
zero


-- | XrGraphicsRequirementsD3D11KHR - D3D11 feature level and LUID
-- requirements
--
-- == Member Descriptions
--
-- = Description
--
-- 'GraphicsRequirementsD3D11KHR' is populated by
-- 'getD3D11GraphicsRequirementsKHR'.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrGraphicsRequirementsD3D11KHR-extension-notenabled# The @@
--     extension /must/ be enabled prior to using
--     'GraphicsRequirementsD3D11KHR'
--
-- -   #VUID-XrGraphicsRequirementsD3D11KHR-type-type# @type@ /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_GRAPHICS_REQUIREMENTS_D3D11_KHR'
--
-- -   #VUID-XrGraphicsRequirementsD3D11KHR-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>
--
-- -   #VUID-XrGraphicsRequirementsD3D11KHR-adapterLuid-parameter#
--     @adapterLuid@ /must/ be a valid 'LUID' value
--
-- -   #VUID-XrGraphicsRequirementsD3D11KHR-minFeatureLevel-parameter#
--     @minFeatureLevel@ /must/ be a valid 'D3D_FEATURE_LEVEL' value
--
-- = See Also
--
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'getD3D11GraphicsRequirementsKHR'
data GraphicsRequirementsD3D11KHR = GraphicsRequirementsD3D11KHR
  { -- | @adapterLuid@ identifies what graphics device needs to be used.
    GraphicsRequirementsD3D11KHR -> LUID
adapterLuid :: LUID
  , -- | @minFeatureLevel@ is the minimum feature level that the D3D11 device
    -- must be initialized with.
    GraphicsRequirementsD3D11KHR -> D3D_FEATURE_LEVEL
minFeatureLevel :: D3D_FEATURE_LEVEL
  }
  deriving (Typeable, GraphicsRequirementsD3D11KHR
-> GraphicsRequirementsD3D11KHR -> Bool
(GraphicsRequirementsD3D11KHR
 -> GraphicsRequirementsD3D11KHR -> Bool)
-> (GraphicsRequirementsD3D11KHR
    -> GraphicsRequirementsD3D11KHR -> Bool)
-> Eq GraphicsRequirementsD3D11KHR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GraphicsRequirementsD3D11KHR
-> GraphicsRequirementsD3D11KHR -> Bool
$c/= :: GraphicsRequirementsD3D11KHR
-> GraphicsRequirementsD3D11KHR -> Bool
== :: GraphicsRequirementsD3D11KHR
-> GraphicsRequirementsD3D11KHR -> Bool
$c== :: GraphicsRequirementsD3D11KHR
-> GraphicsRequirementsD3D11KHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (GraphicsRequirementsD3D11KHR)
#endif
deriving instance Show GraphicsRequirementsD3D11KHR

instance ToCStruct GraphicsRequirementsD3D11KHR where
  withCStruct :: GraphicsRequirementsD3D11KHR
-> (Ptr GraphicsRequirementsD3D11KHR -> IO b) -> IO b
withCStruct x :: GraphicsRequirementsD3D11KHR
x f :: Ptr GraphicsRequirementsD3D11KHR -> IO b
f = Int -> Int -> (Ptr GraphicsRequirementsD3D11KHR -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((Ptr GraphicsRequirementsD3D11KHR -> IO b) -> IO b)
-> (Ptr GraphicsRequirementsD3D11KHR -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr GraphicsRequirementsD3D11KHR
p -> Ptr GraphicsRequirementsD3D11KHR
-> GraphicsRequirementsD3D11KHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr GraphicsRequirementsD3D11KHR
p GraphicsRequirementsD3D11KHR
x (Ptr GraphicsRequirementsD3D11KHR -> IO b
f Ptr GraphicsRequirementsD3D11KHR
p)
  pokeCStruct :: Ptr GraphicsRequirementsD3D11KHR
-> GraphicsRequirementsD3D11KHR -> IO b -> IO b
pokeCStruct p :: Ptr GraphicsRequirementsD3D11KHR
p GraphicsRequirementsD3D11KHR{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsRequirementsD3D11KHR
p Ptr GraphicsRequirementsD3D11KHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_GRAPHICS_REQUIREMENTS_D3D11_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsRequirementsD3D11KHR
p Ptr GraphicsRequirementsD3D11KHR -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr LUID -> LUID -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsRequirementsD3D11KHR
p Ptr GraphicsRequirementsD3D11KHR -> Int -> Ptr LUID
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr LUID)) (LUID
adapterLuid)
    Ptr D3D_FEATURE_LEVEL -> D3D_FEATURE_LEVEL -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsRequirementsD3D11KHR
p Ptr GraphicsRequirementsD3D11KHR -> Int -> Ptr D3D_FEATURE_LEVEL
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr D3D_FEATURE_LEVEL)) (D3D_FEATURE_LEVEL
minFeatureLevel)
    IO b
f
  cStructSize :: Int
cStructSize = 32
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr GraphicsRequirementsD3D11KHR -> IO b -> IO b
pokeZeroCStruct p :: Ptr GraphicsRequirementsD3D11KHR
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsRequirementsD3D11KHR
p Ptr GraphicsRequirementsD3D11KHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_GRAPHICS_REQUIREMENTS_D3D11_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsRequirementsD3D11KHR
p Ptr GraphicsRequirementsD3D11KHR -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr LUID -> LUID -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsRequirementsD3D11KHR
p Ptr GraphicsRequirementsD3D11KHR -> Int -> Ptr LUID
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr LUID)) (LUID
forall a. Zero a => a
zero)
    Ptr D3D_FEATURE_LEVEL -> D3D_FEATURE_LEVEL -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsRequirementsD3D11KHR
p Ptr GraphicsRequirementsD3D11KHR -> Int -> Ptr D3D_FEATURE_LEVEL
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr D3D_FEATURE_LEVEL)) (D3D_FEATURE_LEVEL
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct GraphicsRequirementsD3D11KHR where
  peekCStruct :: Ptr GraphicsRequirementsD3D11KHR -> IO GraphicsRequirementsD3D11KHR
peekCStruct p :: Ptr GraphicsRequirementsD3D11KHR
p = do
    LUID
adapterLuid <- Ptr LUID -> IO LUID
forall a. Storable a => Ptr a -> IO a
peek @LUID ((Ptr GraphicsRequirementsD3D11KHR
p Ptr GraphicsRequirementsD3D11KHR -> Int -> Ptr LUID
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr LUID))
    D3D_FEATURE_LEVEL
minFeatureLevel <- Ptr D3D_FEATURE_LEVEL -> IO D3D_FEATURE_LEVEL
forall a. Storable a => Ptr a -> IO a
peek @D3D_FEATURE_LEVEL ((Ptr GraphicsRequirementsD3D11KHR
p Ptr GraphicsRequirementsD3D11KHR -> Int -> Ptr D3D_FEATURE_LEVEL
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr D3D_FEATURE_LEVEL))
    GraphicsRequirementsD3D11KHR -> IO GraphicsRequirementsD3D11KHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GraphicsRequirementsD3D11KHR -> IO GraphicsRequirementsD3D11KHR)
-> GraphicsRequirementsD3D11KHR -> IO GraphicsRequirementsD3D11KHR
forall a b. (a -> b) -> a -> b
$ LUID -> D3D_FEATURE_LEVEL -> GraphicsRequirementsD3D11KHR
GraphicsRequirementsD3D11KHR
             LUID
adapterLuid D3D_FEATURE_LEVEL
minFeatureLevel

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

instance Zero GraphicsRequirementsD3D11KHR where
  zero :: GraphicsRequirementsD3D11KHR
zero = LUID -> D3D_FEATURE_LEVEL -> GraphicsRequirementsD3D11KHR
GraphicsRequirementsD3D11KHR
           LUID
forall a. Zero a => a
zero
           D3D_FEATURE_LEVEL
forall a. Zero a => a
zero


type KHR_D3D11_enable_SPEC_VERSION = 5

-- No documentation found for TopLevel "XR_KHR_D3D11_enable_SPEC_VERSION"
pattern KHR_D3D11_enable_SPEC_VERSION :: forall a . Integral a => a
pattern $bKHR_D3D11_enable_SPEC_VERSION :: a
$mKHR_D3D11_enable_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
KHR_D3D11_enable_SPEC_VERSION = 5


type KHR_D3D11_ENABLE_EXTENSION_NAME = "XR_KHR_D3D11_enable"

-- No documentation found for TopLevel "XR_KHR_D3D11_ENABLE_EXTENSION_NAME"
pattern KHR_D3D11_ENABLE_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bKHR_D3D11_ENABLE_EXTENSION_NAME :: a
$mKHR_D3D11_ENABLE_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
KHR_D3D11_ENABLE_EXTENSION_NAME = "XR_KHR_D3D11_enable"


type LUID = Word64


type D3D_FEATURE_LEVEL = Word32


data ID3D11Device


data ID3D11Texture2D