{-# language CPP #-}
-- | = Name
--
-- XR_KHR_opengl_es_enable - instance extension
--
-- = Specification
--
-- See
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_KHR_opengl_es_enable  XR_KHR_opengl_es_enable>
-- in the main specification for complete information.
--
-- = Registered Extension Number
--
-- 25
--
-- = Revision
--
-- 7
--
-- = Extension and Version Dependencies
--
-- -   Requires OpenXR 1.0
--
-- = See Also
--
-- 'GraphicsBindingOpenGLESAndroidKHR', 'GraphicsRequirementsOpenGLESKHR',
-- 'SwapchainImageOpenGLESKHR', 'getOpenGLESGraphicsRequirementsKHR'
--
-- = Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_KHR_opengl_es_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_opengl_es_enable  ( getOpenGLESGraphicsRequirementsKHR
                                                  , GraphicsBindingOpenGLESAndroidKHR(..)
                                                  , SwapchainImageOpenGLESKHR(..)
                                                  , GraphicsRequirementsOpenGLESKHR(..)
                                                  , KHR_opengl_es_enable_SPEC_VERSION
                                                  , pattern KHR_opengl_es_enable_SPEC_VERSION
                                                  , KHR_OPENGL_ES_ENABLE_EXTENSION_NAME
                                                  , pattern KHR_OPENGL_ES_ENABLE_EXTENSION_NAME
                                                  , EGLDisplay
                                                  , EGLConfig
                                                  , EGLContext
                                                  ) 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.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import OpenXR.Core10.Handles (Instance)
import OpenXR.Core10.Handles (Instance(..))
import OpenXR.Dynamic (InstanceCmds(pXrGetOpenGLESGraphicsRequirementsKHR))
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.Version (Version)
import OpenXR.Core10.Enums.Result (Result(SUCCESS))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_GRAPHICS_BINDING_OPENGL_ES_ANDROID_KHR))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_GRAPHICS_REQUIREMENTS_OPENGL_ES_KHR))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_SWAPCHAIN_IMAGE_OPENGL_ES_KHR))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrGetOpenGLESGraphicsRequirementsKHR
  :: FunPtr (Ptr Instance_T -> SystemId -> Ptr GraphicsRequirementsOpenGLESKHR -> IO Result) -> Ptr Instance_T -> SystemId -> Ptr GraphicsRequirementsOpenGLESKHR -> IO Result

-- | xrGetOpenGLESGraphicsRequirementsKHR - Retrieve the OpenGL ES version
-- requirements for an instance and system
--
-- == Parameter Descriptions
--
-- = Description
--
-- The 'getOpenGLESGraphicsRequirementsKHR' function identifies to the
-- application the minimum OpenGL ES version requirement and the highest
-- known tested OpenGL ES version. 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 'getOpenGLESGraphicsRequirementsKHR' has not been called for the same
-- @instance@ and @systemId@.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-xrGetOpenGLESGraphicsRequirementsKHR-extension-notenabled# The
--     @@ extension /must/ be enabled prior to calling
--     'getOpenGLESGraphicsRequirementsKHR'
--
-- -   #VUID-xrGetOpenGLESGraphicsRequirementsKHR-instance-parameter#
--     @instance@ /must/ be a valid 'OpenXR.Core10.Handles.Instance' handle
--
-- -   #VUID-xrGetOpenGLESGraphicsRequirementsKHR-graphicsRequirements-parameter#
--     @graphicsRequirements@ /must/ be a pointer to an
--     'GraphicsRequirementsOpenGLESKHR' 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
--
-- 'GraphicsRequirementsOpenGLESKHR', 'OpenXR.Core10.Handles.Instance',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrSystemId >
getOpenGLESGraphicsRequirementsKHR :: 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 (GraphicsRequirementsOpenGLESKHR)
getOpenGLESGraphicsRequirementsKHR :: Instance -> SystemId -> io GraphicsRequirementsOpenGLESKHR
getOpenGLESGraphicsRequirementsKHR instance' :: Instance
instance' systemId :: SystemId
systemId = IO GraphicsRequirementsOpenGLESKHR
-> io GraphicsRequirementsOpenGLESKHR
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GraphicsRequirementsOpenGLESKHR
 -> io GraphicsRequirementsOpenGLESKHR)
