{-# language CPP #-}
-- | = Name
--
-- XR_KHR_composition_layer_cylinder - instance extension
--
-- = Specification
--
-- See
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_KHR_composition_layer_cylinder  XR_KHR_composition_layer_cylinder>
-- in the main specification for complete information.
--
-- = Registered Extension Number
--
-- 18
--
-- = Revision
--
-- 4
--
-- = Extension and Version Dependencies
--
-- -   Requires OpenXR 1.0
--
-- = See Also
--
-- 'CompositionLayerCylinderKHR'
--
-- = Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_KHR_composition_layer_cylinder 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_composition_layer_cylinder  ( CompositionLayerCylinderKHR(..)
                                                            , KHR_composition_layer_cylinder_SPEC_VERSION
                                                            , pattern KHR_composition_layer_cylinder_SPEC_VERSION
                                                            , KHR_COMPOSITION_LAYER_CYLINDER_EXTENSION_NAME
                                                            , pattern KHR_COMPOSITION_LAYER_CYLINDER_EXTENSION_NAME
                                                            ) where

import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Data.Coerce (coerce)
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.Types (CFloat)
import Foreign.C.Types (CFloat(..))
import Foreign.C.Types (CFloat(CFloat))
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.OtherTypes (CompositionLayerBaseHeader(..))
import OpenXR.Core10.Enums.CompositionLayerFlags (CompositionLayerFlags)
import OpenXR.Core10.Enums.EyeVisibility (EyeVisibility)
import OpenXR.Core10.OtherTypes (IsCompositionLayer(..))
import OpenXR.Core10.Space (Posef)
import OpenXR.Core10.Handles (Space_T)
import OpenXR.Core10.Enums.StructureType (StructureType)
import OpenXR.Core10.OtherTypes (SwapchainSubImage)
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_COMPOSITION_LAYER_CYLINDER_KHR))
-- | XrCompositionLayerCylinderKHR - Cylindrical layer composition info
--
-- == Member Descriptions
--
-- = Description
--
-- 'CompositionLayerCylinderKHR' contains the information needed to render
-- a texture onto a cylinder when calling
-- 'OpenXR.Core10.DisplayTiming.endFrame'. 'CompositionLayerCylinderKHR' is
-- an alias type for the base struct
-- 'OpenXR.Core10.OtherTypes.CompositionLayerBaseHeader' used in
-- 'OpenXR.Core10.DisplayTiming.FrameEndInfo'.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrCompositionLayerCylinderKHR-extension-notenabled# The @@
--     extension /must/ be enabled prior to using
--     'CompositionLayerCylinderKHR'
--
-- -   #VUID-XrCompositionLayerCylinderKHR-type-type# @type@ /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_COMPOSITION_LAYER_CYLINDER_KHR'
--
-- -   #VUID-XrCompositionLayerCylinderKHR-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-XrCompositionLayerCylinderKHR-layerFlags-parameter#
--     @layerFlags@ /must/ be @0@ or a valid combination of
--     <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrCompositionLayerFlagBits XrCompositionLayerFlagBits>
--     values
--
-- -   #VUID-XrCompositionLayerCylinderKHR-space-parameter# @space@ /must/
--     be a valid 'OpenXR.Core10.Handles.Space' handle
--
-- -   #VUID-XrCompositionLayerCylinderKHR-eyeVisibility-parameter#
--     @eyeVisibility@ /must/ be a valid
--     'OpenXR.Core10.Enums.EyeVisibility.EyeVisibility' value
--
-- -   #VUID-XrCompositionLayerCylinderKHR-subImage-parameter# @subImage@
--     /must/ be a valid 'OpenXR.Core10.OtherTypes.SwapchainSubImage'
--     structure
--
-- = See Also
--
-- 'OpenXR.Core10.OtherTypes.CompositionLayerBaseHeader',
-- 'OpenXR.Core10.Enums.CompositionLayerFlags.CompositionLayerFlags',
-- 'OpenXR.Core10.Enums.EyeVisibility.EyeVisibility',
-- 'OpenXR.Core10.DisplayTiming.FrameEndInfo', 'OpenXR.Core10.Space.Posef',
-- 'OpenXR.Core10.Handles.Space',
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'OpenXR.Core10.OtherTypes.SwapchainSubImage',
-- 'OpenXR.Core10.DisplayTiming.endFrame'
data CompositionLayerCylinderKHR = CompositionLayerCylinderKHR
  { -- | @layerFlags@ specifies options for the layer.
    CompositionLayerCylinderKHR -> CompositionLayerFlags
layerFlags :: CompositionLayerFlags
  , -- | @space@ is the 'OpenXR.Core10.Handles.Space' in which the @pose@ of the
    -- cylinder layer is evaluated over time.
    CompositionLayerCylinderKHR -> Ptr Space_T
space :: Ptr Space_T
  , -- No documentation found for Nested "XrCompositionLayerCylinderKHR" "eyeVisibility"
    CompositionLayerCylinderKHR -> EyeVisibility
eyeVisibility :: EyeVisibility
  , -- | @subImage@ identifies the image
    -- 'OpenXR.Core10.OtherTypes.SwapchainSubImage' to use.
    CompositionLayerCylinderKHR -> SwapchainSubImage
subImage :: SwapchainSubImage
  , -- | @pose@ is an 'OpenXR.Core10.Space.Posef' defining the position and
    -- orientation of the center point of the view of the cylinder within the
    -- reference frame of the @space@.
    CompositionLayerCylinderKHR -> Posef
pose :: Posef
  , -- | @radius@ is the non-negative radius of the cylinder. Values of zero or
    -- floating point positive infinity are treated as an infinite cylinder.
    CompositionLayerCylinderKHR -> Float
radius :: Float
  , -- | @centralAngle@ is the angle of the visible section of the cylinder,
    -- based at 0 radians, in the range of [0, 2π). It grows symmetrically
    -- around the 0 radian angle.
    CompositionLayerCylinderKHR -> Float
centralAngle :: Float
  , -- | @aspectRatio@ is the ratio of the visible cylinder section width \/
    -- height. The height of the cylinder is given by: (cylinder radius ×
    -- cylinder angle) \/ aspectRatio.
    CompositionLayerCylinderKHR -> Float
aspectRatio :: Float
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CompositionLayerCylinderKHR)
#endif
deriving instance Show CompositionLayerCylinderKHR

