{-# language CPP #-}
-- | = Name
--
-- XR_MSFT_holographic_window_attachment - instance extension
--
-- = Specification
--
-- See
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_MSFT_holographic_window_attachment  XR_MSFT_holographic_window_attachment>
-- in the main specification for complete information.
--
-- = Registered Extension Number
--
-- 64
--
-- = Revision
--
-- 1
--
-- = Extension and Version Dependencies
--
-- -   Requires OpenXR 1.0
--
-- = See Also
--
-- 'HolographicWindowAttachmentMSFT'
--
-- = Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_MSFT_holographic_window_attachment OpenXR Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module OpenXR.Extensions.XR_MSFT_holographic_window_attachment  ( HolographicWindowAttachmentMSFT(..)
                                                                , MSFT_holographic_window_attachment_SPEC_VERSION
                                                                , pattern MSFT_holographic_window_attachment_SPEC_VERSION
                                                                , MSFT_HOLOGRAPHIC_WINDOW_ATTACHMENT_EXTENSION_NAME
                                                                , pattern MSFT_HOLOGRAPHIC_WINDOW_ATTACHMENT_EXTENSION_NAME
                                                                , IUnknown
                                                                ) where

import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import OpenXR.CStruct (FromCStruct)
import OpenXR.CStruct (FromCStruct(..))
import OpenXR.CStruct (ToCStruct)
import OpenXR.CStruct (ToCStruct(..))
import OpenXR.Zero (Zero(..))
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 Foreign.Ptr (Ptr)
import Data.Kind (Type)
import OpenXR.Extensions.XR_MSFT_perception_anchor_interop (IUnknown)
import OpenXR.Core10.Enums.StructureType (StructureType)
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_HOLOGRAPHIC_WINDOW_ATTACHMENT_MSFT))
import OpenXR.Extensions.XR_MSFT_perception_anchor_interop (IUnknown)
-- | XrHolographicWindowAttachmentMSFT - The holographic window binding
-- structure which can be passed at session creation
--
-- == Member Descriptions
--
-- = Description
--
-- When creating a holographic window-backed
-- 'OpenXR.Core10.Handles.Session', the application provides a pointer to
-- an 'HolographicWindowAttachmentMSFT' in the @next@ chain of the
-- 'OpenXR.Core10.Device.SessionCreateInfo'.
--
-- The session state of a holographic window-backed
-- 'OpenXR.Core10.Handles.Session' will only reach
-- 'OpenXR.Core10.Enums.SessionState.SESSION_STATE_VISIBLE' when the
-- provided CoreWindow is made visible. If the CoreWindow is for a
-- secondary app view, the application must programmatically request to
-- make the CoreWindow visible (e.g. with
-- @ApplicationViewSwitcher.TryShowAsStandaloneAsync@ or
-- @ApplicationViewSwitcher.SwitchAsync@).
--
-- The app /must/ not call 'OpenXR.Core10.Device.createSession' while the
-- specified CoreWindow thread is blocked, otherwise the call /may/
-- deadlock.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrHolographicWindowAttachmentMSFT-extension-notenabled# The @@
--     extension /must/ be enabled prior to using
--     'HolographicWindowAttachmentMSFT'
--
-- -   #VUID-XrHolographicWindowAttachmentMSFT-type-type# @type@ /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_HOLOGRAPHIC_WINDOW_ATTACHMENT_MSFT'
--
-- -   #VUID-XrHolographicWindowAttachmentMSFT-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-XrHolographicWindowAttachmentMSFT-holographicSpace-parameter#
--     @holographicSpace@ /must/ be a pointer to an
--     'OpenXR.Extensions.XR_MSFT_perception_anchor_interop.IUnknown' value
--
-- -   #VUID-XrHolographicWindowAttachmentMSFT-coreWindow-parameter#
--     @coreWindow@ /must/ be a pointer to an
--     'OpenXR.Extensions.XR_MSFT_perception_anchor_interop.IUnknown' value
--
-- = See Also
--
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'OpenXR.Core10.Device.createSession'
data HolographicWindowAttachmentMSFT = HolographicWindowAttachmentMSFT
  { -- | @holographicSpace@ is a pointer to a valid
    -- @Windows@.Graphics.Holographic.HolographicSpace.
    HolographicWindowAttachmentMSFT -> Ptr IUnknown
holographicSpace :: Ptr IUnknown
  , -- | @coreWindow@ is a pointer to a valid @Windows@.UI.Core.CoreWindow.
    HolographicWindowAttachmentMSFT -> Ptr IUnknown
coreWindow :: Ptr IUnknown
  }
  deriving (Typeable, HolographicWindowAttachmentMSFT
-> HolographicWindowAttachmentMSFT -> Bool
(HolographicWindowAttachmentMSFT
 -> HolographicWindowAttachmentMSFT -> Bool)
-> (HolographicWindowAttachmentMSFT
    -> HolographicWindowAttachmentMSFT -> Bool)
-> Eq HolographicWindowAttachmentMSFT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HolographicWindowAttachmentMSFT
-> HolographicWindowAttachmentMSFT -> Bool
$c/= :: HolographicWindowAttachmentMSFT
-> HolographicWindowAttachmentMSFT -> Bool
== :: HolographicWindowAttachmentMSFT
-> HolographicWindowAttachmentMSFT -> Bool
$c== :: HolographicWindowAttachmentMSFT
-> HolographicWindowAttachmentMSFT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (HolographicWindowAttachmentMSFT)
#endif
deriving instance Show HolographicWindowAttachmentMSFT

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

instance FromCStruct HolographicWindowAttachmentMSFT where
  peekCStruct :: Ptr HolographicWindowAttachmentMSFT
-> IO HolographicWindowAttachmentMSFT
peekCStruct p :: Ptr HolographicWindowAttachmentMSFT
p = do
    Ptr IUnknown
holographicSpace <- Ptr (Ptr IUnknown) -> IO (Ptr IUnknown)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr IUnknown) ((Ptr HolographicWindowAttachmentMSFT
p Ptr HolographicWindowAttachmentMSFT -> Int -> Ptr (Ptr IUnknown)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr (Ptr IUnknown)))
    Ptr IUnknown
