{-# language CPP #-}
-- | = Name
--
-- XR_MNDX_egl_enable - instance extension
--
-- = Specification
--
-- See
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_MNDX_egl_enable  XR_MNDX_egl_enable>
-- in the main specification for complete information.
--
-- = Registered Extension Number
--
-- 49
--
-- = Revision
--
-- 1
--
-- = Extension and Version Dependencies
--
-- -   Requires OpenXR 1.0
--
-- = See Also
--
-- 'GraphicsBindingEGLMNDX'
--
-- = Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_MNDX_egl_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_MNDX_egl_enable  ( GraphicsBindingEGLMNDX(..)
                                             , MNDX_egl_enable_SPEC_VERSION
                                             , pattern MNDX_egl_enable_SPEC_VERSION
                                             , MNDX_EGL_ENABLE_EXTENSION_NAME
                                             , pattern MNDX_EGL_ENABLE_EXTENSION_NAME
                                             , PFNEGLGETPROCADDRESSPROC
                                             , EGLDisplay
                                             , EGLConfig
                                             , EGLContext
                                             ) 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.C.String (CString)
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 (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Kind (Type)
import OpenXR.Extensions.XR_KHR_opengl_es_enable (EGLConfig)
import OpenXR.Extensions.XR_KHR_opengl_es_enable (EGLContext)
import OpenXR.Extensions.XR_KHR_opengl_es_enable (EGLDisplay)
import OpenXR.Core10.Enums.StructureType (StructureType)
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_GRAPHICS_BINDING_EGL_MNDX))
import OpenXR.Extensions.XR_KHR_opengl_es_enable (EGLConfig)
import OpenXR.Extensions.XR_KHR_opengl_es_enable (EGLContext)
import OpenXR.Extensions.XR_KHR_opengl_es_enable (EGLDisplay)
-- | XrGraphicsBindingEGLMNDX - The graphics binding structure to be passed
-- at session creation to EGL
--
-- == Member Descriptions
--
-- = Description
--
-- When creating an EGL based 'OpenXR.Core10.Handles.Session', the
-- application will provide a pointer to an 'GraphicsBindingEGLMNDX'
-- 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_EGL XR_USE_PLATFORM_EGL>.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrGraphicsBindingEGLMNDX-extension-notenabled# The @@
--     extension /must/ be enabled prior to using 'GraphicsBindingEGLMNDX'
--
-- -   #VUID-XrGraphicsBindingEGLMNDX-type-type# @type@ /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_GRAPHICS_BINDING_EGL_MNDX'
--
-- -   #VUID-XrGraphicsBindingEGLMNDX-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-XrGraphicsBindingEGLMNDX-getProcAddress-parameter#
--     @getProcAddress@ /must/ be a valid 'PFNEGLGETPROCADDRESSPROC' value
--
-- -   #VUID-XrGraphicsBindingEGLMNDX-display-parameter# @display@ /must/
--     be a valid 'OpenXR.Extensions.XR_KHR_opengl_es_enable.EGLDisplay'
--     value
--
-- -   #VUID-XrGraphicsBindingEGLMNDX-config-parameter# @config@ /must/ be
--     a valid 'OpenXR.Extensions.XR_KHR_opengl_es_enable.EGLConfig' value
--
-- -   #VUID-XrGraphicsBindingEGLMNDX-context-parameter# @context@ /must/
--     be a valid 'OpenXR.Extensions.XR_KHR_opengl_es_enable.EGLContext'
--     value
--
-- = See Also
--
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'OpenXR.Core10.Device.createSession'
data GraphicsBindingEGLMNDX = GraphicsBindingEGLMNDX
  { -- | @getProcAddress@ is a valid function pointer to @eglGetProcAddress@.
    GraphicsBindingEGLMNDX -> PFNEGLGETPROCADDRESSPROC
getProcAddress :: PFNEGLGETPROCADDRESSPROC
  , -- | @display@ is a valid EGL
    -- 'OpenXR.Extensions.XR_KHR_opengl_es_enable.EGLDisplay'.
    GraphicsBindingEGLMNDX -> EGLDisplay
display :: EGLDisplay
  , -- | @config@ is a valid EGL
    -- 'OpenXR.Extensions.XR_KHR_opengl_es_enable.EGLConfig'.
    GraphicsBindingEGLMNDX -> EGLDisplay
config :: EGLConfig
  , -- | @context@ is a valid EGL
    -- 'OpenXR.Extensions.XR_KHR_opengl_es_enable.EGLContext'.
    GraphicsBindingEGLMNDX -> EGLDisplay
context :: EGLContext
  }
  deriving (Typeable, GraphicsBindingEGLMNDX -> GraphicsBindingEGLMNDX -> Bool
(GraphicsBindingEGLMNDX -> GraphicsBindingEGLMNDX -> Bool)
-> (GraphicsBindingEGLMNDX -> GraphicsBindingEGLMNDX -> Bool)
-> Eq GraphicsBindingEGLMNDX
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GraphicsBindingEGLMNDX -> GraphicsBindingEGLMNDX -> Bool
$c/= :: GraphicsBindingEGLMNDX -> GraphicsBindingEGLMNDX -> Bool
== :: GraphicsBindingEGLMNDX -> GraphicsBindingEGLMNDX -> Bool
$c== :: GraphicsBindingEGLMNDX -> GraphicsBindingEGLMNDX -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (GraphicsBindingEGLMNDX)
#endif
deriving instance Show GraphicsBindingEGLMNDX

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

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

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

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


type MNDX_egl_enable_SPEC_VERSION = 1

-- No documentation found for TopLevel "XR_MNDX_egl_enable_SPEC_VERSION"
pattern MNDX_egl_enable_SPEC_VERSION :: forall a . Integral a => a
pattern $bMNDX_egl_enable_SPEC_VERSION :: a
$mMNDX_egl_enable_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
MNDX_egl_enable_SPEC_VERSION = 1


type MNDX_EGL_ENABLE_EXTENSION_NAME = "XR_MNDX_egl_enable"

-- No documentation found for TopLevel "XR_MNDX_EGL_ENABLE_EXTENSION_NAME"
pattern MNDX_EGL_ENABLE_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bMNDX_EGL_ENABLE_EXTENSION_NAME :: a
$mMNDX_EGL_ENABLE_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
MNDX_EGL_ENABLE_EXTENSION_NAME = "XR_MNDX_egl_enable"


type PFNEGLGETPROCADDRESSPROC = FunPtr (CString -> IO (FunPtr (IO ())))