instance IsCompositionLayer CompositionLayerCylinderKHR where
  toCompositionLayerBaseHeader :: CompositionLayerCylinderKHR -> CompositionLayerBaseHeader '[]
toCompositionLayerBaseHeader CompositionLayerCylinderKHR{..} = $WCompositionLayerBaseHeader :: forall (es :: [*]).
StructureType
-> Chain es
-> CompositionLayerFlags
-> Ptr Space_T
-> CompositionLayerBaseHeader es
CompositionLayerBaseHeader{$sel:type':CompositionLayerBaseHeader :: StructureType
type' = StructureType
TYPE_COMPOSITION_LAYER_CYLINDER_KHR, $sel:next:CompositionLayerBaseHeader :: Chain '[]
next = (), ..}

instance ToCStruct CompositionLayerCylinderKHR where
  withCStruct :: CompositionLayerCylinderKHR
-> (Ptr CompositionLayerCylinderKHR -> IO b) -> IO b
withCStruct x :: CompositionLayerCylinderKHR
x f :: Ptr CompositionLayerCylinderKHR -> IO b
f = Int -> Int -> (Ptr CompositionLayerCylinderKHR -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 112 8 ((Ptr CompositionLayerCylinderKHR -> IO b) -> IO b)
-> (Ptr CompositionLayerCylinderKHR -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr CompositionLayerCylinderKHR
p -> Ptr CompositionLayerCylinderKHR
-> CompositionLayerCylinderKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr CompositionLayerCylinderKHR
p CompositionLayerCylinderKHR
x (Ptr CompositionLayerCylinderKHR -> IO b
f Ptr CompositionLayerCylinderKHR
p)
  pokeCStruct :: Ptr CompositionLayerCylinderKHR
-> CompositionLayerCylinderKHR -> IO b -> IO b
pokeCStruct p :: Ptr CompositionLayerCylinderKHR
p CompositionLayerCylinderKHR{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCylinderKHR
p Ptr CompositionLayerCylinderKHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_COMPOSITION_LAYER_CYLINDER_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCylinderKHR
p Ptr CompositionLayerCylinderKHR -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr CompositionLayerFlags -> CompositionLayerFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCylinderKHR
p Ptr CompositionLayerCylinderKHR -> Int -> Ptr CompositionLayerFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr CompositionLayerFlags)) (CompositionLayerFlags
layerFlags)
    Ptr (Ptr Space_T) -> Ptr Space_T -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCylinderKHR
p Ptr CompositionLayerCylinderKHR -> Int -> Ptr (Ptr Space_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr Space_T))) (Ptr Space_T
space)
    Ptr EyeVisibility -> EyeVisibility -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCylinderKHR
p Ptr CompositionLayerCylinderKHR -> Int -> Ptr EyeVisibility
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr EyeVisibility)) (EyeVisibility
eyeVisibility)
    Ptr SwapchainSubImage -> SwapchainSubImage -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCylinderKHR
p Ptr CompositionLayerCylinderKHR -> Int -> Ptr SwapchainSubImage
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr SwapchainSubImage)) (SwapchainSubImage
subImage)
    Ptr Posef -> Posef -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCylinderKHR
p Ptr CompositionLayerCylinderKHR -> Int -> Ptr Posef
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 72 :: Ptr Posef)) (Posef
pose)
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCylinderKHR
p Ptr CompositionLayerCylinderKHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 100 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
radius))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCylinderKHR
p Ptr CompositionLayerCylinderKHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 104 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
centralAngle))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCylinderKHR
p Ptr CompositionLayerCylinderKHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 108 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
aspectRatio))
    IO b
f
  cStructSize :: Int
cStructSize = 112
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr CompositionLayerCylinderKHR -> IO b -> IO b
pokeZeroCStruct p :: Ptr CompositionLayerCylinderKHR
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCylinderKHR
p Ptr CompositionLayerCylinderKHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_COMPOSITION_LAYER_CYLINDER_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCylinderKHR
p Ptr CompositionLayerCylinderKHR -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr (Ptr Space_T) -> Ptr Space_T -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCylinderKHR
p Ptr CompositionLayerCylinderKHR -> Int -> Ptr (Ptr Space_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr Space_T))) (Ptr Space_T
forall a. Zero a => a
zero)
    Ptr EyeVisibility -> EyeVisibility -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCylinderKHR
p Ptr CompositionLayerCylinderKHR -> Int -> Ptr EyeVisibility
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr EyeVisibility)) (EyeVisibility
forall a. Zero a => a
zero)
    Ptr SwapchainSubImage -> SwapchainSubImage -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCylinderKHR
p Ptr CompositionLayerCylinderKHR -> Int -> Ptr SwapchainSubImage
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr SwapchainSubImage)) (SwapchainSubImage
forall a. Zero a => a
zero)
    Ptr Posef -> Posef -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCylinderKHR
p Ptr CompositionLayerCylinderKHR -> Int -> Ptr Posef
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 72 :: Ptr Posef)) (Posef
forall a. Zero a => a
zero)
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCylinderKHR
p Ptr CompositionLayerCylinderKHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 100 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCylinderKHR
p Ptr CompositionLayerCylinderKHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 104 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCylinderKHR
p Ptr CompositionLayerCylinderKHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 108 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct CompositionLayerCylinderKHR where
  peekCStruct :: Ptr CompositionLayerCylinderKHR -> IO CompositionLayerCylinderKHR
peekCStruct p :: Ptr CompositionLayerCylinderKHR
p = do
    CompositionLayerFlags
layerFlags <- Ptr CompositionLayerFlags -> IO CompositionLayerFlags
forall a. Storable a => Ptr a -> IO a
peek @CompositionLayerFlags ((Ptr CompositionLayerCylinderKHR
p Ptr CompositionLayerCylinderKHR -> Int -> Ptr CompositionLayerFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr CompositionLayerFlags))
    Ptr Space_T
space <- Ptr (Ptr Space_T) -> IO (Ptr Space_T)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Space_T) ((Ptr CompositionLayerCylinderKHR
p Ptr CompositionLayerCylinderKHR -> Int -> Ptr (Ptr Space_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr Space_T)))
    EyeVisibility