coreWindow <- Ptr (Ptr IUnknown) -> IO (Ptr IUnknown)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr IUnknown) ((Ptr HolographicWindowAttachmentMSFT
p Ptr HolographicWindowAttachmentMSFT -> Int -> Ptr (Ptr IUnknown)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr IUnknown)))
    HolographicWindowAttachmentMSFT
-> IO HolographicWindowAttachmentMSFT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HolographicWindowAttachmentMSFT
 -> IO HolographicWindowAttachmentMSFT)
-> HolographicWindowAttachmentMSFT
-> IO HolographicWindowAttachmentMSFT
forall a b. (a -> b) -> a -> b
$ Ptr IUnknown -> Ptr IUnknown -> HolographicWindowAttachmentMSFT
HolographicWindowAttachmentMSFT
             Ptr IUnknown
holographicSpace Ptr IUnknown
coreWindow

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

instance Zero HolographicWindowAttachmentMSFT where
  zero :: HolographicWindowAttachmentMSFT
zero = Ptr IUnknown -> Ptr IUnknown -> HolographicWindowAttachmentMSFT
HolographicWindowAttachmentMSFT
           Ptr IUnknown
forall a. Zero a => a
zero
           Ptr IUnknown
forall a. Zero a => a
zero


type MSFT_holographic_window_attachment_SPEC_VERSION = 1

-- No documentation found for TopLevel "XR_MSFT_holographic_window_attachment_SPEC_VERSION"
pattern MSFT_holographic_window_attachment_SPEC_VERSION :: forall a . Integral a => a
pattern $bMSFT_holographic_window_attachment_SPEC_VERSION :: a
$mMSFT_holographic_window_attachment_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
MSFT_holographic_window_attachment_SPEC_VERSION = 1


type MSFT_HOLOGRAPHIC_WINDOW_ATTACHMENT_EXTENSION_NAME = "XR_MSFT_holographic_window_attachment"

-- No documentation found for TopLevel "XR_MSFT_HOLOGRAPHIC_WINDOW_ATTACHMENT_EXTENSION_NAME"
pattern MSFT_HOLOGRAPHIC_WINDOW_ATTACHMENT_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bMSFT_HOLOGRAPHIC_WINDOW_ATTACHMENT_EXTENSION_NAME :: a
$mMSFT_HOLOGRAPHIC_WINDOW_ATTACHMENT_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
MSFT_HOLOGRAPHIC_WINDOW_ATTACHMENT_EXTENSION_NAME = "XR_MSFT_holographic_window_attachment"