-> (ContT
      GraphicsRequirementsOpenGLESKHR IO GraphicsRequirementsOpenGLESKHR
    -> IO GraphicsRequirementsOpenGLESKHR)
-> ContT
     GraphicsRequirementsOpenGLESKHR IO GraphicsRequirementsOpenGLESKHR
-> io GraphicsRequirementsOpenGLESKHR
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  GraphicsRequirementsOpenGLESKHR IO GraphicsRequirementsOpenGLESKHR
-> IO GraphicsRequirementsOpenGLESKHR
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   GraphicsRequirementsOpenGLESKHR IO GraphicsRequirementsOpenGLESKHR
 -> io GraphicsRequirementsOpenGLESKHR)
-> ContT
     GraphicsRequirementsOpenGLESKHR IO GraphicsRequirementsOpenGLESKHR
-> io GraphicsRequirementsOpenGLESKHR
forall a b. (a -> b) -> a -> b
$ do
  let xrGetOpenGLESGraphicsRequirementsKHRPtr :: FunPtr
  (Ptr Instance_T
   -> SystemId -> Ptr GraphicsRequirementsOpenGLESKHR -> IO Result)
xrGetOpenGLESGraphicsRequirementsKHRPtr = InstanceCmds
-> FunPtr
     (Ptr Instance_T
      -> SystemId -> Ptr GraphicsRequirementsOpenGLESKHR -> IO Result)
pXrGetOpenGLESGraphicsRequirementsKHR (Instance -> InstanceCmds
instanceCmds (Instance
instance' :: Instance))
  IO () -> ContT GraphicsRequirementsOpenGLESKHR IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT GraphicsRequirementsOpenGLESKHR IO ())
-> IO () -> ContT GraphicsRequirementsOpenGLESKHR 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 GraphicsRequirementsOpenGLESKHR -> IO Result)
xrGetOpenGLESGraphicsRequirementsKHRPtr FunPtr
  (Ptr Instance_T
   -> SystemId -> Ptr GraphicsRequirementsOpenGLESKHR -> IO Result)
-> FunPtr
     (Ptr Instance_T
      -> SystemId -> Ptr GraphicsRequirementsOpenGLESKHR -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Instance_T
   -> SystemId -> Ptr GraphicsRequirementsOpenGLESKHR -> 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 xrGetOpenGLESGraphicsRequirementsKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrGetOpenGLESGraphicsRequirementsKHR' :: Ptr Instance_T
-> SystemId -> Ptr GraphicsRequirementsOpenGLESKHR -> IO Result
xrGetOpenGLESGraphicsRequirementsKHR' = FunPtr
  (Ptr Instance_T
   -> SystemId -> Ptr GraphicsRequirementsOpenGLESKHR -> IO Result)
-> Ptr Instance_T
-> SystemId
-> Ptr GraphicsRequirementsOpenGLESKHR
-> IO Result
mkXrGetOpenGLESGraphicsRequirementsKHR FunPtr
  (Ptr Instance_T
   -> SystemId -> Ptr GraphicsRequirementsOpenGLESKHR -> IO Result)
xrGetOpenGLESGraphicsRequirementsKHRPtr
  Ptr GraphicsRequirementsOpenGLESKHR
pGraphicsRequirements <- ((Ptr GraphicsRequirementsOpenGLESKHR
  -> IO GraphicsRequirementsOpenGLESKHR)
 -> IO GraphicsRequirementsOpenGLESKHR)
-> ContT
     GraphicsRequirementsOpenGLESKHR
     IO
     (Ptr GraphicsRequirementsOpenGLESKHR)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct GraphicsRequirementsOpenGLESKHR =>
(Ptr GraphicsRequirementsOpenGLESKHR -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @GraphicsRequirementsOpenGLESKHR)
  Result
r <- IO Result -> ContT GraphicsRequirementsOpenGLESKHR IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT GraphicsRequirementsOpenGLESKHR IO Result)
-> IO Result -> ContT GraphicsRequirementsOpenGLESKHR IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrGetOpenGLESGraphicsRequirementsKHR" (Ptr Instance_T
-> SystemId -> Ptr GraphicsRequirementsOpenGLESKHR -> IO Result
xrGetOpenGLESGraphicsRequirementsKHR' (Instance -> Ptr Instance_T
instanceHandle (Instance
instance')) (SystemId
systemId) (Ptr GraphicsRequirementsOpenGLESKHR
pGraphicsRequirements))
  IO () -> ContT GraphicsRequirementsOpenGLESKHR IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT GraphicsRequirementsOpenGLESKHR IO ())
