{-# language CPP #-}
-- | = Name
--
-- XR_KHR_D3D12_enable - instance extension
--
-- = Specification
--
-- See
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_KHR_D3D12_enable  XR_KHR_D3D12_enable>
-- in the main specification for complete information.
--
-- = Registered Extension Number
--
-- 29
--
-- = Revision
--
-- 7
--
-- = Extension and Version Dependencies
--
-- -   Requires OpenXR 1.0
--
-- = See Also
--
-- 'GraphicsBindingD3D12KHR', 'GraphicsRequirementsD3D12KHR',
-- 'SwapchainImageD3D12KHR', 'getD3D12GraphicsRequirementsKHR'
--
-- = Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_KHR_D3D12_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_D3D12_enable  ( getD3D12GraphicsRequirementsKHR
                                              , GraphicsBindingD3D12KHR(..)
                                              , SwapchainImageD3D12KHR(..)
                                              , GraphicsRequirementsD3D12KHR(..)
                                              , KHR_D3D12_enable_SPEC_VERSION
                                              , pattern KHR_D3D12_enable_SPEC_VERSION
                                              , KHR_D3D12_ENABLE_EXTENSION_NAME
                                              , pattern KHR_D3D12_ENABLE_EXTENSION_NAME
                                              , ID3D12CommandQueue
                                              , ID3D12Device
                                              , ID3D12Resource
                                              , LUID
                                              , D3D_FEATURE_LEVEL
                                              ) 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.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import OpenXR.Extensions.XR_KHR_D3D11_enable (D3D_FEATURE_LEVEL)
import OpenXR.Core10.Handles (Instance)
import OpenXR.Core10.Handles (Instance(..))
import OpenXR.Dynamic (InstanceCmds(pXrGetD3D12GraphicsRequirementsKHR))
import OpenXR.Core10.Handles (Instance_T)
import OpenXR.Core10.Image (IsSwapchainImage(..))
import OpenXR.Extensions.XR_KHR_D3D11_enable (LUID)
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_D3D12_KHR))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_GRAPHICS_REQUIREMENTS_D3D12_KHR))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_SWAPCHAIN_IMAGE_D3D12_KHR))
import OpenXR.Extensions.XR_KHR_D3D11_enable (D3D_FEATURE_LEVEL)
import OpenXR.Extensions.XR_KHR_D3D11_enable (LUID)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrGetD3D12GraphicsRequirementsKHR
  :: FunPtr (Ptr Instance_T -> SystemId -> Ptr GraphicsRequirementsD3D12KHR -> IO Result) -> Ptr Instance_T -> SystemId -> Ptr GraphicsRequirementsD3D12KHR -> IO Result

-- | xrGetD3D12GraphicsRequirementsKHR - Retrieve the D3D12 feature level and
-- graphics device requirements for an instance and system
--
-- == Parameter Descriptions
--
-- = Description
--
-- The 'getD3D12GraphicsRequirementsKHR' 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 'getD3D12GraphicsRequirementsKHR' has not been called for the same
-- @instance@ and @systemId@. The LUID and feature level that
-- 'getD3D12GraphicsRequirementsKHR' returns should be used to create the
-- 'ID3D12Device' that the application passes to
-- 'OpenXR.Core10.Device.createSession' in the 'GraphicsBindingD3D12KHR'.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-xrGetD3D12GraphicsRequirementsKHR-extension-notenabled# The @@
--     extension /must/ be enabled prior to calling
--     'getD3D12GraphicsRequirementsKHR'
--
-- -   #VUID-xrGetD3D12GraphicsRequirementsKHR-instance-parameter#
--     @instance@ /must/ be a valid 'OpenXR.Core10.Handles.Instance' handle
--
-- -   #VUID-xrGetD3D12GraphicsRequirementsKHR-graphicsRequirements-parameter#
--     @graphicsRequirements@ /must/ be a pointer to an
--     'GraphicsRequirementsD3D12KHR' 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
--
-- 'GraphicsRequirementsD3D12KHR', 'OpenXR.Core10.Handles.Instance',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrSystemId >,
-- 'OpenXR.Core10.Device.createSession'
getD3D12GraphicsRequirementsKHR :: 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 (GraphicsRequirementsD3D12KHR)
getD3D12GraphicsRequirementsKHR :: Instance -> SystemId -> io GraphicsRequirementsD3D12KHR
getD3D12GraphicsRequirementsKHR instance' :: Instance
instance' systemId :: SystemId
systemId = IO GraphicsRequirementsD3D12KHR -> io GraphicsRequirementsD3D12KHR
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GraphicsRequirementsD3D12KHR
 -> io GraphicsRequirementsD3D12KHR)
