{-# language CPP #-}
-- | = Name
--
-- XR_KHR_composition_layer_equirect2 - instance extension
--
-- = Specification
--
-- See
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_KHR_composition_layer_equirect2  XR_KHR_composition_layer_equirect2>
-- in the main specification for complete information.
--
-- = Registered Extension Number
--
-- 92
--
-- = Revision
--
-- 1
--
-- = Extension and Version Dependencies
--
-- -   Requires OpenXR 1.0
--
-- = See Also
--
-- 'CompositionLayerEquirect2KHR'
--
-- = Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_KHR_composition_layer_equirect2 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_equirect2  ( CompositionLayerEquirect2KHR(..)
                                                             , KHR_composition_layer_equirect2_SPEC_VERSION
                                                             , pattern KHR_composition_layer_equirect2_SPEC_VERSION
                                                             , KHR_COMPOSITION_LAYER_EQUIRECT2_EXTENSION_NAME
                                                             , pattern KHR_COMPOSITION_LAYER_EQUIRECT2_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_EQUIRECT2_KHR))
-- | XrCompositionLayerEquirect2KHR - Equirectangular layer composition info
--
-- == Member Descriptions
--
-- = Description
--
-- 'CompositionLayerEquirect2KHR' contains the information needed to render
-- an equirectangular image onto a sphere when calling
-- 'OpenXR.Core10.DisplayTiming.endFrame'. 'CompositionLayerEquirect2KHR'
-- is an alias type for the base struct
-- 'OpenXR.Core10.OtherTypes.CompositionLayerBaseHeader' used in
-- 'OpenXR.Core10.DisplayTiming.FrameEndInfo'.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrCompositionLayerEquirect2KHR-extension-notenabled# The @@
--     extension /must/ be enabled prior to using
--     'CompositionLayerEquirect2KHR'
--
-- -   #VUID-XrCompositionLayerEquirect2KHR-type-type# @type@ /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_COMPOSITION_LAYER_EQUIRECT2_KHR'
--
-- -   #VUID-XrCompositionLayerEquirect2KHR-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-XrCompositionLayerEquirect2KHR-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-XrCompositionLayerEquirect2KHR-space-parameter# @space@ /must/
--     be a valid 'OpenXR.Core10.Handles.Space' handle
--
-- -   #VUID-XrCompositionLayerEquirect2KHR-eyeVisibility-parameter#
--     @eyeVisibility@ /must/ be a valid
--     'OpenXR.Core10.Enums.EyeVisibility.EyeVisibility' value
--
-- -   #VUID-XrCompositionLayerEquirect2KHR-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 CompositionLayerEquirect2KHR = CompositionLayerEquirect2KHR
  { -- | @layerFlags@ specifies options for the layer.
    CompositionLayerEquirect2KHR -> CompositionLayerFlags
layerFlags :: CompositionLayerFlags
  , -- | @space@ is the 'OpenXR.Core10.Handles.Space' in which the @pose@ of the
    -- equirect layer is evaluated over time.
    CompositionLayerEquirect2KHR -> Ptr Space_T
space :: Ptr Space_T
  , -- No documentation found for Nested "XrCompositionLayerEquirect2KHR" "eyeVisibility"
    CompositionLayerEquirect2KHR -> EyeVisibility
eyeVisibility :: EyeVisibility
  , -- | @subImage@ identifies the image
    -- 'OpenXR.Core10.OtherTypes.SwapchainSubImage' to use.
    CompositionLayerEquirect2KHR -> SwapchainSubImage
subImage :: SwapchainSubImage
  , -- | @pose@ is an 'OpenXR.Core10.Space.Posef' defining the position and
    -- orientation of the center point of the sphere onto which the equirect
    -- image data is mapped, relative to the reference frame of the @space@.
    CompositionLayerEquirect2KHR -> Posef
pose :: Posef
  , -- | @radius@ is the non-negative radius of the sphere onto which the
    -- equirect image data is mapped. Values of zero or floating point positive
    -- infinity are treated as an infinite sphere.
    CompositionLayerEquirect2KHR -> Float
radius :: Float
  , -- | @centralHorizontalAngle@ defines the visible horizontal angle of the
    -- sphere, based at 0 radians, in the range of [0, 2π]. It grows
    -- symmetrically around the 0 radian angle.
    CompositionLayerEquirect2KHR -> Float
centralHorizontalAngle :: Float
  , -- | @upperVerticalAngle@ defines the upper vertical angle of the visible
    -- portion of the sphere, in the range of [-π\/2, π\/2].
    CompositionLayerEquirect2KHR -> Float
upperVerticalAngle :: Float
  , -- | @lowerVerticalAngle@ defines the lower vertical angle of the visible
    -- portion of the sphere, in the range of [-π\/2, π\/2].
    CompositionLayerEquirect2KHR -> Float
lowerVerticalAngle :: Float
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CompositionLayerEquirect2KHR)
#endif
deriving instance Show CompositionLayerEquirect2KHR

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

instance ToCStruct CompositionLayerEquirect2KHR where
  withCStruct :: CompositionLayerEquirect2KHR