-> IO () -> ContT GraphicsRequirementsOpenGLESKHR 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))
  GraphicsRequirementsOpenGLESKHR
graphicsRequirements <- IO GraphicsRequirementsOpenGLESKHR
-> ContT
     GraphicsRequirementsOpenGLESKHR IO GraphicsRequirementsOpenGLESKHR
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO GraphicsRequirementsOpenGLESKHR
 -> ContT
      GraphicsRequirementsOpenGLESKHR IO GraphicsRequirementsOpenGLESKHR)
-> IO GraphicsRequirementsOpenGLESKHR
-> ContT
     GraphicsRequirementsOpenGLESKHR IO GraphicsRequirementsOpenGLESKHR
forall a b. (a -> b) -> a -> b
$ Ptr GraphicsRequirementsOpenGLESKHR
-> IO GraphicsRequirementsOpenGLESKHR
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @GraphicsRequirementsOpenGLESKHR Ptr GraphicsRequirementsOpenGLESKHR
pGraphicsRequirements
  GraphicsRequirementsOpenGLESKHR
-> ContT
     GraphicsRequirementsOpenGLESKHR IO GraphicsRequirementsOpenGLESKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GraphicsRequirementsOpenGLESKHR
 -> ContT
      GraphicsRequirementsOpenGLESKHR IO GraphicsRequirementsOpenGLESKHR)
-> GraphicsRequirementsOpenGLESKHR
-> ContT
     GraphicsRequirementsOpenGLESKHR IO GraphicsRequirementsOpenGLESKHR
forall a b. (a -> b) -> a -> b
$ (GraphicsRequirementsOpenGLESKHR
graphicsRequirements)