-> (ContT
      GraphicsRequirementsD3D12KHR IO GraphicsRequirementsD3D12KHR
    -> IO GraphicsRequirementsD3D12KHR)
-> ContT
     GraphicsRequirementsD3D12KHR IO GraphicsRequirementsD3D12KHR
-> io GraphicsRequirementsD3D12KHR
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT GraphicsRequirementsD3D12KHR IO GraphicsRequirementsD3D12KHR
-> IO GraphicsRequirementsD3D12KHR
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT GraphicsRequirementsD3D12KHR IO GraphicsRequirementsD3D12KHR
 -> io GraphicsRequirementsD3D12KHR)
-> ContT
     GraphicsRequirementsD3D12KHR IO GraphicsRequirementsD3D12KHR
-> io GraphicsRequirementsD3D12KHR
forall a b. (a -> b) -> a -> b
$ do
  let xrGetD3D12GraphicsRequirementsKHRPtr :: FunPtr
  (Ptr Instance_T
   -> SystemId -> Ptr GraphicsRequirementsD3D12KHR -> IO Result)
xrGetD3D12GraphicsRequirementsKHRPtr = InstanceCmds
-> FunPtr
     (Ptr Instance_T
      -> SystemId -> Ptr GraphicsRequirementsD3D12KHR -> IO Result)
pXrGetD3D12GraphicsRequirementsKHR (Instance -> InstanceCmds
instanceCmds (Instance
instance' :: Instance))
  IO () -> ContT GraphicsRequirementsD3D12KHR IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT GraphicsRequirementsD3D12KHR IO ())
-> IO () -> ContT GraphicsRequirementsD3D12KHR 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 GraphicsRequirementsD3D12KHR -> IO Result)
xrGetD3D12GraphicsRequirementsKHRPtr FunPtr
  (Ptr Instance_T
   -> SystemId -> Ptr GraphicsRequirementsD3D12KHR -> IO Result)
-> FunPtr
     (Ptr Instance_T
      -> SystemId -> Ptr GraphicsRequirementsD3D12KHR -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Instance_T
   -> SystemId -> Ptr GraphicsRequirementsD3D12KHR -> 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 xrGetD3D12GraphicsRequirementsKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrGetD3D12GraphicsRequirementsKHR' :: Ptr Instance_T
-> SystemId -> Ptr GraphicsRequirementsD3D12KHR -> IO Result
xrGetD3D12GraphicsRequirementsKHR' = FunPtr
  (Ptr Instance_T
   -> SystemId -> Ptr GraphicsRequirementsD3D12KHR -> IO Result)
-> Ptr Instance_T
-> SystemId
-> Ptr GraphicsRequirementsD3D12KHR
-> IO Result
mkXrGetD3D12GraphicsRequirementsKHR FunPtr
  (Ptr Instance_T
   -> SystemId -> Ptr GraphicsRequirementsD3D12KHR -> IO Result)
xrGetD3D12GraphicsRequirementsKHRPtr
  Ptr GraphicsRequirementsD3D12KHR
pGraphicsRequirements <- ((Ptr GraphicsRequirementsD3D12KHR
  -> IO GraphicsRequirementsD3D12KHR)
 -> IO GraphicsRequirementsD3D12KHR)
-> ContT
     GraphicsRequirementsD3D12KHR IO (Ptr GraphicsRequirementsD3D12KHR)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct GraphicsRequirementsD3D12KHR =>
(Ptr GraphicsRequirementsD3D12KHR -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @GraphicsRequirementsD3D12KHR)
  Result
r <- IO Result -> ContT GraphicsRequirementsD3D12KHR IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT GraphicsRequirementsD3D12KHR IO Result)
-> IO Result -> ContT GraphicsRequirementsD3D12KHR IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrGetD3D12GraphicsRequirementsKHR" (Ptr Instance_T
-> SystemId -> Ptr GraphicsRequirementsD3D12KHR -> IO Result
xrGetD3D12GraphicsRequirementsKHR' (Instance -> Ptr Instance_T
instanceHandle (Instance
instance')) (SystemId
systemId) (Ptr GraphicsRequirementsD3D12KHR
pGraphicsRequirements))
  IO () -> ContT GraphicsRequirementsD3D12KHR IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT GraphicsRequirementsD3D12KHR IO ())
-> IO () -> ContT GraphicsRequirementsD3D12KHR 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))
  GraphicsRequirementsD3D12KHR