eyeVisibility <- Ptr EyeVisibility -> IO EyeVisibility
forall a. Storable a => Ptr a -> IO a
peek @EyeVisibility ((Ptr CompositionLayerCylinderKHR
p Ptr CompositionLayerCylinderKHR -> Int -> Ptr EyeVisibility
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr EyeVisibility))
    SwapchainSubImage
subImage <- Ptr SwapchainSubImage -> IO SwapchainSubImage
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @SwapchainSubImage ((Ptr CompositionLayerCylinderKHR
p Ptr CompositionLayerCylinderKHR -> Int -> Ptr SwapchainSubImage
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr SwapchainSubImage))
    Posef
pose <- Ptr Posef -> IO Posef
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Posef ((Ptr CompositionLayerCylinderKHR
p Ptr CompositionLayerCylinderKHR -> Int -> Ptr Posef
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 72 :: Ptr Posef))
    CFloat
radius <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr CompositionLayerCylinderKHR
p Ptr CompositionLayerCylinderKHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 100 :: Ptr CFloat))
    CFloat
centralAngle <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr CompositionLayerCylinderKHR
p Ptr CompositionLayerCylinderKHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 104 :: Ptr CFloat))
    CFloat
aspectRatio <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr CompositionLayerCylinderKHR
p Ptr CompositionLayerCylinderKHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 108 :: Ptr CFloat))
    CompositionLayerCylinderKHR -> IO CompositionLayerCylinderKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompositionLayerCylinderKHR -> IO CompositionLayerCylinderKHR)
-> CompositionLayerCylinderKHR -> IO CompositionLayerCylinderKHR
forall a b. (a -> b) -> a -> b
$ CompositionLayerFlags
-> Ptr Space_T
-> EyeVisibility
-> SwapchainSubImage
-> Posef
-> Float
-> Float
-> Float
-> CompositionLayerCylinderKHR
CompositionLayerCylinderKHR
             CompositionLayerFlags
layerFlags Ptr Space_T
space EyeVisibility
eyeVisibility SwapchainSubImage
subImage Posef
pose (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
radius) (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
centralAngle) (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
aspectRatio)

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

instance Zero CompositionLayerCylinderKHR where
  zero :: CompositionLayerCylinderKHR
zero = CompositionLayerFlags
-> Ptr Space_T
-> EyeVisibility
-> SwapchainSubImage
-> Posef
-> Float
-> Float
-> Float
-> CompositionLayerCylinderKHR
CompositionLayerCylinderKHR
           CompositionLayerFlags
forall a. Zero a => a
zero
           Ptr Space_T
forall a. Zero a => a
zero
           EyeVisibility
forall a. Zero a => a
zero
           SwapchainSubImage
forall a. Zero a => a
zero
           Posef
forall a. Zero a => a
zero
           Float
forall a. Zero a => a
zero
           Float
forall a. Zero a => a
zero
           Float
forall a. Zero a => a
zero


type KHR_composition_layer_cylinder_SPEC_VERSION = 4

-- No documentation found for TopLevel "XR_KHR_composition_layer_cylinder_SPEC_VERSION"
pattern KHR_composition_layer_cylinder_SPEC_VERSION :: forall a . Integral a => a
pattern $bKHR_composition_layer_cylinder_SPEC_VERSION :: a
$mKHR_composition_layer_cylinder_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
KHR_composition_layer_cylinder_SPEC_VERSION = 4


type KHR_COMPOSITION_LAYER_CYLINDER_EXTENSION_NAME = "XR_KHR_composition_layer_cylinder"

-- No documentation found for TopLevel "XR_KHR_COMPOSITION_LAYER_CYLINDER_EXTENSION_NAME"
pattern KHR_COMPOSITION_LAYER_CYLINDER_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bKHR_COMPOSITION_LAYER_CYLINDER_EXTENSION_NAME :: a
$mKHR_COMPOSITION_LAYER_CYLINDER_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
KHR_COMPOSITION_LAYER_CYLINDER_EXTENSION_NAME = "XR_KHR_composition_layer_cylinder"