-- | XrGraphicsBindingOpenGLESAndroidKHR - The graphics binding structure to
-- be passed at session creation to use OpenGL ES on Android
--
-- == Member Descriptions
--
-- = Description
--
-- When creating an OpenGL ES-backed 'OpenXR.Core10.Handles.Session' on
-- Android, the application will provide a pointer to an
-- 'GraphicsBindingOpenGLESAndroidKHR' structure in the @next@ chain of the
-- 'OpenXR.Core10.Device.SessionCreateInfo'.
--
-- The required window system configuration define to expose this structure
-- type is
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_USE_PLATFORM_ANDROID XR_USE_PLATFORM_ANDROID>.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrGraphicsBindingOpenGLESAndroidKHR-extension-notenabled# The
--     @@ extension /must/ be enabled prior to using
--     'GraphicsBindingOpenGLESAndroidKHR'
--
-- -   #VUID-XrGraphicsBindingOpenGLESAndroidKHR-type-type# @type@ /must/
--     be
--     'OpenXR.Core10.Enums.StructureType.TYPE_GRAPHICS_BINDING_OPENGL_ES_ANDROID_KHR'
--
-- -   #VUID-XrGraphicsBindingOpenGLESAndroidKHR-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-XrGraphicsBindingOpenGLESAndroidKHR-display-parameter#
--     @display@ /must/ be a valid 'EGLDisplay' value
--
-- -   #VUID-XrGraphicsBindingOpenGLESAndroidKHR-config-parameter# @config@
--     /must/ be a valid 'EGLConfig' value
--
-- -   #VUID-XrGraphicsBindingOpenGLESAndroidKHR-context-parameter#
--     @context@ /must/ be a valid 'EGLContext' value
--
-- = See Also
--
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'OpenXR.Core10.Device.createSession'
data GraphicsBindingOpenGLESAndroidKHR = GraphicsBindingOpenGLESAndroidKHR
  { -- | @display@ is a valid Android OpenGL ES 'EGLDisplay'.
    GraphicsBindingOpenGLESAndroidKHR -> EGLDisplay
display :: EGLDisplay
  , -- | @config@ is a valid Android OpenGL ES 'EGLConfig'.
    GraphicsBindingOpenGLESAndroidKHR -> EGLDisplay
config :: EGLConfig
  , -- | @context@ is a valid Android OpenGL ES 'EGLContext'.
    GraphicsBindingOpenGLESAndroidKHR -> EGLDisplay
context :: EGLContext
  }
  deriving (Typeable, GraphicsBindingOpenGLESAndroidKHR
-> GraphicsBindingOpenGLESAndroidKHR -> Bool
(GraphicsBindingOpenGLESAndroidKHR
 -> GraphicsBindingOpenGLESAndroidKHR -> Bool)
-> (GraphicsBindingOpenGLESAndroidKHR
    -> GraphicsBindingOpenGLESAndroidKHR -> Bool)
-> Eq GraphicsBindingOpenGLESAndroidKHR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GraphicsBindingOpenGLESAndroidKHR
-> GraphicsBindingOpenGLESAndroidKHR -> Bool
$c/= :: GraphicsBindingOpenGLESAndroidKHR
-> GraphicsBindingOpenGLESAndroidKHR -> Bool
== :: GraphicsBindingOpenGLESAndroidKHR
-> GraphicsBindingOpenGLESAndroidKHR -> Bool
$c== :: GraphicsBindingOpenGLESAndroidKHR
-> GraphicsBindingOpenGLESAndroidKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (GraphicsBindingOpenGLESAndroidKHR)
#endif
deriving instance Show GraphicsBindingOpenGLESAndroidKHR

instance ToCStruct GraphicsBindingOpenGLESAndroidKHR where
  withCStruct :: GraphicsBindingOpenGLESAndroidKHR
-> (Ptr GraphicsBindingOpenGLESAndroidKHR -> IO b) -> IO b
withCStruct x :: GraphicsBindingOpenGLESAndroidKHR
x f :: Ptr GraphicsBindingOpenGLESAndroidKHR -> IO b
f = Int
-> Int -> (Ptr GraphicsBindingOpenGLESAndroidKHR -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 40 8 ((Ptr GraphicsBindingOpenGLESAndroidKHR -> IO b) -> IO b)
-> (Ptr GraphicsBindingOpenGLESAndroidKHR -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr GraphicsBindingOpenGLESAndroidKHR
p -> Ptr GraphicsBindingOpenGLESAndroidKHR
-> GraphicsBindingOpenGLESAndroidKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr GraphicsBindingOpenGLESAndroidKHR
p GraphicsBindingOpenGLESAndroidKHR
x (Ptr GraphicsBindingOpenGLESAndroidKHR -> IO b
f Ptr GraphicsBindingOpenGLESAndroidKHR
p)
  pokeCStruct :: Ptr GraphicsBindingOpenGLESAndroidKHR
-> GraphicsBindingOpenGLESAndroidKHR -> IO b -> IO b
pokeCStruct p :: Ptr GraphicsBindingOpenGLESAndroidKHR
p GraphicsBindingOpenGLESAndroidKHR{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsBindingOpenGLESAndroidKHR
p Ptr GraphicsBindingOpenGLESAndroidKHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_GRAPHICS_BINDING_OPENGL_ES_ANDROID_KHR)
    Ptr EGLDisplay -> EGLDisplay -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsBindingOpenGLESAndroidKHR
p Ptr GraphicsBindingOpenGLESAndroidKHR -> Int -> Ptr EGLDisplay
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (EGLDisplay
forall a. Ptr a
nullPtr)
    Ptr EGLDisplay -> EGLDisplay -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsBindingOpenGLESAndroidKHR
p Ptr GraphicsBindingOpenGLESAndroidKHR -> Int -> Ptr EGLDisplay
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr EGLDisplay)) (EGLDisplay
display)
    Ptr EGLDisplay -> EGLDisplay -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsBindingOpenGLESAndroidKHR
p Ptr GraphicsBindingOpenGLESAndroidKHR -> Int -> Ptr EGLDisplay
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr EGLConfig)) (EGLDisplay
config)
    Ptr EGLDisplay -> EGLDisplay -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsBindingOpenGLESAndroidKHR
p Ptr GraphicsBindingOpenGLESAndroidKHR -> Int -> Ptr EGLDisplay
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr EGLContext)) (EGLDisplay
context)
    IO b
f
  cStructSize :: Int
cStructSize = 40
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr GraphicsBindingOpenGLESAndroidKHR -> IO b -> IO b
pokeZeroCStruct p :: Ptr GraphicsBindingOpenGLESAndroidKHR
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsBindingOpenGLESAndroidKHR
p Ptr GraphicsBindingOpenGLESAndroidKHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_GRAPHICS_BINDING_OPENGL_ES_ANDROID_KHR)
    Ptr EGLDisplay -> EGLDisplay -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsBindingOpenGLESAndroidKHR
p Ptr GraphicsBindingOpenGLESAndroidKHR -> Int -> Ptr EGLDisplay
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (EGLDisplay
forall a. Ptr a
nullPtr)
    Ptr EGLDisplay -> EGLDisplay -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsBindingOpenGLESAndroidKHR
p Ptr GraphicsBindingOpenGLESAndroidKHR -> Int -> Ptr EGLDisplay
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr EGLDisplay)) (EGLDisplay
forall a. Zero a => a
zero)
    Ptr EGLDisplay -> EGLDisplay -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsBindingOpenGLESAndroidKHR
p Ptr GraphicsBindingOpenGLESAndroidKHR -> Int -> Ptr EGLDisplay
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr EGLConfig)) (EGLDisplay
forall a. Zero a => a
zero)
    Ptr EGLDisplay -> EGLDisplay -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsBindingOpenGLESAndroidKHR
p Ptr GraphicsBindingOpenGLESAndroidKHR -> Int -> Ptr EGLDisplay
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr EGLContext)) (EGLDisplay
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct GraphicsBindingOpenGLESAndroidKHR where
  peekCStruct :: Ptr GraphicsBindingOpenGLESAndroidKHR
-> IO GraphicsBindingOpenGLESAndroidKHR
peekCStruct p :: Ptr GraphicsBindingOpenGLESAndroidKHR
p = do
    EGLDisplay
display <- Ptr EGLDisplay -> IO EGLDisplay
forall a. Storable a => Ptr a -> IO a
peek @EGLDisplay ((Ptr GraphicsBindingOpenGLESAndroidKHR
p Ptr GraphicsBindingOpenGLESAndroidKHR -> Int -> Ptr EGLDisplay
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr EGLDisplay))
    EGLDisplay
config <- Ptr EGLDisplay -> IO EGLDisplay
forall a. Storable a => Ptr a -> IO a
peek @EGLConfig ((Ptr GraphicsBindingOpenGLESAndroidKHR
p Ptr GraphicsBindingOpenGLESAndroidKHR -> Int -> Ptr EGLDisplay
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr EGLConfig))
    EGLDisplay
context <- Ptr EGLDisplay -> IO EGLDisplay
forall a. Storable a => Ptr a -> IO a
peek @EGLContext ((Ptr GraphicsBindingOpenGLESAndroidKHR
p Ptr GraphicsBindingOpenGLESAndroidKHR -> Int -> Ptr EGLDisplay
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr EGLContext))
    GraphicsBindingOpenGLESAndroidKHR
-> IO GraphicsBindingOpenGLESAndroidKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GraphicsBindingOpenGLESAndroidKHR
 -> IO GraphicsBindingOpenGLESAndroidKHR)
