{-# language CPP #-}
-- | = Name
--
-- XR_EXT_eye_gaze_interaction - instance extension
--
-- = Specification
--
-- See
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_EXT_eye_gaze_interaction  XR_EXT_eye_gaze_interaction>
-- in the main specification for complete information.
--
-- = Registered Extension Number
--
-- 31
--
-- = Revision
--
-- 1
--
-- = Extension and Version Dependencies
--
-- -   Requires OpenXR 1.0
--
-- = See Also
--
-- 'EyeGazeSampleTimeEXT', 'SystemEyeGazeInteractionPropertiesEXT'
--
-- = Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_EXT_eye_gaze_interaction OpenXR Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module OpenXR.Extensions.XR_EXT_eye_gaze_interaction  ( SystemEyeGazeInteractionPropertiesEXT(..)
                                                      , EyeGazeSampleTimeEXT(..)
                                                      , EXT_eye_gaze_interaction_SPEC_VERSION
                                                      , pattern EXT_eye_gaze_interaction_SPEC_VERSION
                                                      , EXT_EYE_GAZE_INTERACTION_EXTENSION_NAME
                                                      , pattern EXT_EYE_GAZE_INTERACTION_EXTENSION_NAME
                                                      ) 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.Core10.FundamentalTypes (bool32ToBool)
import OpenXR.Core10.FundamentalTypes (boolToBool32)
import OpenXR.Core10.FundamentalTypes (Bool32)
import OpenXR.Core10.Enums.StructureType (StructureType)
import OpenXR.Core10.FundamentalTypes (Time)
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_EYE_GAZE_SAMPLE_TIME_EXT))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_SYSTEM_EYE_GAZE_INTERACTION_PROPERTIES_EXT))
-- | XrSystemEyeGazeInteractionPropertiesEXT - Eye gaze interaction system
-- properties
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrSystemEyeGazeInteractionPropertiesEXT-extension-notenabled#
--     The @@ extension /must/ be enabled prior to using
--     'SystemEyeGazeInteractionPropertiesEXT'
--
-- -   #VUID-XrSystemEyeGazeInteractionPropertiesEXT-type-type# @type@
--     /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_SYSTEM_EYE_GAZE_INTERACTION_PROPERTIES_EXT'
--
-- -   #VUID-XrSystemEyeGazeInteractionPropertiesEXT-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
--
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrBool32 >,
-- 'OpenXR.Core10.Enums.StructureType.StructureType'
data SystemEyeGazeInteractionPropertiesEXT = SystemEyeGazeInteractionPropertiesEXT
  { -- | @supportsEyeGazeInteraction@ the runtime /must/ set this value to
    -- 'OpenXR.Core10.FundamentalTypes.TRUE' when eye gaze sufficient for use
    -- cases such as aiming or targeting is supported by the current device,
    -- otherwise the runtime /must/ set this to
    -- 'OpenXR.Core10.FundamentalTypes.FALSE'.
    SystemEyeGazeInteractionPropertiesEXT -> Bool
supportsEyeGazeInteraction :: Bool }
  deriving (Typeable, SystemEyeGazeInteractionPropertiesEXT
-> SystemEyeGazeInteractionPropertiesEXT -> Bool
(SystemEyeGazeInteractionPropertiesEXT
 -> SystemEyeGazeInteractionPropertiesEXT -> Bool)
-> (SystemEyeGazeInteractionPropertiesEXT
    -> SystemEyeGazeInteractionPropertiesEXT -> Bool)
-> Eq SystemEyeGazeInteractionPropertiesEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemEyeGazeInteractionPropertiesEXT
-> SystemEyeGazeInteractionPropertiesEXT -> Bool
$c/= :: SystemEyeGazeInteractionPropertiesEXT
-> SystemEyeGazeInteractionPropertiesEXT -> Bool
== :: SystemEyeGazeInteractionPropertiesEXT
-> SystemEyeGazeInteractionPropertiesEXT -> Bool
$c== :: SystemEyeGazeInteractionPropertiesEXT
-> SystemEyeGazeInteractionPropertiesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SystemEyeGazeInteractionPropertiesEXT)
#endif
deriving instance Show SystemEyeGazeInteractionPropertiesEXT

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

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

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

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


-- | XrEyeGazeSampleTimeEXT - Eye gaze sample time structure
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrEyeGazeSampleTimeEXT-extension-notenabled# The @@ extension
--     /must/ be enabled prior to using 'EyeGazeSampleTimeEXT'
--
-- -   #VUID-XrEyeGazeSampleTimeEXT-type-type# @type@ /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_EYE_GAZE_SAMPLE_TIME_EXT'
--
-- -   #VUID-XrEyeGazeSampleTimeEXT-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.Core10.Enums.StructureType.StructureType',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >
data EyeGazeSampleTimeEXT = EyeGazeSampleTimeEXT
  { -- | @time@ is when in time the eye gaze pose is expressed.
    EyeGazeSampleTimeEXT -> Time
time :: Time }
  deriving (Typeable, EyeGazeSampleTimeEXT -> EyeGazeSampleTimeEXT -> Bool
(EyeGazeSampleTimeEXT -> EyeGazeSampleTimeEXT -> Bool)
-> (EyeGazeSampleTimeEXT -> EyeGazeSampleTimeEXT -> Bool)
-> Eq EyeGazeSampleTimeEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EyeGazeSampleTimeEXT -> EyeGazeSampleTimeEXT -> Bool
$c/= :: EyeGazeSampleTimeEXT -> EyeGazeSampleTimeEXT -> Bool
== :: EyeGazeSampleTimeEXT -> EyeGazeSampleTimeEXT -> Bool
$c== :: EyeGazeSampleTimeEXT -> EyeGazeSampleTimeEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (EyeGazeSampleTimeEXT)
#endif
deriving instance Show EyeGazeSampleTimeEXT

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

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

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

instance Zero EyeGazeSampleTimeEXT where
  zero :: EyeGazeSampleTimeEXT
zero = Time -> EyeGazeSampleTimeEXT
EyeGazeSampleTimeEXT
           Time
forall a. Zero a => a
zero


type EXT_eye_gaze_interaction_SPEC_VERSION = 1

-- No documentation found for TopLevel "XR_EXT_eye_gaze_interaction_SPEC_VERSION"
pattern EXT_eye_gaze_interaction_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_eye_gaze_interaction_SPEC_VERSION :: a
$mEXT_eye_gaze_interaction_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
EXT_eye_gaze_interaction_SPEC_VERSION = 1


type EXT_EYE_GAZE_INTERACTION_EXTENSION_NAME = "XR_EXT_eye_gaze_interaction"

-- No documentation found for TopLevel "XR_EXT_EYE_GAZE_INTERACTION_EXTENSION_NAME"
pattern EXT_EYE_GAZE_INTERACTION_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_EYE_GAZE_INTERACTION_EXTENSION_NAME :: a
$mEXT_EYE_GAZE_INTERACTION_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
EXT_EYE_GAZE_INTERACTION_EXTENSION_NAME = "XR_EXT_eye_gaze_interaction"