graphicsRequirements <- IO GraphicsRequirementsD3D12KHR
-> ContT
     GraphicsRequirementsD3D12KHR IO GraphicsRequirementsD3D12KHR
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO GraphicsRequirementsD3D12KHR
 -> ContT
      GraphicsRequirementsD3D12KHR IO GraphicsRequirementsD3D12KHR)
-> IO GraphicsRequirementsD3D12KHR
-> ContT
     GraphicsRequirementsD3D12KHR IO GraphicsRequirementsD3D12KHR
forall a b. (a -> b) -> a -> b
$ Ptr GraphicsRequirementsD3D12KHR -> IO GraphicsRequirementsD3D12KHR
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @GraphicsRequirementsD3D12KHR Ptr GraphicsRequirementsD3D12KHR
pGraphicsRequirements
  GraphicsRequirementsD3D12KHR
-> ContT
     GraphicsRequirementsD3D12KHR IO GraphicsRequirementsD3D12KHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GraphicsRequirementsD3D12KHR
 -> ContT
      GraphicsRequirementsD3D12KHR IO GraphicsRequirementsD3D12KHR)
-> GraphicsRequirementsD3D12KHR
-> ContT
     GraphicsRequirementsD3D12KHR IO GraphicsRequirementsD3D12KHR
forall a b. (a -> b) -> a -> b
$ (GraphicsRequirementsD3D12KHR
graphicsRequirements)


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

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

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

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

instance Zero GraphicsBindingD3D12KHR where
  zero :: GraphicsBindingD3D12KHR
zero = Ptr ID3D12Device
-> Ptr ID3D12CommandQueue -> GraphicsBindingD3D12KHR
GraphicsBindingD3D12KHR
           Ptr ID3D12Device
forall a. Zero a => a
zero
           Ptr ID3D12CommandQueue
forall a. Zero a => a
zero


-- | XrSwapchainImageD3D12KHR - D3D12-specific swapchain image structure
--
-- == Member Descriptions
--
-- = Description
--
-- If a given session was created with 'GraphicsBindingD3D12KHR', 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 'SwapchainImageD3D12KHR' 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 'SwapchainImageD3D12KHR'.
--
-- 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-XrSwapchainImageD3D12KHR-extension-notenabled# The @@
--     extension /must/ be enabled prior to using 'SwapchainImageD3D12KHR'
--
-- -   #VUID-XrSwapchainImageD3D12KHR-type-type# @type@ /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_SWAPCHAIN_IMAGE_D3D12_KHR'
--
-- -   #VUID-XrSwapchainImageD3D12KHR-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-XrSwapchainImageD3D12KHR-texture-parameter# @texture@ /must/
--     be a pointer to an 'ID3D12Resource' value
--
-- = See Also
--
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'OpenXR.Core10.Image.SwapchainImageBaseHeader'
data SwapchainImageD3D12KHR = SwapchainImageD3D12KHR
  { -- | @texture@ is a pointer to a valid @ID3D12Texture2D@ to use.
    SwapchainImageD3D12KHR -> Ptr ID3D12Resource
texture :: Ptr ID3D12Resource }
  deriving (Typeable, SwapchainImageD3D12KHR -> SwapchainImageD3D12KHR -> Bool
(SwapchainImageD3D12KHR -> SwapchainImageD3D12KHR -> Bool)
-> (SwapchainImageD3D12KHR -> SwapchainImageD3D12KHR -> Bool)
-> Eq SwapchainImageD3D12KHR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SwapchainImageD3D12KHR -> SwapchainImageD3D12KHR -> Bool
$c/= :: SwapchainImageD3D12KHR -> SwapchainImageD3D12KHR -> Bool
== :: SwapchainImageD3D12KHR -> SwapchainImageD3D12KHR -> Bool
$c== :: SwapchainImageD3D12KHR -> SwapchainImageD3D12KHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SwapchainImageD3D12KHR)
#endif
deriving instance Show SwapchainImageD3D12KHR

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

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

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

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

instance Zero SwapchainImageD3D12KHR where
  zero :: SwapchainImageD3D12KHR
zero = Ptr ID3D12Resource -> SwapchainImageD3D12KHR
SwapchainImageD3D12KHR
           Ptr ID3D12Resource
forall a. Zero a => a
zero


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

instance ToCStruct GraphicsRequirementsD3D12KHR where
  withCStruct :: GraphicsRequirementsD3D12KHR