-> GraphicsBindingOpenGLESAndroidKHR
-> IO GraphicsBindingOpenGLESAndroidKHR
forall a b. (a -> b) -> a -> b
$ EGLDisplay
-> EGLDisplay -> EGLDisplay -> GraphicsBindingOpenGLESAndroidKHR
GraphicsBindingOpenGLESAndroidKHR
             EGLDisplay
display EGLDisplay
config EGLDisplay
context

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

instance Zero GraphicsBindingOpenGLESAndroidKHR where
  zero :: GraphicsBindingOpenGLESAndroidKHR
zero = EGLDisplay
-> EGLDisplay -> EGLDisplay -> GraphicsBindingOpenGLESAndroidKHR
GraphicsBindingOpenGLESAndroidKHR
           EGLDisplay
forall a. Zero a => a
zero
           EGLDisplay
forall a. Zero a => a
zero
           EGLDisplay
forall a. Zero a => a
zero


-- | XrSwapchainImageOpenGLESKHR - OpenGL ES-specific swapchain image
-- structure
--
-- == Member Descriptions
--
-- = Description
--
-- If a given session was created with a @XrGraphicsBindingOpenGLES*KHR@,
-- 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 'SwapchainImageOpenGLESKHR' 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 'SwapchainImageOpenGLESKHR' structure.
--
-- The OpenXR runtime /must/ interpret the bottom-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 -1, and far Z plane at 1.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrSwapchainImageOpenGLESKHR-extension-notenabled# The @@
--     extension /must/ be enabled prior to using
--     'SwapchainImageOpenGLESKHR'
--
-- -   #VUID-XrSwapchainImageOpenGLESKHR-type-type# @type@ /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_SWAPCHAIN_IMAGE_OPENGL_ES_KHR'
--
-- -   #VUID-XrSwapchainImageOpenGLESKHR-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',
-- 'OpenXR.Core10.Image.SwapchainImageBaseHeader'
data SwapchainImageOpenGLESKHR = SwapchainImageOpenGLESKHR
  { -- | @image@ is an index indicating the current OpenGL ES swapchain image to
    -- use.
    SwapchainImageOpenGLESKHR -> Word32
image :: Word32 }
  deriving (Typeable, SwapchainImageOpenGLESKHR -> SwapchainImageOpenGLESKHR -> Bool
(SwapchainImageOpenGLESKHR -> SwapchainImageOpenGLESKHR -> Bool)
-> (SwapchainImageOpenGLESKHR -> SwapchainImageOpenGLESKHR -> Bool)
-> Eq SwapchainImageOpenGLESKHR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SwapchainImageOpenGLESKHR -> SwapchainImageOpenGLESKHR -> Bool
$c/= :: SwapchainImageOpenGLESKHR -> SwapchainImageOpenGLESKHR -> Bool
== :: SwapchainImageOpenGLESKHR -> SwapchainImageOpenGLESKHR -> Bool
$c== :: SwapchainImageOpenGLESKHR -> SwapchainImageOpenGLESKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SwapchainImageOpenGLESKHR)
#endif
deriving instance Show SwapchainImageOpenGLESKHR

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

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

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

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

instance Zero SwapchainImageOpenGLESKHR where
  zero :: SwapchainImageOpenGLESKHR
zero = Word32 -> SwapchainImageOpenGLESKHR
SwapchainImageOpenGLESKHR
           Word32