-> (Ptr CompositionLayerEquirect2KHR -> IO b) -> IO b
withCStruct x :: CompositionLayerEquirect2KHR
x f :: Ptr CompositionLayerEquirect2KHR -> IO b
f = Int -> Int -> (Ptr CompositionLayerEquirect2KHR -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 120 8 ((Ptr CompositionLayerEquirect2KHR -> IO b) -> IO b)
-> (Ptr CompositionLayerEquirect2KHR -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr CompositionLayerEquirect2KHR
p -> Ptr CompositionLayerEquirect2KHR
-> CompositionLayerEquirect2KHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr CompositionLayerEquirect2KHR
p CompositionLayerEquirect2KHR
x (Ptr CompositionLayerEquirect2KHR -> IO b
f Ptr CompositionLayerEquirect2KHR
p)
  pokeCStruct :: Ptr CompositionLayerEquirect2KHR
-> CompositionLayerEquirect2KHR -> IO b -> IO b
pokeCStruct p :: Ptr CompositionLayerEquirect2KHR
p CompositionLayerEquirect2KHR{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_COMPOSITION_LAYER_EQUIRECT2_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> 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 CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR
-> 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 CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> 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 CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> 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 CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> 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 CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> 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 CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> 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 CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 104 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
centralHorizontalAngle))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 108 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
upperVerticalAngle))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 112 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
lowerVerticalAngle))
    IO b
f
  cStructSize :: Int
cStructSize = 120
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr CompositionLayerEquirect2KHR -> IO b -> IO b
pokeZeroCStruct p :: Ptr CompositionLayerEquirect2KHR
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_COMPOSITION_LAYER_EQUIRECT2_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> 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 CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> 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 CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> 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 CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> 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 CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> 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 CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> 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 CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> 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 CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> 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))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 112 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct CompositionLayerEquirect2KHR where
  peekCStruct :: Ptr CompositionLayerEquirect2KHR -> IO CompositionLayerEquirect2KHR
peekCStruct p :: Ptr CompositionLayerEquirect2KHR
p = do
    CompositionLayerFlags
layerFlags <- Ptr CompositionLayerFlags -> IO CompositionLayerFlags
forall a. Storable a => Ptr a -> IO a
peek @CompositionLayerFlags ((Ptr CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR
-> 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 CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> 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 CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> 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 CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> 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 CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> 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 CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 100 :: Ptr CFloat))
    CFloat
centralHorizontalAngle <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 104 :: Ptr CFloat))
    CFloat
upperVerticalAngle <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 108 :: Ptr CFloat))
    CFloat
lowerVerticalAngle <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr CompositionLayerEquirect2KHR
p Ptr CompositionLayerEquirect2KHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 112 :: Ptr CFloat))
    CompositionLayerEquirect2KHR -> IO CompositionLayerEquirect2KHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompositionLayerEquirect2KHR -> IO CompositionLayerEquirect2KHR)
-> CompositionLayerEquirect2KHR -> IO CompositionLayerEquirect2KHR
forall a b. (a -> b) -> a -> b
$ CompositionLayerFlags
-> Ptr Space_T
-> EyeVisibility
-> SwapchainSubImage
-> Posef
-> Float
-> Float
-> Float
-> Float
-> CompositionLayerEquirect2KHR
CompositionLayerEquirect2KHR
             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
centralHorizontalAngle) (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
upperVerticalAngle) (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
lowerVerticalAngle)

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

instance Zero CompositionLayerEquirect2KHR where
  zero :: CompositionLayerEquirect2KHR
zero = CompositionLayerFlags
-> Ptr Space_T
-> EyeVisibility
-> SwapchainSubImage
-> Posef
-> Float
-> Float
-> Float
-> Float
-> CompositionLayerEquirect2KHR
CompositionLayerEquirect2KHR
           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
           Float
forall a. Zero a => a
zero


type KHR_composition_layer_equirect2_SPEC_VERSION = 1

-- No documentation found for TopLevel "XR_KHR_composition_layer_equirect2_SPEC_VERSION"
pattern KHR_composition_layer_equirect2_SPEC_VERSION :: forall a . Integral a => a
pattern $bKHR_composition_layer_equirect2_SPEC_VERSION :: a
$mKHR_composition_layer_equirect2_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
KHR_composition_layer_equirect2_SPEC_VERSION = 1


type KHR_COMPOSITION_LAYER_EQUIRECT2_EXTENSION_NAME = "XR_KHR_composition_layer_equirect2"

-- No documentation found for TopLevel "XR_KHR_COMPOSITION_LAYER_EQUIRECT2_EXTENSION_NAME"
pattern KHR_COMPOSITION_LAYER_EQUIRECT2_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bKHR_COMPOSITION_LAYER_EQUIRECT2_EXTENSION_NAME :: a
$mKHR_COMPOSITION_LAYER_EQUIRECT2_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
KHR_COMPOSITION_LAYER_EQUIRECT2_EXTENSION_NAME = "XR_KHR_composition_layer_equirect2"