-> (Ptr GraphicsRequirementsD3D12KHR -> IO b) -> IO b
withCStruct x :: GraphicsRequirementsD3D12KHR
x f :: Ptr GraphicsRequirementsD3D12KHR -> IO b
f = Int -> Int -> (Ptr GraphicsRequirementsD3D12KHR -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((Ptr GraphicsRequirementsD3D12KHR -> IO b) -> IO b)
-> (Ptr GraphicsRequirementsD3D12KHR -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr GraphicsRequirementsD3D12KHR
p -> Ptr GraphicsRequirementsD3D12KHR
-> GraphicsRequirementsD3D12KHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr GraphicsRequirementsD3D12KHR
p GraphicsRequirementsD3D12KHR
x (Ptr GraphicsRequirementsD3D12KHR -> IO b
f Ptr GraphicsRequirementsD3D12KHR
p)
  pokeCStruct :: Ptr GraphicsRequirementsD3D12KHR
-> GraphicsRequirementsD3D12KHR -> IO b -> IO b
pokeCStruct p :: Ptr GraphicsRequirementsD3D12KHR
p GraphicsRequirementsD3D12KHR{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsRequirementsD3D12KHR
p Ptr GraphicsRequirementsD3D12KHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_GRAPHICS_REQUIREMENTS_D3D12_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsRequirementsD3D12KHR
p Ptr GraphicsRequirementsD3D12KHR -> 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 GraphicsRequirementsD3D12KHR
p Ptr GraphicsRequirementsD3D12KHR -> 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 GraphicsRequirementsD3D12KHR
p Ptr GraphicsRequirementsD3D12KHR -> 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 GraphicsRequirementsD3D12KHR -> IO b -> IO b
pokeZeroCStruct p :: Ptr GraphicsRequirementsD3D12KHR
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsRequirementsD3D12KHR
p Ptr GraphicsRequirementsD3D12KHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_GRAPHICS_REQUIREMENTS_D3D12_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsRequirementsD3D12KHR
p Ptr GraphicsRequirementsD3D12KHR -> 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 GraphicsRequirementsD3D12KHR
p Ptr GraphicsRequirementsD3D12KHR -> 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 GraphicsRequirementsD3D12KHR
p Ptr GraphicsRequirementsD3D12KHR -> 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 GraphicsRequirementsD3D12KHR where
  peekCStruct :: Ptr GraphicsRequirementsD3D12KHR -> IO GraphicsRequirementsD3D12KHR
peekCStruct p :: Ptr GraphicsRequirementsD3D12KHR
p = do
    LUID
adapterLuid <- Ptr LUID -> IO LUID
forall a. Storable a => Ptr a -> IO a
peek @LUID ((Ptr GraphicsRequirementsD3D12KHR
p Ptr GraphicsRequirementsD3D12KHR -> 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 GraphicsRequirementsD3D12KHR
p Ptr GraphicsRequirementsD3D12KHR -> Int -> Ptr D3D_FEATURE_LEVEL
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr D3D_FEATURE_LEVEL))
    GraphicsRequirementsD3D12KHR -> IO GraphicsRequirementsD3D12KHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GraphicsRequirementsD3D12KHR -> IO GraphicsRequirementsD3D12KHR)
-> GraphicsRequirementsD3D12KHR -> IO GraphicsRequirementsD3D12KHR
forall a b. (a -> b) -> a -> b
$ LUID -> D3D_FEATURE_LEVEL -> GraphicsRequirementsD3D12KHR
GraphicsRequirementsD3D12KHR
             LUID
adapterLuid D3D_FEATURE_LEVEL
minFeatureLevel

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

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


type KHR_D3D12_enable_SPEC_VERSION = 7

-- No documentation found for TopLevel "XR_KHR_D3D12_enable_SPEC_VERSION"
pattern KHR_D3D12_enable_SPEC_VERSION :: forall a . Integral a => a
pattern $bKHR_D3D12_enable_SPEC_VERSION :: a
$mKHR_D3D12_enable_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
KHR_D3D12_enable_SPEC_VERSION = 7


type KHR_D3D12_ENABLE_EXTENSION_NAME = "XR_KHR_D3D12_enable"

-- No documentation found for TopLevel "XR_KHR_D3D12_ENABLE_EXTENSION_NAME"
pattern KHR_D3D12_ENABLE_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bKHR_D3D12_ENABLE_EXTENSION_NAME :: a
$mKHR_D3D12_ENABLE_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
KHR_D3D12_ENABLE_EXTENSION_NAME = "XR_KHR_D3D12_enable"


data ID3D12CommandQueue


data ID3D12Device


data ID3D12Resource