forall a. Zero a => a
zero


-- | XrGraphicsRequirementsOpenGLESKHR - OpenGL ES API version requirements
--
-- == Member Descriptions
--
-- = Description
--
-- 'GraphicsRequirementsOpenGLESKHR' is populated by
-- 'getOpenGLESGraphicsRequirementsKHR' with the runtime’s OpenGL ES API
-- version requirements.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrGraphicsRequirementsOpenGLESKHR-extension-notenabled# The @@
--     extension /must/ be enabled prior to using
--     'GraphicsRequirementsOpenGLESKHR'
--
-- -   #VUID-XrGraphicsRequirementsOpenGLESKHR-type-type# @type@ /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_GRAPHICS_REQUIREMENTS_OPENGL_ES_KHR'
--
-- -   #VUID-XrGraphicsRequirementsOpenGLESKHR-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#XrVersion >,
-- 'getOpenGLESGraphicsRequirementsKHR'
data GraphicsRequirementsOpenGLESKHR = GraphicsRequirementsOpenGLESKHR
  { -- | @minApiVersionSupported@ is the minimum version of OpenGL ES that the
    -- runtime supports. Uses 'OpenXR.Version.MAKE_VERSION' on major and minor
    -- API version, ignoring any patch version component.
    GraphicsRequirementsOpenGLESKHR -> Version
minApiVersionSupported :: Version
  , -- | @maxApiVersionSupported@ is the maximum version of OpenGL ES that the
    -- runtime has been tested on and is known to support. Newer OpenGL ES
    -- versions might work if they are compatible. Uses
    -- 'OpenXR.Version.MAKE_VERSION' on major and minor API version, ignoring
    -- any patch version component.
    GraphicsRequirementsOpenGLESKHR -> Version
maxApiVersionSupported :: Version
  }
  deriving (Typeable, GraphicsRequirementsOpenGLESKHR
-> GraphicsRequirementsOpenGLESKHR -> Bool
(GraphicsRequirementsOpenGLESKHR
 -> GraphicsRequirementsOpenGLESKHR -> Bool)
-> (GraphicsRequirementsOpenGLESKHR
    -> GraphicsRequirementsOpenGLESKHR -> Bool)
-> Eq GraphicsRequirementsOpenGLESKHR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GraphicsRequirementsOpenGLESKHR
-> GraphicsRequirementsOpenGLESKHR -> Bool
$c/= :: GraphicsRequirementsOpenGLESKHR
-> GraphicsRequirementsOpenGLESKHR -> Bool
== :: GraphicsRequirementsOpenGLESKHR
-> GraphicsRequirementsOpenGLESKHR -> Bool
$c== :: GraphicsRequirementsOpenGLESKHR
-> GraphicsRequirementsOpenGLESKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (GraphicsRequirementsOpenGLESKHR)
#endif
deriving instance Show GraphicsRequirementsOpenGLESKHR

instance ToCStruct GraphicsRequirementsOpenGLESKHR where
  withCStruct :: GraphicsRequirementsOpenGLESKHR
-> (Ptr GraphicsRequirementsOpenGLESKHR -> IO b) -> IO b
withCStruct x :: GraphicsRequirementsOpenGLESKHR
x f :: Ptr GraphicsRequirementsOpenGLESKHR -> IO b
f = Int -> Int -> (Ptr GraphicsRequirementsOpenGLESKHR -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((Ptr GraphicsRequirementsOpenGLESKHR -> IO b) -> IO b)
-> (Ptr GraphicsRequirementsOpenGLESKHR -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr GraphicsRequirementsOpenGLESKHR
p -> Ptr GraphicsRequirementsOpenGLESKHR
-> GraphicsRequirementsOpenGLESKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr GraphicsRequirementsOpenGLESKHR
p GraphicsRequirementsOpenGLESKHR
x (Ptr GraphicsRequirementsOpenGLESKHR -> IO b
f Ptr GraphicsRequirementsOpenGLESKHR
p)
  pokeCStruct :: Ptr GraphicsRequirementsOpenGLESKHR
-> GraphicsRequirementsOpenGLESKHR -> IO b -> IO b
pokeCStruct p :: Ptr GraphicsRequirementsOpenGLESKHR
p GraphicsRequirementsOpenGLESKHR{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsRequirementsOpenGLESKHR
p Ptr GraphicsRequirementsOpenGLESKHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_GRAPHICS_REQUIREMENTS_OPENGL_ES_KHR)
    Ptr EGLDisplay -> EGLDisplay -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsRequirementsOpenGLESKHR
p Ptr GraphicsRequirementsOpenGLESKHR -> Int -> Ptr EGLDisplay
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (EGLDisplay
forall a. Ptr a
nullPtr)
    Ptr Version -> Version -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsRequirementsOpenGLESKHR
p Ptr GraphicsRequirementsOpenGLESKHR -> Int -> Ptr Version
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Version)) (Version
minApiVersionSupported)
    Ptr Version -> Version -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsRequirementsOpenGLESKHR
p Ptr GraphicsRequirementsOpenGLESKHR -> Int -> Ptr Version
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Version)) (Version
maxApiVersionSupported)
    IO b
f
  cStructSize :: Int
cStructSize = 32
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr GraphicsRequirementsOpenGLESKHR -> IO b -> IO b
pokeZeroCStruct p :: Ptr GraphicsRequirementsOpenGLESKHR
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsRequirementsOpenGLESKHR
p Ptr GraphicsRequirementsOpenGLESKHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_GRAPHICS_REQUIREMENTS_OPENGL_ES_KHR)
    Ptr EGLDisplay -> EGLDisplay -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsRequirementsOpenGLESKHR
p Ptr GraphicsRequirementsOpenGLESKHR -> Int -> Ptr EGLDisplay
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (EGLDisplay
forall a. Ptr a
nullPtr)
    Ptr Version -> Version -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsRequirementsOpenGLESKHR
p Ptr GraphicsRequirementsOpenGLESKHR -> Int -> Ptr Version
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Version)) (Version
forall a. Zero a => a
zero)
    Ptr Version -> Version -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr GraphicsRequirementsOpenGLESKHR
p Ptr GraphicsRequirementsOpenGLESKHR -> Int -> Ptr Version
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Version)) (Version
forall a. Zero a => a
zero)
    IO b
f

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

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

instance Zero GraphicsRequirementsOpenGLESKHR where
  zero :: GraphicsRequirementsOpenGLESKHR
zero = Version -> Version -> GraphicsRequirementsOpenGLESKHR
GraphicsRequirementsOpenGLESKHR
           Version
forall a. Zero a => a
zero
           Version
forall a. Zero a => a
zero


type KHR_opengl_es_enable_SPEC_VERSION = 7

-- No documentation found for TopLevel "XR_KHR_opengl_es_enable_SPEC_VERSION"
pattern KHR_opengl_es_enable_SPEC_VERSION :: forall a . Integral a => a
pattern $bKHR_opengl_es_enable_SPEC_VERSION :: a
$mKHR_opengl_es_enable_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
KHR_opengl_es_enable_SPEC_VERSION = 7


type KHR_OPENGL_ES_ENABLE_EXTENSION_NAME = "XR_KHR_opengl_es_enable"

-- No documentation found for TopLevel "XR_KHR_OPENGL_ES_ENABLE_EXTENSION_NAME"
pattern KHR_OPENGL_ES_ENABLE_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bKHR_OPENGL_ES_ENABLE_EXTENSION_NAME :: a
$mKHR_OPENGL_ES_ENABLE_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
KHR_OPENGL_ES_ENABLE_EXTENSION_NAME = "XR_KHR_opengl_es_enable"


type EGLDisplay = Ptr ()


type EGLConfig = Ptr ()


type EGLContext = Ptr ()