{-# language CPP #-}
-- No documentation found for Chapter "OtherTypes"
module OpenXR.Core10.OtherTypes  ( Vector4f(..)
                                 , Color4f(..)
                                 , Fovf(..)
                                 , SwapchainSubImage(..)
                                 , CompositionLayerBaseHeader(..)
                                 , IsCompositionLayer(..)
                                 , CompositionLayerProjectionView(..)
                                 , CompositionLayerProjection(..)
                                 , CompositionLayerQuad(..)
                                 , HapticVibration(..)
                                 , EventDataBaseHeader(..)
                                 , IsEventData(..)
                                 , EventDataEventsLost(..)
                                 , EventDataInstanceLossPending(..)
                                 , EventDataSessionStateChanged(..)
                                 , EventDataReferenceSpaceChangePending(..)
                                 , EventDataInteractionProfileChanged(..)
                                 , Offset2Df(..)
                                 , Extent2Df(..)
                                 , Rect2Df(..)
                                 , BaseInStructure(..)
                                 , BaseOutStructure(..)
                                 , ObjectType(..)
                                 ) where

import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytesAligned)
import GHC.IO (throwIO)
import GHC.Ptr (castPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Data.Coerce (coerce)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import OpenXR.CStruct (FromCStruct)
import OpenXR.CStruct (FromCStruct(..))
import OpenXR.CStruct (ToCStruct)
import OpenXR.CStruct (ToCStruct(..))
import OpenXR.Zero (Zero(..))
import Data.Type.Equality ((:~:)(Refl))
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 GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import OpenXR.CStruct.Utils (advancePtrBytes)
import OpenXR.Core10.FundamentalTypes (bool32ToBool)
import OpenXR.Core10.FundamentalTypes (boolToBool32)
import OpenXR.CStruct.Extends (forgetExtensions)
import OpenXR.CStruct.Extends (peekSomeCStruct)
import OpenXR.CStruct.Extends (pokeSomeCStruct)
import OpenXR.Core10.FundamentalTypes (Bool32)
import OpenXR.CStruct.Extends (Chain)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_composition_layer_color_scale_bias (CompositionLayerColorScaleBiasKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_composition_layer_cube (CompositionLayerCubeKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_composition_layer_cylinder (CompositionLayerCylinderKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_composition_layer_depth (CompositionLayerDepthInfoKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_composition_layer_equirect2 (CompositionLayerEquirect2KHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_composition_layer_equirect (CompositionLayerEquirectKHR)
import OpenXR.Core10.Enums.CompositionLayerFlags (CompositionLayerFlags)
import OpenXR.Core10.FundamentalTypes (Duration)
import {-# SOURCE #-} OpenXR.Extensions.XR_FB_display_refresh_rate (EventDataDisplayRefreshRateChangedFB)
import {-# SOURCE #-} OpenXR.Extensions.XR_EXTX_overlay (EventDataMainSessionVisibilityChangedEXTX)
import {-# SOURCE #-} OpenXR.Extensions.XR_EXT_performance_settings (EventDataPerfSettingsEXT)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_visibility_mask (EventDataVisibilityMaskChangedKHR)
import OpenXR.CStruct.Extends (Extends)
import OpenXR.CStruct.Extends (Extendss)
import OpenXR.CStruct.Extends (Extensible(..))
import OpenXR.Core10.FundamentalTypes (Extent2Df)
import OpenXR.Core10.Enums.EyeVisibility (EyeVisibility)
import OpenXR.Core10.Haptics (HapticBaseHeader(..))
import OpenXR.CStruct.Extends (Inheritable(..))
import OpenXR.Core10.Haptics (IsHaptic(..))
import OpenXR.CStruct.Extends (PeekChain)
import OpenXR.CStruct.Extends (PeekChain(..))
import OpenXR.CStruct.Extends (PokeChain)
import OpenXR.CStruct.Extends (PokeChain(..))
import OpenXR.Core10.Space (Posef)
import OpenXR.Core10.FundamentalTypes (Rect2Di)
import OpenXR.Core10.Enums.ReferenceSpaceType (ReferenceSpaceType)
import OpenXR.Core10.Enums.SessionState (SessionState)
import OpenXR.Core10.Handles (Session_T)
import OpenXR.CStruct.Extends (SomeChild(..))
import OpenXR.CStruct.Extends (SomeStruct)
import OpenXR.Core10.Handles (Space_T)
import OpenXR.Core10.Enums.StructureType (StructureType)
import OpenXR.Core10.Handles (Swapchain_T)
import OpenXR.Core10.FundamentalTypes (Time)
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_COMPOSITION_LAYER_CUBE_KHR))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_COMPOSITION_LAYER_CYLINDER_KHR))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_COMPOSITION_LAYER_EQUIRECT2_KHR))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_COMPOSITION_LAYER_EQUIRECT_KHR))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_COMPOSITION_LAYER_PROJECTION))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_COMPOSITION_LAYER_PROJECTION_VIEW))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_COMPOSITION_LAYER_QUAD))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_EVENT_DATA_DISPLAY_REFRESH_RATE_CHANGED_FB))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_EVENT_DATA_EVENTS_LOST))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_EVENT_DATA_INSTANCE_LOSS_PENDING))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_EVENT_DATA_INTERACTION_PROFILE_CHANGED))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_EVENT_DATA_MAIN_SESSION_VISIBILITY_CHANGED_EXTX))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_EVENT_DATA_PERF_SETTINGS_EXT))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_EVENT_DATA_REFERENCE_SPACE_CHANGE_PENDING))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_EVENT_DATA_SESSION_STATE_CHANGED))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_EVENT_DATA_VISIBILITY_MASK_CHANGED_KHR))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_HAPTIC_VIBRATION))
import OpenXR.CStruct.Extends (BaseInStructure(..))
import OpenXR.CStruct.Extends (BaseOutStructure(..))
import OpenXR.Core10.FundamentalTypes (Extent2Df(..))
import OpenXR.Core10.Enums.ObjectType (ObjectType(..))
import OpenXR.Core10.FundamentalTypes (Offset2Df(..))
import OpenXR.Core10.FundamentalTypes (Rect2Df(..))
-- | XrVector4f - Four-dimensional vector
--
-- == Member Descriptions
--
-- = Description
--
-- If used to represent physical distances, @x@, @y@, and @z@ values /must/
-- be in meters.
--
-- = See Also
--
-- 'OpenXR.Core10.Space.Posef', 'OpenXR.Core10.Space.Quaternionf',
-- 'OpenXR.Core10.Input.Vector2f', 'OpenXR.Core10.Space.Vector3f'
data Vector4f = Vector4f
  { -- | @x@ is the x coordinate of the vector.
    Vector4f -> Float
x :: Float
  , -- | @y@ is the y coordinate of the vector.
    Vector4f -> Float
y :: Float
  , -- | @z@ is the z coordinate of the vector.
    Vector4f -> Float
z :: Float
  , -- | @w@ is the w coordinate of the vector.
    Vector4f -> Float
w :: Float
  }
  deriving (Typeable, Vector4f -> Vector4f -> Bool
(Vector4f -> Vector4f -> Bool)
-> (Vector4f -> Vector4f -> Bool) -> Eq Vector4f
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vector4f -> Vector4f -> Bool
$c/= :: Vector4f -> Vector4f -> Bool
== :: Vector4f -> Vector4f -> Bool
$c== :: Vector4f -> Vector4f -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (Vector4f)
#endif
deriving instance Show Vector4f

instance ToCStruct Vector4f where
  withCStruct :: Vector4f -> (Ptr Vector4f -> IO b) -> IO b
withCStruct x :: Vector4f
x f :: Ptr Vector4f -> IO b
f = Int -> Int -> (Ptr Vector4f -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 16 4 ((Ptr Vector4f -> IO b) -> IO b) -> (Ptr Vector4f -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr Vector4f
p -> Ptr Vector4f -> Vector4f -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr Vector4f
p Vector4f
x (Ptr Vector4f -> IO b
f Ptr Vector4f
p)
  pokeCStruct :: Ptr Vector4f -> Vector4f -> IO b -> IO b
pokeCStruct p :: Ptr Vector4f
p Vector4f{..} f :: IO b
f = do
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Vector4f
p Ptr Vector4f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
x))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Vector4f
p Ptr Vector4f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
y))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Vector4f
p Ptr Vector4f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
z))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Vector4f
p Ptr Vector4f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
w))
    IO b
f
  cStructSize :: Int
cStructSize = 16
  cStructAlignment :: Int
cStructAlignment = 4
  pokeZeroCStruct :: Ptr Vector4f -> IO b -> IO b
pokeZeroCStruct p :: Ptr Vector4f
p f :: IO b
f = do
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Vector4f
p Ptr Vector4f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: 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 Vector4f
p Ptr Vector4f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: 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 Vector4f
p Ptr Vector4f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: 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 Vector4f
p Ptr Vector4f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct Vector4f where
  peekCStruct :: Ptr Vector4f -> IO Vector4f
peekCStruct p :: Ptr Vector4f
p = do
    CFloat
x <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr Vector4f
p Ptr Vector4f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr CFloat))
    CFloat
y <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr Vector4f
p Ptr Vector4f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr CFloat))
    CFloat
z <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr Vector4f
p Ptr Vector4f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr CFloat))
    CFloat
w <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr Vector4f
p Ptr Vector4f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr CFloat))
    Vector4f -> IO Vector4f
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector4f -> IO Vector4f) -> Vector4f -> IO Vector4f
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Float -> Vector4f
Vector4f
             (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
x) (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
y) (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
z) (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
w)

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

instance Zero Vector4f where
  zero :: Vector4f
zero = Float -> Float -> Float -> Float -> Vector4f
Vector4f
           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


-- | XrColor4f - Color Vector
--
-- == Member Descriptions
--
-- = Description
--
-- Unless otherwise specified, colors are encoded as linear (not with sRGB
-- nor other gamma compression) values with individual components being in
-- the range of 0.0 through 1.0, and without the RGB components being
-- premultiplied by the alpha component.
--
-- = See Also
--
-- 'OpenXR.Extensions.XR_KHR_composition_layer_color_scale_bias.CompositionLayerColorScaleBiasKHR'
data Color4f = Color4f
  { -- | @r@ is the red component of the color.
    Color4f -> Float
r :: Float
  , -- | @g@ is the green component of the color.
    Color4f -> Float
g :: Float
  , -- | @b@ is the blue component of the color.
    Color4f -> Float
b :: Float
  , -- | @a@ is the alpha component of the color.
    Color4f -> Float
a :: Float
  }
  deriving (Typeable, Color4f -> Color4f -> Bool
(Color4f -> Color4f -> Bool)
-> (Color4f -> Color4f -> Bool) -> Eq Color4f
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Color4f -> Color4f -> Bool
$c/= :: Color4f -> Color4f -> Bool
== :: Color4f -> Color4f -> Bool
$c== :: Color4f -> Color4f -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (Color4f)
#endif
deriving instance Show Color4f

instance ToCStruct Color4f where
  withCStruct :: Color4f -> (Ptr Color4f -> IO b) -> IO b
withCStruct x :: Color4f
x f :: Ptr Color4f -> IO b
f = Int -> Int -> (Ptr Color4f -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 16 4 ((Ptr Color4f -> IO b) -> IO b) -> (Ptr Color4f -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr Color4f
p -> Ptr Color4f -> Color4f -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr Color4f
p Color4f
x (Ptr Color4f -> IO b
f Ptr Color4f
p)
  pokeCStruct :: Ptr Color4f -> Color4f -> IO b -> IO b
pokeCStruct p :: Ptr Color4f
p Color4f{..} f :: IO b
f = do
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Color4f
p Ptr Color4f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
r))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Color4f
p Ptr Color4f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
g))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Color4f
p Ptr Color4f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
b))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Color4f
p Ptr Color4f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
a))
    IO b
f
  cStructSize :: Int
cStructSize = 16
  cStructAlignment :: Int
cStructAlignment = 4
  pokeZeroCStruct :: Ptr Color4f -> IO b -> IO b
pokeZeroCStruct p :: Ptr Color4f
p f :: IO b
f = do
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Color4f
p Ptr Color4f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: 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 Color4f
p Ptr Color4f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: 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 Color4f
p Ptr Color4f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: 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 Color4f
p Ptr Color4f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct Color4f where
  peekCStruct :: Ptr Color4f -> IO Color4f
peekCStruct p :: Ptr Color4f
p = do
    CFloat
r <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr Color4f
p Ptr Color4f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr CFloat))
    CFloat
g <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr Color4f
p Ptr Color4f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr CFloat))
    CFloat
b <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr Color4f
p Ptr Color4f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr CFloat))
    CFloat
a <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr Color4f
p Ptr Color4f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr CFloat))
    Color4f -> IO Color4f
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Color4f -> IO Color4f) -> Color4f -> IO Color4f
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Float -> Color4f
Color4f
             (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
r) (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
g) (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
b) (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
a)

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

instance Zero Color4f where
  zero :: Color4f
zero = Float -> Float -> Float -> Float -> Color4f
Color4f
           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


-- | XrFovf - Field of view
--
-- == Member Descriptions
--
-- = Description
--
-- Angles to the right of the center and upwards from the center are
-- positive, and angles to the left of the center and down from the center
-- are negative. The total horizontal field of view is @angleRight@ minus
-- @angleLeft@, and the total vertical field of view is @angleUp@ minus
-- @angleDown@. For a symmetric FoV, @angleRight@ and @angleUp@ will have
-- positive values, @angleLeft@ will be -@angleRight@, and @angleDown@ will
-- be -@angleUp@.
--
-- The angles /must/ be specified in radians, and /must/ be between -π\/2
-- and π\/2 exclusively.
--
-- When @angleLeft@ > @angleRight@, the content of the view /must/ be
-- flipped horizontally. When @angleDown@ > @angleUp@, the content of the
-- view /must/ be flipped vertically.
--
-- = See Also
--
-- 'CompositionLayerProjectionView', 'OpenXR.Core10.DisplayTiming.View',
-- 'OpenXR.Extensions.XR_EPIC_view_configuration_fov.ViewConfigurationViewFovEPIC'
data Fovf = Fovf
  { -- | @angleLeft@ is the angle of the left side of the field of view. For a
    -- symmetric field of view this value is negative.
    Fovf -> Float
angleLeft :: Float
  , -- | @angleRight@ is the angle of the right side of the field of view.
    Fovf -> Float
angleRight :: Float
  , -- | @angleUp@ is the angle of the top part of the field of view.
    Fovf -> Float
angleUp :: Float
  , -- | @angleDown@ is the angle of the bottom part of the field of view. For a
    -- symmetric field of view this value is negative.
    Fovf -> Float
angleDown :: Float
  }
  deriving (Typeable, Fovf -> Fovf -> Bool
(Fovf -> Fovf -> Bool) -> (Fovf -> Fovf -> Bool) -> Eq Fovf
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fovf -> Fovf -> Bool
$c/= :: Fovf -> Fovf -> Bool
== :: Fovf -> Fovf -> Bool
$c== :: Fovf -> Fovf -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (Fovf)
#endif
deriving instance Show Fovf

instance ToCStruct Fovf where
  withCStruct :: Fovf -> (Ptr Fovf -> IO b) -> IO b
withCStruct x :: Fovf
x f :: Ptr Fovf -> IO b
f = Int -> Int -> (Ptr Fovf -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 16 4 ((Ptr Fovf -> IO b) -> IO b) -> (Ptr Fovf -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr Fovf
p -> Ptr Fovf -> Fovf -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr Fovf
p Fovf
x (Ptr Fovf -> IO b
f Ptr Fovf
p)
  pokeCStruct :: Ptr Fovf -> Fovf -> IO b -> IO b
pokeCStruct p :: Ptr Fovf
p Fovf{..} f :: IO b
f = do
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Fovf
p Ptr Fovf -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
angleLeft))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Fovf
p Ptr Fovf -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
angleRight))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Fovf
p Ptr Fovf -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
angleUp))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Fovf
p Ptr Fovf -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
angleDown))
    IO b
f
  cStructSize :: Int
cStructSize = 16
  cStructAlignment :: Int
cStructAlignment = 4
  pokeZeroCStruct :: Ptr Fovf -> IO b -> IO b
pokeZeroCStruct p :: Ptr Fovf
p f :: IO b
f = do
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Fovf
p Ptr Fovf -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: 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 Fovf
p Ptr Fovf -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: 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 Fovf
p Ptr Fovf -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: 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 Fovf
p Ptr Fovf -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct Fovf where
  peekCStruct :: Ptr Fovf -> IO Fovf
peekCStruct p :: Ptr Fovf
p = do
    CFloat
angleLeft <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr Fovf
p Ptr Fovf -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr CFloat))
    CFloat
angleRight <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr Fovf
p Ptr Fovf -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr CFloat))
    CFloat
angleUp <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr Fovf
p Ptr Fovf -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr CFloat))
    CFloat
angleDown <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr Fovf
p Ptr Fovf -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr CFloat))
    Fovf -> IO Fovf
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fovf -> IO Fovf) -> Fovf -> IO Fovf
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Float -> Fovf
Fovf
             (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
angleLeft) (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
angleRight) (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
angleUp) (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
angleDown)

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

instance Zero Fovf where
  zero :: Fovf
zero = Float -> Float -> Float -> Float -> Fovf
Fovf
           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


-- | XrSwapchainSubImage - Composition layer data
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'OpenXR.Extensions.XR_KHR_composition_layer_cylinder.CompositionLayerCylinderKHR',
-- 'OpenXR.Extensions.XR_KHR_composition_layer_depth.CompositionLayerDepthInfoKHR',
-- 'OpenXR.Extensions.XR_KHR_composition_layer_equirect2.CompositionLayerEquirect2KHR',
-- 'OpenXR.Extensions.XR_KHR_composition_layer_equirect.CompositionLayerEquirectKHR',
-- 'CompositionLayerProjectionView', 'CompositionLayerQuad',
-- 'OpenXR.Core10.DisplayTiming.FrameEndInfo',
-- 'OpenXR.Core10.FundamentalTypes.Rect2Di',
-- 'OpenXR.Core10.Handles.Swapchain'
data SwapchainSubImage = SwapchainSubImage
  { -- | @swapchain@ is the 'OpenXR.Core10.Handles.Swapchain' to be displayed.
    --
    -- #VUID-XrSwapchainSubImage-swapchain-parameter# @swapchain@ /must/ be a
    -- valid 'OpenXR.Core10.Handles.Swapchain' handle
    SwapchainSubImage -> Ptr Swapchain_T
swapchain :: Ptr Swapchain_T
  , -- | @imageRect@ is an 'OpenXR.Core10.FundamentalTypes.Rect2Di' representing
    -- the valid portion of the image to use, in pixels. It also implicitly
    -- defines the transform from normalized image coordinates into pixel
    -- coordinates. Note that the compositor /may/ bleed in pixels from outside
    -- the bounds in some cases, for instance due to mipmapping.
    SwapchainSubImage -> Rect2Di
imageRect :: Rect2Di
  , -- | @imageArrayIndex@ is the image array index, with 0 meaning the first or
    -- only array element.
    SwapchainSubImage -> Word32
imageArrayIndex :: Word32
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SwapchainSubImage)
#endif
deriving instance Show SwapchainSubImage

instance ToCStruct SwapchainSubImage where
  withCStruct :: SwapchainSubImage -> (Ptr SwapchainSubImage -> IO b) -> IO b
withCStruct x :: SwapchainSubImage
x f :: Ptr SwapchainSubImage -> IO b
f = Int -> Int -> (Ptr SwapchainSubImage -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((Ptr SwapchainSubImage -> IO b) -> IO b)
-> (Ptr SwapchainSubImage -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr SwapchainSubImage
p -> Ptr SwapchainSubImage -> SwapchainSubImage -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SwapchainSubImage
p SwapchainSubImage
x (Ptr SwapchainSubImage -> IO b
f Ptr SwapchainSubImage
p)
  pokeCStruct :: Ptr SwapchainSubImage -> SwapchainSubImage -> IO b -> IO b
pokeCStruct p :: Ptr SwapchainSubImage
p SwapchainSubImage{..} f :: IO b
f = do
    Ptr (Ptr Swapchain_T) -> Ptr Swapchain_T -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainSubImage
p Ptr SwapchainSubImage -> Int -> Ptr (Ptr Swapchain_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr (Ptr Swapchain_T))) (Ptr Swapchain_T
swapchain)
    Ptr Rect2Di -> Rect2Di -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainSubImage
p Ptr SwapchainSubImage -> Int -> Ptr Rect2Di
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Rect2Di)) (Rect2Di
imageRect)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainSubImage
p Ptr SwapchainSubImage -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word32)) (Word32
imageArrayIndex)
    IO b
f
  cStructSize :: Int
cStructSize = 32
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr SwapchainSubImage -> IO b -> IO b
pokeZeroCStruct p :: Ptr SwapchainSubImage
p f :: IO b
f = do
    Ptr (Ptr Swapchain_T) -> Ptr Swapchain_T -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainSubImage
p Ptr SwapchainSubImage -> Int -> Ptr (Ptr Swapchain_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr (Ptr Swapchain_T))) (Ptr Swapchain_T
forall a. Zero a => a
zero)
    Ptr Rect2Di -> Rect2Di -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainSubImage
p Ptr SwapchainSubImage -> Int -> Ptr Rect2Di
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Rect2Di)) (Rect2Di
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SwapchainSubImage
p Ptr SwapchainSubImage -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct SwapchainSubImage where
  peekCStruct :: Ptr SwapchainSubImage -> IO SwapchainSubImage
peekCStruct p :: Ptr SwapchainSubImage
p = do
    Ptr Swapchain_T
swapchain <- Ptr (Ptr Swapchain_T) -> IO (Ptr Swapchain_T)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Swapchain_T) ((Ptr SwapchainSubImage
p Ptr SwapchainSubImage -> Int -> Ptr (Ptr Swapchain_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr (Ptr Swapchain_T)))
    Rect2Di
imageRect <- Ptr Rect2Di -> IO Rect2Di
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Rect2Di ((Ptr SwapchainSubImage
p Ptr SwapchainSubImage -> Int -> Ptr Rect2Di
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Rect2Di))
    Word32
imageArrayIndex <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr SwapchainSubImage
p Ptr SwapchainSubImage -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word32))
    SwapchainSubImage -> IO SwapchainSubImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SwapchainSubImage -> IO SwapchainSubImage)
-> SwapchainSubImage -> IO SwapchainSubImage
forall a b. (a -> b) -> a -> b
$ Ptr Swapchain_T -> Rect2Di -> Word32 -> SwapchainSubImage
SwapchainSubImage
             Ptr Swapchain_T
swapchain Rect2Di
imageRect Word32
imageArrayIndex

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

instance Zero SwapchainSubImage where
  zero :: SwapchainSubImage
zero = Ptr Swapchain_T -> Rect2Di -> Word32 -> SwapchainSubImage
SwapchainSubImage
           Ptr Swapchain_T
forall a. Zero a => a
zero
           Rect2Di
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero


-- | XrCompositionLayerBaseHeader - Composition layer base header
--
-- == Member Descriptions
--
-- = Description
--
-- All composition layer structures begin with the elements described in
-- the 'CompositionLayerBaseHeader'. The 'CompositionLayerBaseHeader'
-- structure is not intended to be directly used, but forms a basis for
-- defining current and future structures containing composition layer
-- information. The 'OpenXR.Core10.DisplayTiming.FrameEndInfo' structure
-- contains an array of pointers to these polymorphic header structures.
-- All composition layer type pointers /must/ be type-castable as an
-- 'CompositionLayerBaseHeader' pointer.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'OpenXR.Core10.Enums.CompositionLayerFlags.CompositionLayerFlags',
-- 'OpenXR.Core10.DisplayTiming.FrameEndInfo',
-- 'OpenXR.Extensions.XR_MSFT_secondary_view_configuration.SecondaryViewConfigurationLayerInfoMSFT',
-- 'OpenXR.Core10.Handles.Space',
-- 'OpenXR.Core10.Enums.StructureType.StructureType', 'SwapchainSubImage'
data CompositionLayerBaseHeader (es :: [Type]) = CompositionLayerBaseHeader
  { -- | @type@ is the 'OpenXR.Core10.Enums.StructureType.StructureType' of this
    -- structure. This base structure itself has no associated
    -- 'OpenXR.Core10.Enums.StructureType.StructureType' value.
    --
    -- #VUID-XrCompositionLayerBaseHeader-type-type# @type@ /must/ be one of
    -- the following XrStructureType values:
    -- 'OpenXR.Core10.Enums.StructureType.TYPE_COMPOSITION_LAYER_CUBE_KHR',
    -- 'OpenXR.Core10.Enums.StructureType.TYPE_COMPOSITION_LAYER_CYLINDER_KHR',
    -- 'OpenXR.Core10.Enums.StructureType.TYPE_COMPOSITION_LAYER_EQUIRECT2_KHR',
    -- 'OpenXR.Core10.Enums.StructureType.TYPE_COMPOSITION_LAYER_EQUIRECT_KHR',
    -- 'OpenXR.Core10.Enums.StructureType.TYPE_COMPOSITION_LAYER_PROJECTION',
    -- 'OpenXR.Core10.Enums.StructureType.TYPE_COMPOSITION_LAYER_QUAD'
    CompositionLayerBaseHeader es -> StructureType
type' :: StructureType
  , -- | @next@ is @NULL@ or a pointer to the next structure in a structure
    -- chain. No such structures are defined in core OpenXR.
    --
    -- #VUID-XrCompositionLayerBaseHeader-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.Extensions.XR_KHR_composition_layer_color_scale_bias.CompositionLayerColorScaleBiasKHR'
    CompositionLayerBaseHeader es -> Chain es
next :: Chain es
  , -- | @layerFlags@ is a bitmask of
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrCompositionLayerFlagBits XrCompositionLayerFlagBits>
    -- describing flags to apply to the layer.
    --
    -- #VUID-XrCompositionLayerBaseHeader-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
    CompositionLayerBaseHeader es -> CompositionLayerFlags
layerFlags :: CompositionLayerFlags
  , -- | @space@ is the 'OpenXR.Core10.Handles.Space' in which the layer will be
    -- kept stable over time.
    --
    -- #VUID-XrCompositionLayerBaseHeader-space-parameter# @space@ /must/ be a
    -- valid 'OpenXR.Core10.Handles.Space' handle
    CompositionLayerBaseHeader es -> Ptr Space_T
space :: Ptr Space_T
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CompositionLayerBaseHeader (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (CompositionLayerBaseHeader es)

instance Extensible CompositionLayerBaseHeader where
  extensibleTypeName :: String
extensibleTypeName = "CompositionLayerBaseHeader"
  setNext :: CompositionLayerBaseHeader ds
-> Chain es -> CompositionLayerBaseHeader es
setNext x :: CompositionLayerBaseHeader ds
x next :: Chain es
next = CompositionLayerBaseHeader ds
x{$sel:next:CompositionLayerBaseHeader :: Chain es
next = Chain es
next}
  getNext :: CompositionLayerBaseHeader es -> Chain es
getNext CompositionLayerBaseHeader{..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends CompositionLayerBaseHeader e => b) -> Maybe b
  extends :: proxy e -> (Extends CompositionLayerBaseHeader e => b) -> Maybe b
extends _ f :: Extends CompositionLayerBaseHeader e => b
f
    | Just Refl <- (Typeable e, Typeable CompositionLayerColorScaleBiasKHR) =>
Maybe (e :~: CompositionLayerColorScaleBiasKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @CompositionLayerColorScaleBiasKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends CompositionLayerBaseHeader e => b
f
    | Bool
otherwise = Maybe b
forall a. Maybe a
Nothing

class ToCStruct a => IsCompositionLayer a where
  toCompositionLayerBaseHeader :: a -> CompositionLayerBaseHeader '[]

instance Inheritable (CompositionLayerBaseHeader '[]) where
  peekSomeCChild :: Ptr (SomeChild (CompositionLayerBaseHeader '[])) -> IO (SomeChild (CompositionLayerBaseHeader '[]))
  peekSomeCChild :: Ptr (SomeChild (CompositionLayerBaseHeader '[]))
-> IO (SomeChild (CompositionLayerBaseHeader '[]))
peekSomeCChild p :: Ptr (SomeChild (CompositionLayerBaseHeader '[]))
p = do
    StructureType
ty <- Ptr StructureType -> IO StructureType
forall a. Storable a => Ptr a -> IO a
peek @StructureType (Ptr (SomeChild (CompositionLayerBaseHeader '[]))
-> Ptr StructureType
forall a b. Ptr a -> Ptr b
castPtr @(SomeChild (CompositionLayerBaseHeader '[])) @StructureType Ptr (SomeChild (CompositionLayerBaseHeader '[]))
p)
    case StructureType
ty of
      TYPE_COMPOSITION_LAYER_EQUIRECT2_KHR -> CompositionLayerEquirect2KHR
-> SomeChild (CompositionLayerBaseHeader '[])
forall a b.
(Inherits a b, Typeable b, ToCStruct b, Show b) =>
b -> SomeChild a
SomeChild (CompositionLayerEquirect2KHR
 -> SomeChild (CompositionLayerBaseHeader '[]))
-> IO CompositionLayerEquirect2KHR
-> IO (SomeChild (CompositionLayerBaseHeader '[]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CompositionLayerEquirect2KHR -> IO CompositionLayerEquirect2KHR
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct (Ptr (SomeChild (CompositionLayerBaseHeader '[]))
-> Ptr CompositionLayerEquirect2KHR
forall a b. Ptr a -> Ptr b
castPtr @(SomeChild (CompositionLayerBaseHeader '[])) @CompositionLayerEquirect2KHR Ptr (SomeChild (CompositionLayerBaseHeader '[]))
p)
      TYPE_COMPOSITION_LAYER_EQUIRECT_KHR -> CompositionLayerEquirectKHR
-> SomeChild (CompositionLayerBaseHeader '[])
forall a b.
(Inherits a b, Typeable b, ToCStruct b, Show b) =>
b -> SomeChild a
SomeChild (CompositionLayerEquirectKHR
 -> SomeChild (CompositionLayerBaseHeader '[]))
-> IO CompositionLayerEquirectKHR
-> IO (SomeChild (CompositionLayerBaseHeader '[]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CompositionLayerEquirectKHR -> IO CompositionLayerEquirectKHR
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct (Ptr (SomeChild (CompositionLayerBaseHeader '[]))
-> Ptr CompositionLayerEquirectKHR
forall a b. Ptr a -> Ptr b
castPtr @(SomeChild (CompositionLayerBaseHeader '[])) @CompositionLayerEquirectKHR Ptr (SomeChild (CompositionLayerBaseHeader '[]))
p)
      TYPE_COMPOSITION_LAYER_CUBE_KHR -> CompositionLayerCubeKHR
-> SomeChild (CompositionLayerBaseHeader '[])
forall a b.
(Inherits a b, Typeable b, ToCStruct b, Show b) =>
b -> SomeChild a
SomeChild (CompositionLayerCubeKHR
 -> SomeChild (CompositionLayerBaseHeader '[]))
-> IO CompositionLayerCubeKHR
-> IO (SomeChild (CompositionLayerBaseHeader '[]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CompositionLayerCubeKHR -> IO CompositionLayerCubeKHR
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct (Ptr (SomeChild (CompositionLayerBaseHeader '[]))
-> Ptr CompositionLayerCubeKHR
forall a b. Ptr a -> Ptr b
castPtr @(SomeChild (CompositionLayerBaseHeader '[])) @CompositionLayerCubeKHR Ptr (SomeChild (CompositionLayerBaseHeader '[]))
p)
      TYPE_COMPOSITION_LAYER_CYLINDER_KHR -> CompositionLayerCylinderKHR
-> SomeChild (CompositionLayerBaseHeader '[])
forall a b.
(Inherits a b, Typeable b, ToCStruct b, Show b) =>
b -> SomeChild a
SomeChild (CompositionLayerCylinderKHR
 -> SomeChild (CompositionLayerBaseHeader '[]))
-> IO CompositionLayerCylinderKHR
-> IO (SomeChild (CompositionLayerBaseHeader '[]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CompositionLayerCylinderKHR -> IO CompositionLayerCylinderKHR
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct (Ptr (SomeChild (CompositionLayerBaseHeader '[]))
-> Ptr CompositionLayerCylinderKHR
forall a b. Ptr a -> Ptr b
castPtr @(SomeChild (CompositionLayerBaseHeader '[])) @CompositionLayerCylinderKHR Ptr (SomeChild (CompositionLayerBaseHeader '[]))
p)
      TYPE_COMPOSITION_LAYER_QUAD -> CompositionLayerQuad -> SomeChild (CompositionLayerBaseHeader '[])
forall a b.
(Inherits a b, Typeable b, ToCStruct b, Show b) =>
b -> SomeChild a
SomeChild (CompositionLayerQuad
 -> SomeChild (CompositionLayerBaseHeader '[]))
-> IO CompositionLayerQuad
-> IO (SomeChild (CompositionLayerBaseHeader '[]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CompositionLayerQuad -> IO CompositionLayerQuad
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct (Ptr (SomeChild (CompositionLayerBaseHeader '[]))
-> Ptr CompositionLayerQuad
forall a b. Ptr a -> Ptr b
castPtr @(SomeChild (CompositionLayerBaseHeader '[])) @CompositionLayerQuad Ptr (SomeChild (CompositionLayerBaseHeader '[]))
p)
      TYPE_COMPOSITION_LAYER_PROJECTION -> CompositionLayerProjection
-> SomeChild (CompositionLayerBaseHeader '[])
forall a b.
(Inherits a b, Typeable b, ToCStruct b, Show b) =>
b -> SomeChild a
SomeChild (CompositionLayerProjection
 -> SomeChild (CompositionLayerBaseHeader '[]))
-> IO CompositionLayerProjection
-> IO (SomeChild (CompositionLayerBaseHeader '[]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CompositionLayerProjection -> IO CompositionLayerProjection
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct (Ptr (SomeChild (CompositionLayerBaseHeader '[]))
-> Ptr CompositionLayerProjection
forall a b. Ptr a -> Ptr b
castPtr @(SomeChild (CompositionLayerBaseHeader '[])) @CompositionLayerProjection Ptr (SomeChild (CompositionLayerBaseHeader '[]))
p)
      c :: StructureType
c -> IOException -> IO (SomeChild (CompositionLayerBaseHeader '[]))
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO (SomeChild (CompositionLayerBaseHeader '[])))
-> IOException -> IO (SomeChild (CompositionLayerBaseHeader '[]))
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
          "peekSomeCChild"
          ("Illegal struct inheritance of CompositionLayerBaseHeader with " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> StructureType -> String
forall a. Show a => a -> String
show StructureType
c)
          Maybe CInt
forall a. Maybe a
Nothing
          Maybe String
forall a. Maybe a
Nothing

instance (Extendss CompositionLayerBaseHeader es, PokeChain es) => ToCStruct (CompositionLayerBaseHeader es) where
  withCStruct :: CompositionLayerBaseHeader es
-> (Ptr (CompositionLayerBaseHeader es) -> IO b) -> IO b
withCStruct x :: CompositionLayerBaseHeader es
x f :: Ptr (CompositionLayerBaseHeader es) -> IO b
f = Int -> Int -> (Ptr (CompositionLayerBaseHeader es) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((Ptr (CompositionLayerBaseHeader es) -> IO b) -> IO b)
-> (Ptr (CompositionLayerBaseHeader es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr (CompositionLayerBaseHeader es)
p -> Ptr (CompositionLayerBaseHeader es)
-> CompositionLayerBaseHeader es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (CompositionLayerBaseHeader es)
p CompositionLayerBaseHeader es
x (Ptr (CompositionLayerBaseHeader es) -> IO b
f Ptr (CompositionLayerBaseHeader es)
p)
  pokeCStruct :: Ptr (CompositionLayerBaseHeader es)
-> CompositionLayerBaseHeader es -> IO b -> IO b
pokeCStruct p :: Ptr (CompositionLayerBaseHeader es)
p CompositionLayerBaseHeader{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (CompositionLayerBaseHeader es)
p Ptr (CompositionLayerBaseHeader es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
type')
    Ptr ()
next'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (CompositionLayerBaseHeader es)
p Ptr (CompositionLayerBaseHeader es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
next''
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CompositionLayerFlags -> CompositionLayerFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (CompositionLayerBaseHeader es)
p Ptr (CompositionLayerBaseHeader es)
-> Int -> Ptr CompositionLayerFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr CompositionLayerFlags)) (CompositionLayerFlags
layerFlags)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr Space_T) -> Ptr Space_T -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (CompositionLayerBaseHeader es)
p Ptr (CompositionLayerBaseHeader es) -> Int -> Ptr (Ptr Space_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr Space_T))) (Ptr Space_T
space)
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = 32
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr (CompositionLayerBaseHeader es) -> IO b -> IO b
pokeZeroCStruct p :: Ptr (CompositionLayerBaseHeader es)
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (CompositionLayerBaseHeader es)
p Ptr (CompositionLayerBaseHeader es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
forall a. Zero a => a
zero)
    Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ forall a. PokeChain es => (Ptr (Chain es) -> IO a) -> IO a
forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (CompositionLayerBaseHeader es)
p Ptr (CompositionLayerBaseHeader es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext'
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr Space_T) -> Ptr Space_T -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (CompositionLayerBaseHeader es)
p Ptr (CompositionLayerBaseHeader es) -> 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)
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f

instance (Extendss CompositionLayerBaseHeader es, PeekChain es) => FromCStruct (CompositionLayerBaseHeader es) where
  peekCStruct :: Ptr (CompositionLayerBaseHeader es)
-> IO (CompositionLayerBaseHeader es)
peekCStruct p :: Ptr (CompositionLayerBaseHeader es)
p = do
    StructureType
type' <- Ptr StructureType -> IO StructureType
forall a. Storable a => Ptr a -> IO a
peek @StructureType ((Ptr (CompositionLayerBaseHeader es)
p Ptr (CompositionLayerBaseHeader es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType))
    Ptr ()
next <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (CompositionLayerBaseHeader es)
p Ptr (CompositionLayerBaseHeader es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ())))
    Chain es
next' <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
next)
    CompositionLayerFlags
layerFlags <- Ptr CompositionLayerFlags -> IO CompositionLayerFlags
forall a. Storable a => Ptr a -> IO a
peek @CompositionLayerFlags ((Ptr (CompositionLayerBaseHeader es)
p Ptr (CompositionLayerBaseHeader es)
-> 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 (CompositionLayerBaseHeader es)
p Ptr (CompositionLayerBaseHeader es) -> Int -> Ptr (Ptr Space_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr Space_T)))
    CompositionLayerBaseHeader es -> IO (CompositionLayerBaseHeader es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompositionLayerBaseHeader es
 -> IO (CompositionLayerBaseHeader es))
-> CompositionLayerBaseHeader es
-> IO (CompositionLayerBaseHeader es)
forall a b. (a -> b) -> a -> b
$ StructureType
-> Chain es
-> CompositionLayerFlags
-> Ptr Space_T
-> CompositionLayerBaseHeader es
forall (es :: [*]).
StructureType
-> Chain es
-> CompositionLayerFlags
-> Ptr Space_T
-> CompositionLayerBaseHeader es
CompositionLayerBaseHeader
             StructureType
type' Chain es
next' CompositionLayerFlags
layerFlags Ptr Space_T
space

instance es ~ '[] => Zero (CompositionLayerBaseHeader es) where
  zero :: CompositionLayerBaseHeader es
zero = StructureType
-> Chain es
-> CompositionLayerFlags
-> Ptr Space_T
-> CompositionLayerBaseHeader es
forall (es :: [*]).
StructureType
-> Chain es
-> CompositionLayerFlags
-> Ptr Space_T
-> CompositionLayerBaseHeader es
CompositionLayerBaseHeader
           StructureType
forall a. Zero a => a
zero
           ()
           CompositionLayerFlags
forall a. Zero a => a
zero
           Ptr Space_T
forall a. Zero a => a
zero


-- | XrCompositionLayerProjectionView - Projection layer element
--
-- == Member Descriptions
--
-- = Description
--
-- The count and order of view poses submitted with
-- 'CompositionLayerProjection' /must/ be the same order as that returned
-- by 'OpenXR.Core10.DisplayTiming.locateViews'. The
-- 'CompositionLayerProjectionView'::@pose@ and
-- 'CompositionLayerProjectionView'::@fov@ /should/ almost always derive
-- from 'OpenXR.Core10.DisplayTiming.View'::@pose@ and
-- 'OpenXR.Core10.DisplayTiming.View'::@fov@ as found in the
-- 'OpenXR.Core10.DisplayTiming.locateViews'::@views@ array. However,
-- applications /may/ submit an 'CompositionLayerProjectionView' which has
-- a different view or FOV than that from
-- 'OpenXR.Core10.DisplayTiming.locateViews'. In this case, the runtime
-- will map the view and FOV to the system display appropriately. In the
-- case that two submitted views within a single layer overlap, they /must/
-- be composited in view array order.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'CompositionLayerProjection', 'Fovf', 'OpenXR.Core10.Space.Posef',
-- 'OpenXR.Core10.Enums.StructureType.StructureType', 'SwapchainSubImage'
data CompositionLayerProjectionView (es :: [Type]) = CompositionLayerProjectionView
  { -- | @next@ is @NULL@ or a pointer to the next structure in a structure
    -- chain. No such structures are defined in core OpenXR.
    --
    -- #VUID-XrCompositionLayerProjectionView-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.Extensions.XR_KHR_composition_layer_depth.CompositionLayerDepthInfoKHR'
    CompositionLayerProjectionView es -> Chain es
next :: Chain es
  , -- | @pose@ is an 'OpenXR.Core10.Space.Posef' defining the location and
    -- orientation of this projection element in the @space@ of the
    -- corresponding 'CompositionLayerProjectionView'.
    CompositionLayerProjectionView es -> Posef
pose :: Posef
  , -- | @fov@ is the 'Fovf' for this projection element.
    CompositionLayerProjectionView es -> Fovf
fov :: Fovf
  , -- | @subImage@ is the image layer 'SwapchainSubImage' to use.
    --
    -- #VUID-XrCompositionLayerProjectionView-subImage-parameter# @subImage@
    -- /must/ be a valid 'SwapchainSubImage' structure
    CompositionLayerProjectionView es -> SwapchainSubImage
subImage :: SwapchainSubImage
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CompositionLayerProjectionView (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (CompositionLayerProjectionView es)

instance Extensible CompositionLayerProjectionView where
  extensibleTypeName :: String
extensibleTypeName = "CompositionLayerProjectionView"
  setNext :: CompositionLayerProjectionView ds
-> Chain es -> CompositionLayerProjectionView es
setNext x :: CompositionLayerProjectionView ds
x next :: Chain es
next = CompositionLayerProjectionView ds
x{$sel:next:CompositionLayerProjectionView :: Chain es
next = Chain es
next}
  getNext :: CompositionLayerProjectionView es -> Chain es
getNext CompositionLayerProjectionView{..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends CompositionLayerProjectionView e => b) -> Maybe b
  extends :: proxy e
-> (Extends CompositionLayerProjectionView e => b) -> Maybe b
extends _ f :: Extends CompositionLayerProjectionView e => b
f
    | Just Refl <- (Typeable e, Typeable CompositionLayerDepthInfoKHR) =>
Maybe (e :~: CompositionLayerDepthInfoKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @CompositionLayerDepthInfoKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends CompositionLayerProjectionView e => b
f
    | Bool
otherwise = Maybe b
forall a. Maybe a
Nothing

instance (Extendss CompositionLayerProjectionView es, PokeChain es) => ToCStruct (CompositionLayerProjectionView es) where
  withCStruct :: CompositionLayerProjectionView es
-> (Ptr (CompositionLayerProjectionView es) -> IO b) -> IO b
withCStruct x :: CompositionLayerProjectionView es
x f :: Ptr (CompositionLayerProjectionView es) -> IO b
f = Int
-> Int -> (Ptr (CompositionLayerProjectionView es) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 96 8 ((Ptr (CompositionLayerProjectionView es) -> IO b) -> IO b)
-> (Ptr (CompositionLayerProjectionView es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr (CompositionLayerProjectionView es)
p -> Ptr (CompositionLayerProjectionView es)
-> CompositionLayerProjectionView es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (CompositionLayerProjectionView es)
p CompositionLayerProjectionView es
x (Ptr (CompositionLayerProjectionView es) -> IO b
f Ptr (CompositionLayerProjectionView es)
p)
  pokeCStruct :: Ptr (CompositionLayerProjectionView es)
-> CompositionLayerProjectionView es -> IO b -> IO b
pokeCStruct p :: Ptr (CompositionLayerProjectionView es)
p CompositionLayerProjectionView{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (CompositionLayerProjectionView es)
p Ptr (CompositionLayerProjectionView es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_COMPOSITION_LAYER_PROJECTION_VIEW)
    Ptr ()
next'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (CompositionLayerProjectionView es)
p Ptr (CompositionLayerProjectionView es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
next''
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Posef -> Posef -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (CompositionLayerProjectionView es)
p Ptr (CompositionLayerProjectionView es) -> Int -> Ptr Posef
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Posef)) (Posef
pose)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Fovf -> Fovf -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (CompositionLayerProjectionView es)
p Ptr (CompositionLayerProjectionView es) -> Int -> Ptr Fovf
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 44 :: Ptr Fovf)) (Fovf
fov)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SwapchainSubImage -> SwapchainSubImage -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (CompositionLayerProjectionView es)
p Ptr (CompositionLayerProjectionView es)
-> Int -> Ptr SwapchainSubImage
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 64 :: Ptr SwapchainSubImage)) (SwapchainSubImage
subImage)
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = 96
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr (CompositionLayerProjectionView es) -> IO b -> IO b
pokeZeroCStruct p :: Ptr (CompositionLayerProjectionView es)
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (CompositionLayerProjectionView es)
p Ptr (CompositionLayerProjectionView es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_COMPOSITION_LAYER_PROJECTION_VIEW)
    Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ forall a. PokeChain es => (Ptr (Chain es) -> IO a) -> IO a
forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (CompositionLayerProjectionView es)
p Ptr (CompositionLayerProjectionView es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext'
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Posef -> Posef -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (CompositionLayerProjectionView es)
p Ptr (CompositionLayerProjectionView es) -> Int -> Ptr Posef
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Posef)) (Posef
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Fovf -> Fovf -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (CompositionLayerProjectionView es)
p Ptr (CompositionLayerProjectionView es) -> Int -> Ptr Fovf
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 44 :: Ptr Fovf)) (Fovf
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SwapchainSubImage -> SwapchainSubImage -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (CompositionLayerProjectionView es)
p Ptr (CompositionLayerProjectionView es)
-> Int -> Ptr SwapchainSubImage
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 64 :: Ptr SwapchainSubImage)) (SwapchainSubImage
forall a. Zero a => a
zero)
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f

instance (Extendss CompositionLayerProjectionView es, PeekChain es) => FromCStruct (CompositionLayerProjectionView es) where
  peekCStruct :: Ptr (CompositionLayerProjectionView es)
-> IO (CompositionLayerProjectionView es)
peekCStruct p :: Ptr (CompositionLayerProjectionView es)
p = do
    Ptr ()
next <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (CompositionLayerProjectionView es)
p Ptr (CompositionLayerProjectionView es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ())))
    Chain es
next' <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
next)
    Posef
pose <- Ptr Posef -> IO Posef
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Posef ((Ptr (CompositionLayerProjectionView es)
p Ptr (CompositionLayerProjectionView es) -> Int -> Ptr Posef
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Posef))
    Fovf
fov <- Ptr Fovf -> IO Fovf
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Fovf ((Ptr (CompositionLayerProjectionView es)
p Ptr (CompositionLayerProjectionView es) -> Int -> Ptr Fovf
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 44 :: Ptr Fovf))
    SwapchainSubImage
subImage <- Ptr SwapchainSubImage -> IO SwapchainSubImage
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @SwapchainSubImage ((Ptr (CompositionLayerProjectionView es)
p Ptr (CompositionLayerProjectionView es)
-> Int -> Ptr SwapchainSubImage
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 64 :: Ptr SwapchainSubImage))
    CompositionLayerProjectionView es
-> IO (CompositionLayerProjectionView es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompositionLayerProjectionView es
 -> IO (CompositionLayerProjectionView es))
-> CompositionLayerProjectionView es
-> IO (CompositionLayerProjectionView es)
forall a b. (a -> b) -> a -> b
$ Chain es
-> Posef
-> Fovf
-> SwapchainSubImage
-> CompositionLayerProjectionView es
forall (es :: [*]).
Chain es
-> Posef
-> Fovf
-> SwapchainSubImage
-> CompositionLayerProjectionView es
CompositionLayerProjectionView
             Chain es
next' Posef
pose Fovf
fov SwapchainSubImage
subImage

instance es ~ '[] => Zero (CompositionLayerProjectionView es) where
  zero :: CompositionLayerProjectionView es
zero = Chain es
-> Posef
-> Fovf
-> SwapchainSubImage
-> CompositionLayerProjectionView es
forall (es :: [*]).
Chain es
-> Posef
-> Fovf
-> SwapchainSubImage
-> CompositionLayerProjectionView es
CompositionLayerProjectionView
           ()
           Posef
forall a. Zero a => a
zero
           Fovf
forall a. Zero a => a
zero
           SwapchainSubImage
forall a. Zero a => a
zero


-- | XrCompositionLayerProjection - Composition layer for projection
--
-- == Member Descriptions
--
-- = Description
--
-- Note
--
-- Because a runtime may reproject the layer over time, a projection layer
-- should specify an 'OpenXR.Core10.Handles.Space' in which to maximize
-- stability of the layer content. For example, a projection layer
-- containing world-locked content should use an
-- 'OpenXR.Core10.Handles.Space' which is also world-locked, such as the
-- @LOCAL@ or @STAGE@ reference spaces. In the case that the projection
-- layer should be head-locked, such as a heads up display, the @VIEW@
-- reference space would provide the highest quality layer reprojection.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrCompositionLayerProjection-type-type# @type@ /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_COMPOSITION_LAYER_PROJECTION'
--
-- -   #VUID-XrCompositionLayerProjection-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-XrCompositionLayerProjection-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-XrCompositionLayerProjection-space-parameter# @space@ /must/
--     be a valid 'OpenXR.Core10.Handles.Space' handle
--
-- -   #VUID-XrCompositionLayerProjection-views-parameter# @views@ /must/
--     be a pointer to an array of @viewCount@ valid
--     'CompositionLayerProjectionView' structures
--
-- -   #VUID-XrCompositionLayerProjection-viewCount-arraylength# The
--     @viewCount@ parameter /must/ be greater than @0@
--
-- = See Also
--
-- 'CompositionLayerBaseHeader',
-- 'OpenXR.Core10.Enums.CompositionLayerFlags.CompositionLayerFlags',
-- 'CompositionLayerProjectionView', 'OpenXR.Core10.Handles.Space',
-- 'OpenXR.Core10.Enums.StructureType.StructureType', 'SwapchainSubImage'
data CompositionLayerProjection = CompositionLayerProjection
  { -- | @layerFlags@ is a bitmask of
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrCompositionLayerFlagBits XrCompositionLayerFlagBits>
    -- describing flags to apply to the layer.
    CompositionLayerProjection -> CompositionLayerFlags
layerFlags :: CompositionLayerFlags
  , -- | @space@ is the 'OpenXR.Core10.Handles.Space' in which the @pose@ of each
    -- 'CompositionLayerProjectionView' is evaluated over time by the
    -- compositor.
    CompositionLayerProjection -> Ptr Space_T
space :: Ptr Space_T
  , -- | @views@ is the array of type 'CompositionLayerProjectionView' containing
    -- each projection layer view.
    CompositionLayerProjection
-> Vector (SomeStruct CompositionLayerProjectionView)
views :: Vector (SomeStruct CompositionLayerProjectionView)
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CompositionLayerProjection)
#endif
deriving instance Show CompositionLayerProjection

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

instance ToCStruct CompositionLayerProjection where
  withCStruct :: CompositionLayerProjection
-> (Ptr CompositionLayerProjection -> IO b) -> IO b
withCStruct x :: CompositionLayerProjection
x f :: Ptr CompositionLayerProjection -> IO b
f = Int -> Int -> (Ptr CompositionLayerProjection -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 48 8 ((Ptr CompositionLayerProjection -> IO b) -> IO b)
-> (Ptr CompositionLayerProjection -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr CompositionLayerProjection
p -> Ptr CompositionLayerProjection
-> CompositionLayerProjection -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr CompositionLayerProjection
p CompositionLayerProjection
x (Ptr CompositionLayerProjection -> IO b
f Ptr CompositionLayerProjection
p)
  pokeCStruct :: Ptr CompositionLayerProjection
-> CompositionLayerProjection -> IO b -> IO b
pokeCStruct p :: Ptr CompositionLayerProjection
p CompositionLayerProjection{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerProjection
p Ptr CompositionLayerProjection -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_COMPOSITION_LAYER_PROJECTION)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerProjection
p Ptr CompositionLayerProjection -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CompositionLayerFlags -> CompositionLayerFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerProjection
p Ptr CompositionLayerProjection -> Int -> Ptr CompositionLayerFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr CompositionLayerFlags)) (CompositionLayerFlags
layerFlags)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr Space_T) -> Ptr Space_T -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerProjection
p Ptr CompositionLayerProjection -> Int -> Ptr (Ptr Space_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr Space_T))) (Ptr Space_T
space)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerProjection
p Ptr CompositionLayerProjection -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector (SomeStruct CompositionLayerProjectionView) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (SomeStruct CompositionLayerProjectionView) -> Int)
-> Vector (SomeStruct CompositionLayerProjectionView) -> Int
forall a b. (a -> b) -> a -> b
$ (Vector (SomeStruct CompositionLayerProjectionView)
views)) :: Word32))
    Ptr (CompositionLayerProjectionView Any)
pViews' <- ((Ptr (CompositionLayerProjectionView Any) -> IO b) -> IO b)
-> ContT b IO (Ptr (CompositionLayerProjectionView Any))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (CompositionLayerProjectionView Any) -> IO b) -> IO b)
 -> ContT b IO (Ptr (CompositionLayerProjectionView Any)))
-> ((Ptr (CompositionLayerProjectionView Any) -> IO b) -> IO b)
-> ContT b IO (Ptr (CompositionLayerProjectionView Any))
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> (Ptr (CompositionLayerProjectionView Any) -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @(CompositionLayerProjectionView _) ((Vector (SomeStruct CompositionLayerProjectionView) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (SomeStruct CompositionLayerProjectionView)
views)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 96) 8
    (Int -> SomeStruct CompositionLayerProjectionView -> ContT b IO ())
-> Vector (SomeStruct CompositionLayerProjectionView)
-> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: SomeStruct CompositionLayerProjectionView
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (SomeStruct CompositionLayerProjectionView)
-> SomeStruct CompositionLayerProjectionView -> IO b -> IO b
forall (a :: [*] -> *) b.
(forall (es :: [*]).
 (Extendss a es, PokeChain es) =>
 ToCStruct (a es)) =>
Ptr (SomeStruct a) -> SomeStruct a -> IO b -> IO b
pokeSomeCStruct (Ptr (CompositionLayerProjectionView Any)
-> Ptr (SomeStruct CompositionLayerProjectionView)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (CompositionLayerProjectionView Any)
pViews' Ptr (CompositionLayerProjectionView Any)
-> Int -> Ptr (CompositionLayerProjectionView _)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (96 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (CompositionLayerProjectionView _))) (SomeStruct CompositionLayerProjectionView
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector (SomeStruct CompositionLayerProjectionView)
views)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr (CompositionLayerProjectionView Any))
-> Ptr (CompositionLayerProjectionView Any) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerProjection
p Ptr CompositionLayerProjection
-> Int -> Ptr (Ptr (CompositionLayerProjectionView _))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr (Ptr (CompositionLayerProjectionView _)))) (Ptr (CompositionLayerProjectionView Any)
pViews')
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = 48
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr CompositionLayerProjection -> IO b -> IO b
pokeZeroCStruct p :: Ptr CompositionLayerProjection
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerProjection
p Ptr CompositionLayerProjection -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_COMPOSITION_LAYER_PROJECTION)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerProjection
p Ptr CompositionLayerProjection -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr Space_T) -> Ptr Space_T -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerProjection
p Ptr CompositionLayerProjection -> 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 (CompositionLayerProjectionView Any)
pViews' <- ((Ptr (CompositionLayerProjectionView Any) -> IO b) -> IO b)
-> ContT b IO (Ptr (CompositionLayerProjectionView Any))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (CompositionLayerProjectionView Any) -> IO b) -> IO b)
 -> ContT b IO (Ptr (CompositionLayerProjectionView Any)))
-> ((Ptr (CompositionLayerProjectionView Any) -> IO b) -> IO b)
-> ContT b IO (Ptr (CompositionLayerProjectionView Any))
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> (Ptr (CompositionLayerProjectionView Any) -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @(CompositionLayerProjectionView _) ((Vector Any -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Any
forall a. Monoid a => a
mempty)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 96) 8
    (Int -> SomeStruct CompositionLayerProjectionView -> ContT b IO ())
-> Vector (SomeStruct CompositionLayerProjectionView)
-> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: SomeStruct CompositionLayerProjectionView
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (SomeStruct CompositionLayerProjectionView)
-> SomeStruct CompositionLayerProjectionView -> IO b -> IO b
forall (a :: [*] -> *) b.
(forall (es :: [*]).
 (Extendss a es, PokeChain es) =>
 ToCStruct (a es)) =>
Ptr (SomeStruct a) -> SomeStruct a -> IO b -> IO b
pokeSomeCStruct (Ptr (CompositionLayerProjectionView Any)
-> Ptr (SomeStruct CompositionLayerProjectionView)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (CompositionLayerProjectionView Any)
pViews' Ptr (CompositionLayerProjectionView Any)
-> Int -> Ptr (CompositionLayerProjectionView _)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (96 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (CompositionLayerProjectionView _))) (SomeStruct CompositionLayerProjectionView
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector (SomeStruct CompositionLayerProjectionView)
forall a. Monoid a => a
mempty)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr (CompositionLayerProjectionView Any))
-> Ptr (CompositionLayerProjectionView Any) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerProjection
p Ptr CompositionLayerProjection
-> Int -> Ptr (Ptr (CompositionLayerProjectionView _))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr (Ptr (CompositionLayerProjectionView _)))) (Ptr (CompositionLayerProjectionView Any)
pViews')
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f

instance FromCStruct CompositionLayerProjection where
  peekCStruct :: Ptr CompositionLayerProjection -> IO CompositionLayerProjection
peekCStruct p :: Ptr CompositionLayerProjection
p = do
    CompositionLayerFlags
layerFlags <- Ptr CompositionLayerFlags -> IO CompositionLayerFlags
forall a. Storable a => Ptr a -> IO a
peek @CompositionLayerFlags ((Ptr CompositionLayerProjection
p Ptr CompositionLayerProjection -> 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 CompositionLayerProjection
p Ptr CompositionLayerProjection -> Int -> Ptr (Ptr Space_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr Space_T)))
    Word32
viewCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr CompositionLayerProjection
p Ptr CompositionLayerProjection -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Word32))
    Ptr (CompositionLayerProjectionView Any)
views <- Ptr (Ptr (CompositionLayerProjectionView Any))
-> IO (Ptr (CompositionLayerProjectionView Any))
forall a. Storable a => Ptr a -> IO a
peek @(Ptr (CompositionLayerProjectionView _)) ((Ptr CompositionLayerProjection
p Ptr CompositionLayerProjection
-> Int -> Ptr (Ptr (CompositionLayerProjectionView _))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr (Ptr (CompositionLayerProjectionView _))))
    Vector (SomeStruct CompositionLayerProjectionView)
views' <- Int
-> (Int -> IO (SomeStruct CompositionLayerProjectionView))
-> IO (Vector (SomeStruct CompositionLayerProjectionView))
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
viewCount) (\i :: Int
i -> Ptr (SomeStruct CompositionLayerProjectionView)
-> IO (SomeStruct CompositionLayerProjectionView)
forall (a :: [*] -> *).
(Extensible a,
 forall (es :: [*]).
 (Extendss a es, PeekChain es) =>
 FromCStruct (a es)) =>
Ptr (SomeStruct a) -> IO (SomeStruct a)
peekSomeCStruct (Ptr (CompositionLayerProjectionView Any)
-> Ptr (SomeStruct CompositionLayerProjectionView)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions ((Ptr (CompositionLayerProjectionView Any)
views Ptr (CompositionLayerProjectionView Any)
-> Int -> Ptr (CompositionLayerProjectionView Any)
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (96 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (CompositionLayerProjectionView _)))))
    CompositionLayerProjection -> IO CompositionLayerProjection
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompositionLayerProjection -> IO CompositionLayerProjection)
-> CompositionLayerProjection -> IO CompositionLayerProjection
forall a b. (a -> b) -> a -> b
$ CompositionLayerFlags
-> Ptr Space_T
-> Vector (SomeStruct CompositionLayerProjectionView)
-> CompositionLayerProjection
CompositionLayerProjection
             CompositionLayerFlags
layerFlags Ptr Space_T
space Vector (SomeStruct CompositionLayerProjectionView)
views'

instance Zero CompositionLayerProjection where
  zero :: CompositionLayerProjection
zero = CompositionLayerFlags
-> Ptr Space_T
-> Vector (SomeStruct CompositionLayerProjectionView)
-> CompositionLayerProjection
CompositionLayerProjection
           CompositionLayerFlags
forall a. Zero a => a
zero
           Ptr Space_T
forall a. Zero a => a
zero
           Vector (SomeStruct CompositionLayerProjectionView)
forall a. Monoid a => a
mempty


-- | XrCompositionLayerQuad - Quad composition layer
--
-- == Member Descriptions
--
-- = Description
--
-- The 'CompositionLayerQuad' layer is useful for user interface elements
-- or 2D content rendered into the virtual world. The layer’s
-- 'SwapchainSubImage'::swapchain image is applied to a quad in the virtual
-- world space. Only front face of the quad surface is visible; the back
-- face is not visible and /must/ not be drawn by the runtime. A quad layer
-- has no thickness; it is a two-dimensional object positioned and oriented
-- in 3D space. The position of a quad refers to the center of the quad
-- within the given 'OpenXR.Core10.Handles.Space'. The orientation of the
-- quad refers to the orientation of the normal vector from the front face.
-- The size of a quad refers to the quad’s size in the x-y plane of the
-- given 'OpenXR.Core10.Handles.Space'’s coordinate system. A quad with a
-- position of {0,0,0}, rotation of {0,0,0,1} (no rotation), and a size of
-- {1,1} refers to a 1 meter x 1 meter quad centered at {0,0,0} with its
-- front face normal vector coinciding with the +z axis.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'CompositionLayerBaseHeader',
-- 'OpenXR.Core10.Enums.CompositionLayerFlags.CompositionLayerFlags',
-- 'OpenXR.Core10.FundamentalTypes.Extent2Df',
-- 'OpenXR.Core10.Enums.EyeVisibility.EyeVisibility',
-- 'OpenXR.Core10.Space.Posef', 'OpenXR.Core10.Handles.Space',
-- 'OpenXR.Core10.Enums.StructureType.StructureType', 'SwapchainSubImage'
data CompositionLayerQuad = CompositionLayerQuad
  { -- | @layerFlags@ is a bitmask of
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrCompositionLayerFlagBits XrCompositionLayerFlagBits>
    -- describing flags to apply to the layer.
    --
    -- #VUID-XrCompositionLayerQuad-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
    CompositionLayerQuad -> CompositionLayerFlags
layerFlags :: CompositionLayerFlags
  , -- | @space@ is the 'OpenXR.Core10.Handles.Space' in which the @pose@ of the
    -- quad layer is evaluated over time.
    --
    -- #VUID-XrCompositionLayerQuad-space-parameter# @space@ /must/ be a valid
    -- 'OpenXR.Core10.Handles.Space' handle
    CompositionLayerQuad -> Ptr Space_T
space :: Ptr Space_T
  , -- | @eyeVisibility@ is the 'OpenXR.Core10.Enums.EyeVisibility.EyeVisibility'
    -- for this layer.
    --
    -- #VUID-XrCompositionLayerQuad-eyeVisibility-parameter# @eyeVisibility@
    -- /must/ be a valid 'OpenXR.Core10.Enums.EyeVisibility.EyeVisibility'
    -- value
    CompositionLayerQuad -> EyeVisibility
eyeVisibility :: EyeVisibility
  , -- | @subImage@ is the image layer 'SwapchainSubImage' to use.
    --
    -- #VUID-XrCompositionLayerQuad-subImage-parameter# @subImage@ /must/ be a
    -- valid 'SwapchainSubImage' structure
    CompositionLayerQuad -> SwapchainSubImage
subImage :: SwapchainSubImage
  , -- | @pose@ is an 'OpenXR.Core10.Space.Posef' defining the position and
    -- orientation of the quad in the reference frame of the @space@.
    CompositionLayerQuad -> Posef
pose :: Posef
  , -- | @size@ is the width and height of the quad in meters.
    CompositionLayerQuad -> Extent2Df
size :: Extent2Df
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CompositionLayerQuad)
#endif
deriving instance Show CompositionLayerQuad

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

instance ToCStruct CompositionLayerQuad where
  withCStruct :: CompositionLayerQuad -> (Ptr CompositionLayerQuad -> IO b) -> IO b
withCStruct x :: CompositionLayerQuad
x f :: Ptr CompositionLayerQuad -> IO b
f = Int -> Int -> (Ptr CompositionLayerQuad -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 112 8 ((Ptr CompositionLayerQuad -> IO b) -> IO b)
-> (Ptr CompositionLayerQuad -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr CompositionLayerQuad
p -> Ptr CompositionLayerQuad -> CompositionLayerQuad -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr CompositionLayerQuad
p CompositionLayerQuad
x (Ptr CompositionLayerQuad -> IO b
f Ptr CompositionLayerQuad
p)
  pokeCStruct :: Ptr CompositionLayerQuad -> CompositionLayerQuad -> IO b -> IO b
pokeCStruct p :: Ptr CompositionLayerQuad
p CompositionLayerQuad{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerQuad
p Ptr CompositionLayerQuad -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_COMPOSITION_LAYER_QUAD)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerQuad
p Ptr CompositionLayerQuad -> 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 CompositionLayerQuad
p Ptr CompositionLayerQuad -> 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 CompositionLayerQuad
p Ptr CompositionLayerQuad -> 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 CompositionLayerQuad
p Ptr CompositionLayerQuad -> 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 CompositionLayerQuad
p Ptr CompositionLayerQuad -> 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 CompositionLayerQuad
p Ptr CompositionLayerQuad -> Int -> Ptr Posef
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 72 :: Ptr Posef)) (Posef
pose)
    Ptr Extent2Df -> Extent2Df -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerQuad
p Ptr CompositionLayerQuad -> Int -> Ptr Extent2Df
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 100 :: Ptr Extent2Df)) (Extent2Df
size)
    IO b
f
  cStructSize :: Int
cStructSize = 112
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr CompositionLayerQuad -> IO b -> IO b
pokeZeroCStruct p :: Ptr CompositionLayerQuad
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerQuad
p Ptr CompositionLayerQuad -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_COMPOSITION_LAYER_QUAD)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerQuad
p Ptr CompositionLayerQuad -> 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 CompositionLayerQuad
p Ptr CompositionLayerQuad -> 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 CompositionLayerQuad
p Ptr CompositionLayerQuad -> 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 CompositionLayerQuad
p Ptr CompositionLayerQuad -> 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 CompositionLayerQuad
p Ptr CompositionLayerQuad -> Int -> Ptr Posef
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 72 :: Ptr Posef)) (Posef
forall a. Zero a => a
zero)
    Ptr Extent2Df -> Extent2Df -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerQuad
p Ptr CompositionLayerQuad -> Int -> Ptr Extent2Df
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 100 :: Ptr Extent2Df)) (Extent2Df
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct CompositionLayerQuad where
  peekCStruct :: Ptr CompositionLayerQuad -> IO CompositionLayerQuad
peekCStruct p :: Ptr CompositionLayerQuad
p = do
    CompositionLayerFlags
layerFlags <- Ptr CompositionLayerFlags -> IO CompositionLayerFlags
forall a. Storable a => Ptr a -> IO a
peek @CompositionLayerFlags ((Ptr CompositionLayerQuad
p Ptr CompositionLayerQuad -> 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 CompositionLayerQuad
p Ptr CompositionLayerQuad -> 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 CompositionLayerQuad
p Ptr CompositionLayerQuad -> 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 CompositionLayerQuad
p Ptr CompositionLayerQuad -> 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 CompositionLayerQuad
p Ptr CompositionLayerQuad -> Int -> Ptr Posef
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 72 :: Ptr Posef))
    Extent2Df
size <- Ptr Extent2Df -> IO Extent2Df
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent2Df ((Ptr CompositionLayerQuad
p Ptr CompositionLayerQuad -> Int -> Ptr Extent2Df
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 100 :: Ptr Extent2Df))
    CompositionLayerQuad -> IO CompositionLayerQuad
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompositionLayerQuad -> IO CompositionLayerQuad)
-> CompositionLayerQuad -> IO CompositionLayerQuad
forall a b. (a -> b) -> a -> b
$ CompositionLayerFlags
-> Ptr Space_T
-> EyeVisibility
-> SwapchainSubImage
-> Posef
-> Extent2Df
-> CompositionLayerQuad
CompositionLayerQuad
             CompositionLayerFlags
layerFlags Ptr Space_T
space EyeVisibility
eyeVisibility SwapchainSubImage
subImage Posef
pose Extent2Df
size

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

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


-- | XrHapticVibration - Base header for haptic feedback
--
-- == Member Descriptions
--
-- = Description
--
-- The 'HapticVibration' is used in calls to
-- 'OpenXR.Core10.Haptics.applyHapticFeedback' that trigger @vibration@
-- output actions.
--
-- The @duration@, and @frequency@ parameters /may/ be clamped to
-- implementation-dependent ranges.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrDuration >,
-- 'OpenXR.Core10.Haptics.HapticBaseHeader',
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'OpenXR.Core10.Haptics.applyHapticFeedback'
data HapticVibration = HapticVibration
  { -- | @duration@ is the number of nanoseconds the vibration /should/ last. If
    -- 'OpenXR.Core10.APIConstants.MIN_HAPTIC_DURATION' is specified, the
    -- runtime /must/ produce a short haptics pulse of minimal supported
    -- duration for the haptic device.
    HapticVibration -> Duration
duration :: Duration
  , -- | @frequency@ is the frequency of the vibration in Hz. If
    -- 'OpenXR.Core10.APIConstants.FREQUENCY_UNSPECIFIED' is specified, it is
    -- left to the runtime to decide the optimal frequency value to use.
    HapticVibration -> Float
frequency :: Float
  , -- | @amplitude@ is the amplitude of the vibration between 0.0 and 1.0.
    HapticVibration -> Float
amplitude :: Float
  }
  deriving (Typeable, HapticVibration -> HapticVibration -> Bool
(HapticVibration -> HapticVibration -> Bool)
-> (HapticVibration -> HapticVibration -> Bool)
-> Eq HapticVibration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HapticVibration -> HapticVibration -> Bool
$c/= :: HapticVibration -> HapticVibration -> Bool
== :: HapticVibration -> HapticVibration -> Bool
$c== :: HapticVibration -> HapticVibration -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (HapticVibration)
#endif
deriving instance Show HapticVibration

instance IsHaptic HapticVibration where
  toHapticBaseHeader :: HapticVibration -> HapticBaseHeader
toHapticBaseHeader HapticVibration{} = $WHapticBaseHeader :: StructureType -> HapticBaseHeader
HapticBaseHeader{$sel:type':HapticBaseHeader :: StructureType
type' = StructureType
TYPE_HAPTIC_VIBRATION}

instance ToCStruct HapticVibration where
  withCStruct :: HapticVibration -> (Ptr HapticVibration -> IO b) -> IO b
withCStruct x :: HapticVibration
x f :: Ptr HapticVibration -> IO b
f = Int -> Int -> (Ptr HapticVibration -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((Ptr HapticVibration -> IO b) -> IO b)
-> (Ptr HapticVibration -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr HapticVibration
p -> Ptr HapticVibration -> HapticVibration -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr HapticVibration
p HapticVibration
x (Ptr HapticVibration -> IO b
f Ptr HapticVibration
p)
  pokeCStruct :: Ptr HapticVibration -> HapticVibration -> IO b -> IO b
pokeCStruct p :: Ptr HapticVibration
p HapticVibration{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr HapticVibration
p Ptr HapticVibration -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_HAPTIC_VIBRATION)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr HapticVibration
p Ptr HapticVibration -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Duration -> Duration -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr HapticVibration
p Ptr HapticVibration -> Int -> Ptr Duration
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Duration)) (Duration
duration)
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr HapticVibration
p Ptr HapticVibration -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
frequency))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr HapticVibration
p Ptr HapticVibration -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 28 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
amplitude))
    IO b
f
  cStructSize :: Int
cStructSize = 32
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr HapticVibration -> IO b -> IO b
pokeZeroCStruct p :: Ptr HapticVibration
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr HapticVibration
p Ptr HapticVibration -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_HAPTIC_VIBRATION)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr HapticVibration
p Ptr HapticVibration -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Duration -> Duration -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr HapticVibration
p Ptr HapticVibration -> Int -> Ptr Duration
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Duration)) (Duration
forall a. Zero a => a
zero)
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr HapticVibration
p Ptr HapticVibration -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 28 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct HapticVibration where
  peekCStruct :: Ptr HapticVibration -> IO HapticVibration
peekCStruct p :: Ptr HapticVibration
p = do
    Duration
duration <- Ptr Duration -> IO Duration
forall a. Storable a => Ptr a -> IO a
peek @Duration ((Ptr HapticVibration
p Ptr HapticVibration -> Int -> Ptr Duration
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Duration))
    CFloat
frequency <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr HapticVibration
p Ptr HapticVibration -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr CFloat))
    CFloat
amplitude <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr HapticVibration
p Ptr HapticVibration -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 28 :: Ptr CFloat))
    HapticVibration -> IO HapticVibration
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HapticVibration -> IO HapticVibration)
-> HapticVibration -> IO HapticVibration
forall a b. (a -> b) -> a -> b
$ Duration -> Float -> Float -> HapticVibration
HapticVibration
             Duration
duration (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
frequency) (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
amplitude)

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

instance Zero HapticVibration where
  zero :: HapticVibration
zero = Duration -> Float -> Float -> HapticVibration
HapticVibration
           Duration
forall a. Zero a => a
zero
           Float
forall a. Zero a => a
zero
           Float
forall a. Zero a => a
zero


-- | XrEventDataBaseHeader - Base header for an event
--
-- == Parameter Descriptions
--
-- = Description
--
-- The 'EventDataBaseHeader' is a generic structure used to identify the
-- common event data elements.
--
-- Upon receipt, the 'EventDataBaseHeader' pointer should be type-cast to a
-- pointer of the appropriate event data based on the @type@ parameter.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'OpenXR.Core10.Instance.pollEvent'
data EventDataBaseHeader = EventDataBaseHeader
  { -- | @type@ is the 'OpenXR.Core10.Enums.StructureType.StructureType' of this
    -- structure. This base structure itself has no associated
    -- 'OpenXR.Core10.Enums.StructureType.StructureType' value.
    --
    -- #VUID-XrEventDataBaseHeader-type-type# @type@ /must/ be one of the
    -- following XrStructureType values:
    -- 'OpenXR.Core10.Enums.StructureType.TYPE_EVENT_DATA_DISPLAY_REFRESH_RATE_CHANGED_FB',
    -- 'OpenXR.Core10.Enums.StructureType.TYPE_EVENT_DATA_EVENTS_LOST',
    -- 'OpenXR.Core10.Enums.StructureType.TYPE_EVENT_DATA_INSTANCE_LOSS_PENDING',
    -- 'OpenXR.Core10.Enums.StructureType.TYPE_EVENT_DATA_INTERACTION_PROFILE_CHANGED',
    -- 'OpenXR.Core10.Enums.StructureType.TYPE_EVENT_DATA_MAIN_SESSION_VISIBILITY_CHANGED_EXTX',
    -- 'OpenXR.Core10.Enums.StructureType.TYPE_EVENT_DATA_PERF_SETTINGS_EXT',
    -- 'OpenXR.Core10.Enums.StructureType.TYPE_EVENT_DATA_REFERENCE_SPACE_CHANGE_PENDING',
    -- 'OpenXR.Core10.Enums.StructureType.TYPE_EVENT_DATA_SESSION_STATE_CHANGED',
    -- 'OpenXR.Core10.Enums.StructureType.TYPE_EVENT_DATA_VISIBILITY_MASK_CHANGED_KHR'
    EventDataBaseHeader -> StructureType
type' :: StructureType }
  deriving (Typeable, EventDataBaseHeader -> EventDataBaseHeader -> Bool
(EventDataBaseHeader -> EventDataBaseHeader -> Bool)
-> (EventDataBaseHeader -> EventDataBaseHeader -> Bool)
-> Eq EventDataBaseHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventDataBaseHeader -> EventDataBaseHeader -> Bool
$c/= :: EventDataBaseHeader -> EventDataBaseHeader -> Bool
== :: EventDataBaseHeader -> EventDataBaseHeader -> Bool
$c== :: EventDataBaseHeader -> EventDataBaseHeader -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (EventDataBaseHeader)
#endif
deriving instance Show EventDataBaseHeader

class ToCStruct a => IsEventData a where
  toEventDataBaseHeader :: a -> EventDataBaseHeader

instance Inheritable EventDataBaseHeader where
  peekSomeCChild :: Ptr (SomeChild EventDataBaseHeader) -> IO (SomeChild EventDataBaseHeader)
  peekSomeCChild :: Ptr (SomeChild EventDataBaseHeader)
-> IO (SomeChild EventDataBaseHeader)
peekSomeCChild p :: Ptr (SomeChild EventDataBaseHeader)
p = do
    StructureType
ty <- Ptr StructureType -> IO StructureType
forall a. Storable a => Ptr a -> IO a
peek @StructureType (Ptr (SomeChild EventDataBaseHeader) -> Ptr StructureType
forall a b. Ptr a -> Ptr b
castPtr @(SomeChild EventDataBaseHeader) @StructureType Ptr (SomeChild EventDataBaseHeader)
p)
    case StructureType
ty of
      TYPE_EVENT_DATA_DISPLAY_REFRESH_RATE_CHANGED_FB -> EventDataDisplayRefreshRateChangedFB
-> SomeChild EventDataBaseHeader
forall a b.
(Inherits a b, Typeable b, ToCStruct b, Show b) =>
b -> SomeChild a
SomeChild (EventDataDisplayRefreshRateChangedFB
 -> SomeChild EventDataBaseHeader)
-> IO EventDataDisplayRefreshRateChangedFB
-> IO (SomeChild EventDataBaseHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr EventDataDisplayRefreshRateChangedFB
-> IO EventDataDisplayRefreshRateChangedFB
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct (Ptr (SomeChild EventDataBaseHeader)
-> Ptr EventDataDisplayRefreshRateChangedFB
forall a b. Ptr a -> Ptr b
castPtr @(SomeChild EventDataBaseHeader) @EventDataDisplayRefreshRateChangedFB Ptr (SomeChild EventDataBaseHeader)
p)
      TYPE_EVENT_DATA_MAIN_SESSION_VISIBILITY_CHANGED_EXTX -> EventDataMainSessionVisibilityChangedEXTX
-> SomeChild EventDataBaseHeader
forall a b.
(Inherits a b, Typeable b, ToCStruct b, Show b) =>
b -> SomeChild a
SomeChild (EventDataMainSessionVisibilityChangedEXTX
 -> SomeChild EventDataBaseHeader)
-> IO EventDataMainSessionVisibilityChangedEXTX
-> IO (SomeChild EventDataBaseHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr EventDataMainSessionVisibilityChangedEXTX
-> IO EventDataMainSessionVisibilityChangedEXTX
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct (Ptr (SomeChild EventDataBaseHeader)
-> Ptr EventDataMainSessionVisibilityChangedEXTX
forall a b. Ptr a -> Ptr b
castPtr @(SomeChild EventDataBaseHeader) @EventDataMainSessionVisibilityChangedEXTX Ptr (SomeChild EventDataBaseHeader)
p)
      TYPE_EVENT_DATA_INTERACTION_PROFILE_CHANGED -> EventDataInteractionProfileChanged -> SomeChild EventDataBaseHeader
forall a b.
(Inherits a b, Typeable b, ToCStruct b, Show b) =>
b -> SomeChild a
SomeChild (EventDataInteractionProfileChanged
 -> SomeChild EventDataBaseHeader)
-> IO EventDataInteractionProfileChanged
-> IO (SomeChild EventDataBaseHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr EventDataInteractionProfileChanged
-> IO EventDataInteractionProfileChanged
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct (Ptr (SomeChild EventDataBaseHeader)
-> Ptr EventDataInteractionProfileChanged
forall a b. Ptr a -> Ptr b
castPtr @(SomeChild EventDataBaseHeader) @EventDataInteractionProfileChanged Ptr (SomeChild EventDataBaseHeader)
p)
      TYPE_EVENT_DATA_VISIBILITY_MASK_CHANGED_KHR -> EventDataVisibilityMaskChangedKHR -> SomeChild EventDataBaseHeader
forall a b.
(Inherits a b, Typeable b, ToCStruct b, Show b) =>
b -> SomeChild a
SomeChild (EventDataVisibilityMaskChangedKHR
 -> SomeChild EventDataBaseHeader)
-> IO EventDataVisibilityMaskChangedKHR
-> IO (SomeChild EventDataBaseHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr EventDataVisibilityMaskChangedKHR
-> IO EventDataVisibilityMaskChangedKHR
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct (Ptr (SomeChild EventDataBaseHeader)
-> Ptr EventDataVisibilityMaskChangedKHR
forall a b. Ptr a -> Ptr b
castPtr @(SomeChild EventDataBaseHeader) @EventDataVisibilityMaskChangedKHR Ptr (SomeChild EventDataBaseHeader)
p)
      TYPE_EVENT_DATA_PERF_SETTINGS_EXT -> EventDataPerfSettingsEXT -> SomeChild EventDataBaseHeader
forall a b.
(Inherits a b, Typeable b, ToCStruct b, Show b) =>
b -> SomeChild a
SomeChild (EventDataPerfSettingsEXT -> SomeChild EventDataBaseHeader)
-> IO EventDataPerfSettingsEXT
-> IO (SomeChild EventDataBaseHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr EventDataPerfSettingsEXT -> IO EventDataPerfSettingsEXT
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct (Ptr (SomeChild EventDataBaseHeader) -> Ptr EventDataPerfSettingsEXT
forall a b. Ptr a -> Ptr b
castPtr @(SomeChild EventDataBaseHeader) @EventDataPerfSettingsEXT Ptr (SomeChild EventDataBaseHeader)
p)
      TYPE_EVENT_DATA_REFERENCE_SPACE_CHANGE_PENDING -> EventDataReferenceSpaceChangePending
-> SomeChild EventDataBaseHeader
forall a b.
(Inherits a b, Typeable b, ToCStruct b, Show b) =>
b -> SomeChild a
SomeChild (EventDataReferenceSpaceChangePending
 -> SomeChild EventDataBaseHeader)
-> IO EventDataReferenceSpaceChangePending
-> IO (SomeChild EventDataBaseHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr EventDataReferenceSpaceChangePending
-> IO EventDataReferenceSpaceChangePending
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct (Ptr (SomeChild EventDataBaseHeader)
-> Ptr EventDataReferenceSpaceChangePending
forall a b. Ptr a -> Ptr b
castPtr @(SomeChild EventDataBaseHeader) @EventDataReferenceSpaceChangePending Ptr (SomeChild EventDataBaseHeader)
p)
      TYPE_EVENT_DATA_SESSION_STATE_CHANGED -> EventDataSessionStateChanged -> SomeChild EventDataBaseHeader
forall a b.
(Inherits a b, Typeable b, ToCStruct b, Show b) =>
b -> SomeChild a
SomeChild (EventDataSessionStateChanged -> SomeChild EventDataBaseHeader)
-> IO EventDataSessionStateChanged
-> IO (SomeChild EventDataBaseHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr EventDataSessionStateChanged -> IO EventDataSessionStateChanged
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct (Ptr (SomeChild EventDataBaseHeader)
-> Ptr EventDataSessionStateChanged
forall a b. Ptr a -> Ptr b
castPtr @(SomeChild EventDataBaseHeader) @EventDataSessionStateChanged Ptr (SomeChild EventDataBaseHeader)
p)
      TYPE_EVENT_DATA_INSTANCE_LOSS_PENDING -> EventDataInstanceLossPending -> SomeChild EventDataBaseHeader
forall a b.
(Inherits a b, Typeable b, ToCStruct b, Show b) =>
b -> SomeChild a
SomeChild (EventDataInstanceLossPending -> SomeChild EventDataBaseHeader)
-> IO EventDataInstanceLossPending
-> IO (SomeChild EventDataBaseHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr EventDataInstanceLossPending -> IO EventDataInstanceLossPending
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct (Ptr (SomeChild EventDataBaseHeader)
-> Ptr EventDataInstanceLossPending
forall a b. Ptr a -> Ptr b
castPtr @(SomeChild EventDataBaseHeader) @EventDataInstanceLossPending Ptr (SomeChild EventDataBaseHeader)
p)
      TYPE_EVENT_DATA_EVENTS_LOST -> EventDataEventsLost -> SomeChild EventDataBaseHeader
forall a b.
(Inherits a b, Typeable b, ToCStruct b, Show b) =>
b -> SomeChild a
SomeChild (EventDataEventsLost -> SomeChild EventDataBaseHeader)
-> IO EventDataEventsLost -> IO (SomeChild EventDataBaseHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr EventDataEventsLost -> IO EventDataEventsLost
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct (Ptr (SomeChild EventDataBaseHeader) -> Ptr EventDataEventsLost
forall a b. Ptr a -> Ptr b
castPtr @(SomeChild EventDataBaseHeader) @EventDataEventsLost Ptr (SomeChild EventDataBaseHeader)
p)
      c :: StructureType
c -> IOException -> IO (SomeChild EventDataBaseHeader)
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO (SomeChild EventDataBaseHeader))
-> IOException -> IO (SomeChild EventDataBaseHeader)
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
          "peekSomeCChild"
          ("Illegal struct inheritance of EventDataBaseHeader with " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> StructureType -> String
forall a. Show a => a -> String
show StructureType
c)
          Maybe CInt
forall a. Maybe a
Nothing
          Maybe String
forall a. Maybe a
Nothing

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

instance FromCStruct EventDataBaseHeader where
  peekCStruct :: Ptr EventDataBaseHeader -> IO EventDataBaseHeader
peekCStruct p :: Ptr EventDataBaseHeader
p = do
    StructureType
type' <- Ptr StructureType -> IO StructureType
forall a. Storable a => Ptr a -> IO a
peek @StructureType ((Ptr EventDataBaseHeader
p Ptr EventDataBaseHeader -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType))
    EventDataBaseHeader -> IO EventDataBaseHeader
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EventDataBaseHeader -> IO EventDataBaseHeader)
-> EventDataBaseHeader -> IO EventDataBaseHeader
forall a b. (a -> b) -> a -> b
$ StructureType -> EventDataBaseHeader
EventDataBaseHeader
             StructureType
type'

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

instance Zero EventDataBaseHeader where
  zero :: EventDataBaseHeader
zero = StructureType -> EventDataBaseHeader
EventDataBaseHeader
           StructureType
forall a. Zero a => a
zero


-- | XrEventDataEventsLost - Event indicating events were lost
--
-- == Member Descriptions
--
-- = Description
--
-- Receiving the 'EventDataEventsLost' event structure indicates that the
-- event queue overflowed and some events were removed at the position
-- within the queue at which this event was found.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'EventDataBaseHeader',
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'OpenXR.Core10.Instance.pollEvent'
data EventDataEventsLost = EventDataEventsLost
  { -- | @lostEventCount@ is the number of events which have overflowed since the
    -- last call to 'OpenXR.Core10.Instance.pollEvent'.
    EventDataEventsLost -> Word32
lostEventCount :: Word32 }
  deriving (Typeable, EventDataEventsLost -> EventDataEventsLost -> Bool
(EventDataEventsLost -> EventDataEventsLost -> Bool)
-> (EventDataEventsLost -> EventDataEventsLost -> Bool)
-> Eq EventDataEventsLost
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventDataEventsLost -> EventDataEventsLost -> Bool
$c/= :: EventDataEventsLost -> EventDataEventsLost -> Bool
== :: EventDataEventsLost -> EventDataEventsLost -> Bool
$c== :: EventDataEventsLost -> EventDataEventsLost -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (EventDataEventsLost)
#endif
deriving instance Show EventDataEventsLost

instance IsEventData EventDataEventsLost where
  toEventDataBaseHeader :: EventDataEventsLost -> EventDataBaseHeader
toEventDataBaseHeader EventDataEventsLost{} = $WEventDataBaseHeader :: StructureType -> EventDataBaseHeader
EventDataBaseHeader{$sel:type':EventDataBaseHeader :: StructureType
type' = StructureType
TYPE_EVENT_DATA_EVENTS_LOST}

instance ToCStruct EventDataEventsLost where
  withCStruct :: EventDataEventsLost -> (Ptr EventDataEventsLost -> IO b) -> IO b
withCStruct x :: EventDataEventsLost
x f :: Ptr EventDataEventsLost -> IO b
f = Int -> Int -> (Ptr EventDataEventsLost -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 24 8 ((Ptr EventDataEventsLost -> IO b) -> IO b)
-> (Ptr EventDataEventsLost -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr EventDataEventsLost
p -> Ptr EventDataEventsLost -> EventDataEventsLost -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr EventDataEventsLost
p EventDataEventsLost
x (Ptr EventDataEventsLost -> IO b
f Ptr EventDataEventsLost
p)
  pokeCStruct :: Ptr EventDataEventsLost -> EventDataEventsLost -> IO b -> IO b
pokeCStruct p :: Ptr EventDataEventsLost
p EventDataEventsLost{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr EventDataEventsLost
p Ptr EventDataEventsLost -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_EVENT_DATA_EVENTS_LOST)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr EventDataEventsLost
p Ptr EventDataEventsLost -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr EventDataEventsLost
p Ptr EventDataEventsLost -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32)) (Word32
lostEventCount)
    IO b
f
  cStructSize :: Int
cStructSize = 24
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr EventDataEventsLost -> IO b -> IO b
pokeZeroCStruct p :: Ptr EventDataEventsLost
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr EventDataEventsLost
p Ptr EventDataEventsLost -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_EVENT_DATA_EVENTS_LOST)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr EventDataEventsLost
p Ptr EventDataEventsLost -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr EventDataEventsLost
p Ptr EventDataEventsLost -> 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 EventDataEventsLost where
  peekCStruct :: Ptr EventDataEventsLost -> IO EventDataEventsLost
peekCStruct p :: Ptr EventDataEventsLost
p = do
    Word32
lostEventCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr EventDataEventsLost
p Ptr EventDataEventsLost -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32))
    EventDataEventsLost -> IO EventDataEventsLost
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EventDataEventsLost -> IO EventDataEventsLost)
-> EventDataEventsLost -> IO EventDataEventsLost
forall a b. (a -> b) -> a -> b
$ Word32 -> EventDataEventsLost
EventDataEventsLost
             Word32
lostEventCount

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

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


-- | XrEventDataInstanceLossPending - Event indicating instance loss will
-- occur
--
-- = Members
--
-- Receiving the 'EventDataInstanceLossPending' event structure indicates
-- that the application is about to lose the indicated
-- 'OpenXR.Core10.Handles.Instance' at the indicated @lossTime@ in the
-- future. The application should call
-- 'OpenXR.Core10.Instance.destroyInstance' and relinquish any
-- instance-specific resources. This typically occurs to make way for a
-- replacement of the underlying runtime, such as via a software update.
--
-- = Description
--
-- After the application has destroyed all of its instances and their
-- children and waited past the specified time, it may then re-try
-- 'OpenXR.Core10.Instance.createInstance' in a loop waiting for whatever
-- maintenance the runtime is performing to complete. The runtime will
-- return 'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST' from
-- 'OpenXR.Core10.Instance.createInstance' as long as it is unable to
-- create the instance. Once the runtime has returned and is able to
-- continue, it /must/ resume returning
-- 'OpenXR.Core10.Enums.Result.SUCCESS' from
-- 'OpenXR.Core10.Instance.createInstance' if valid data is passed in.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'EventDataBaseHeader',
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >,
-- 'OpenXR.Core10.Instance.pollEvent'
data EventDataInstanceLossPending = EventDataInstanceLossPending
  { -- | @lossTime@ is the absolute time at which the indicated instance will be
    -- considered lost and become unusable.
    EventDataInstanceLossPending -> Duration
lossTime :: Time }
  deriving (Typeable, EventDataInstanceLossPending
-> EventDataInstanceLossPending -> Bool
(EventDataInstanceLossPending
 -> EventDataInstanceLossPending -> Bool)
-> (EventDataInstanceLossPending
    -> EventDataInstanceLossPending -> Bool)
-> Eq EventDataInstanceLossPending
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventDataInstanceLossPending
-> EventDataInstanceLossPending -> Bool
$c/= :: EventDataInstanceLossPending
-> EventDataInstanceLossPending -> Bool
== :: EventDataInstanceLossPending
-> EventDataInstanceLossPending -> Bool
$c== :: EventDataInstanceLossPending
-> EventDataInstanceLossPending -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (EventDataInstanceLossPending)
#endif
deriving instance Show EventDataInstanceLossPending

instance IsEventData EventDataInstanceLossPending where
  toEventDataBaseHeader :: EventDataInstanceLossPending -> EventDataBaseHeader
toEventDataBaseHeader EventDataInstanceLossPending{} = $WEventDataBaseHeader :: StructureType -> EventDataBaseHeader
EventDataBaseHeader{$sel:type':EventDataBaseHeader :: StructureType
type' = StructureType
TYPE_EVENT_DATA_INSTANCE_LOSS_PENDING}

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

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

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

instance Zero EventDataInstanceLossPending where
  zero :: EventDataInstanceLossPending
zero = Duration -> EventDataInstanceLossPending
EventDataInstanceLossPending
           Duration
forall a. Zero a => a
zero


-- | XrEventDataSessionStateChanged - Event indicating session state changed
--
-- == Member Descriptions
--
-- = Description
--
-- Receiving the 'EventDataSessionStateChanged' event structure indicates
-- that the application has changed lifecycle state.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'EventDataBaseHeader', 'OpenXR.Core10.Handles.Session',
-- 'OpenXR.Core10.Enums.SessionState.SessionState',
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >,
-- 'OpenXR.Core10.Instance.pollEvent'
data EventDataSessionStateChanged = EventDataSessionStateChanged
  { -- | @session@ is the 'OpenXR.Core10.Handles.Session' which has changed
    -- state.
    --
    -- #VUID-XrEventDataSessionStateChanged-session-parameter# @session@ /must/
    -- be a valid 'OpenXR.Core10.Handles.Session' handle
    EventDataSessionStateChanged -> Ptr Session_T
session :: Ptr Session_T
  , -- | @state@ is the current 'OpenXR.Core10.Enums.SessionState.SessionState'
    -- of the @session@.
    --
    -- #VUID-XrEventDataSessionStateChanged-state-parameter# @state@ /must/ be
    -- a valid 'OpenXR.Core10.Enums.SessionState.SessionState' value
    EventDataSessionStateChanged -> SessionState
state :: SessionState
  , -- | @time@ is an
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >
    -- which indicates the time of the state change.
    EventDataSessionStateChanged -> Duration
time :: Time
  }
  deriving (Typeable, EventDataSessionStateChanged
-> EventDataSessionStateChanged -> Bool
(EventDataSessionStateChanged
 -> EventDataSessionStateChanged -> Bool)
-> (EventDataSessionStateChanged
    -> EventDataSessionStateChanged -> Bool)
-> Eq EventDataSessionStateChanged
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventDataSessionStateChanged
-> EventDataSessionStateChanged -> Bool
$c/= :: EventDataSessionStateChanged
-> EventDataSessionStateChanged -> Bool
== :: EventDataSessionStateChanged
-> EventDataSessionStateChanged -> Bool
$c== :: EventDataSessionStateChanged
-> EventDataSessionStateChanged -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (EventDataSessionStateChanged)
#endif
deriving instance Show EventDataSessionStateChanged

instance IsEventData EventDataSessionStateChanged where
  toEventDataBaseHeader :: EventDataSessionStateChanged -> EventDataBaseHeader
toEventDataBaseHeader EventDataSessionStateChanged{} = $WEventDataBaseHeader :: StructureType -> EventDataBaseHeader
EventDataBaseHeader{$sel:type':EventDataBaseHeader :: StructureType
type' = StructureType
TYPE_EVENT_DATA_SESSION_STATE_CHANGED}

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

instance FromCStruct EventDataSessionStateChanged where
  peekCStruct :: Ptr EventDataSessionStateChanged -> IO EventDataSessionStateChanged
peekCStruct p :: Ptr EventDataSessionStateChanged
p = do
    Ptr Session_T
session <- Ptr (Ptr Session_T) -> IO (Ptr Session_T)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Session_T) ((Ptr EventDataSessionStateChanged
p Ptr EventDataSessionStateChanged -> Int -> Ptr (Ptr Session_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr (Ptr Session_T)))
    SessionState
state <- Ptr SessionState -> IO SessionState
forall a. Storable a => Ptr a -> IO a
peek @SessionState ((Ptr EventDataSessionStateChanged
p Ptr EventDataSessionStateChanged -> Int -> Ptr SessionState
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr SessionState))
    Duration
time <- Ptr Duration -> IO Duration
forall a. Storable a => Ptr a -> IO a
peek @Time ((Ptr EventDataSessionStateChanged
p Ptr EventDataSessionStateChanged -> Int -> Ptr Duration
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Time))
    EventDataSessionStateChanged -> IO EventDataSessionStateChanged
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EventDataSessionStateChanged -> IO EventDataSessionStateChanged)
-> EventDataSessionStateChanged -> IO EventDataSessionStateChanged
forall a b. (a -> b) -> a -> b
$ Ptr Session_T
-> SessionState -> Duration -> EventDataSessionStateChanged
EventDataSessionStateChanged
             Ptr Session_T
session SessionState
state Duration
time

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

instance Zero EventDataSessionStateChanged where
  zero :: EventDataSessionStateChanged
zero = Ptr Session_T
-> SessionState -> Duration -> EventDataSessionStateChanged
EventDataSessionStateChanged
           Ptr Session_T
forall a. Zero a => a
zero
           SessionState
forall a. Zero a => a
zero
           Duration
forall a. Zero a => a
zero


-- | XrEventDataReferenceSpaceChangePending - Notifies the application that a
-- reference space is changing
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'OpenXR.Core10.Enums.ReferenceSpaceType.REFERENCE_SPACE_TYPE_STAGE',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrBool32 >,
-- 'OpenXR.Core10.Space.Posef',
-- 'OpenXR.Core10.Enums.ReferenceSpaceType.ReferenceSpaceType',
-- 'OpenXR.Core10.Handles.Session',
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >,
-- 'OpenXR.Core10.Space.createReferenceSpace'
data EventDataReferenceSpaceChangePending = EventDataReferenceSpaceChangePending
  { -- | @session@ is the 'OpenXR.Core10.Handles.Session' for which the reference
    -- space is changing.
    --
    -- #VUID-XrEventDataReferenceSpaceChangePending-session-parameter#
    -- @session@ /must/ be a valid 'OpenXR.Core10.Handles.Session' handle
    EventDataReferenceSpaceChangePending -> Ptr Session_T
session :: Ptr Session_T
  , -- | @referenceSpaceType@ is the
    -- 'OpenXR.Core10.Enums.ReferenceSpaceType.ReferenceSpaceType' that is
    -- changing.
    --
    -- #VUID-XrEventDataReferenceSpaceChangePending-referenceSpaceType-parameter#
    -- @referenceSpaceType@ /must/ be a valid
    -- 'OpenXR.Core10.Enums.ReferenceSpaceType.ReferenceSpaceType' value
    EventDataReferenceSpaceChangePending -> ReferenceSpaceType
referenceSpaceType :: ReferenceSpaceType
  , -- | @changeTime@ is the target
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >
    -- after which 'OpenXR.Core10.Space.locateSpace' or
    -- 'OpenXR.Core10.DisplayTiming.locateViews' will return values that
    -- respect this change.
    EventDataReferenceSpaceChangePending -> Duration
changeTime :: Time
  , -- | @poseValid@ is true if the runtime can determine the @pose@ of the new
    -- space in the previous space before the change.
    EventDataReferenceSpaceChangePending -> Bool
poseValid :: Bool
  , -- | @poseInPreviousSpace@ is an 'OpenXR.Core10.Space.Posef' defining the
    -- position and orientation of the new reference space’s natural origin
    -- within the natural reference frame of its previous space.
    EventDataReferenceSpaceChangePending -> Posef
poseInPreviousSpace :: Posef
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (EventDataReferenceSpaceChangePending)
#endif
deriving instance Show EventDataReferenceSpaceChangePending

instance IsEventData EventDataReferenceSpaceChangePending where
  toEventDataBaseHeader :: EventDataReferenceSpaceChangePending -> EventDataBaseHeader
toEventDataBaseHeader EventDataReferenceSpaceChangePending{} = $WEventDataBaseHeader :: StructureType -> EventDataBaseHeader
EventDataBaseHeader{$sel:type':EventDataBaseHeader :: StructureType
type' = StructureType
TYPE_EVENT_DATA_REFERENCE_SPACE_CHANGE_PENDING}

instance ToCStruct EventDataReferenceSpaceChangePending where
  withCStruct :: EventDataReferenceSpaceChangePending
-> (Ptr EventDataReferenceSpaceChangePending -> IO b) -> IO b
withCStruct x :: EventDataReferenceSpaceChangePending
x f :: Ptr EventDataReferenceSpaceChangePending -> IO b
f = Int
-> Int
-> (Ptr EventDataReferenceSpaceChangePending -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 72 8 ((Ptr EventDataReferenceSpaceChangePending -> IO b) -> IO b)
-> (Ptr EventDataReferenceSpaceChangePending -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr EventDataReferenceSpaceChangePending
p -> Ptr EventDataReferenceSpaceChangePending
-> EventDataReferenceSpaceChangePending -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr EventDataReferenceSpaceChangePending
p EventDataReferenceSpaceChangePending
x (Ptr EventDataReferenceSpaceChangePending -> IO b
f Ptr EventDataReferenceSpaceChangePending
p)
  pokeCStruct :: Ptr EventDataReferenceSpaceChangePending
-> EventDataReferenceSpaceChangePending -> IO b -> IO b
pokeCStruct p :: Ptr EventDataReferenceSpaceChangePending
p EventDataReferenceSpaceChangePending{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr EventDataReferenceSpaceChangePending
p Ptr EventDataReferenceSpaceChangePending
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_EVENT_DATA_REFERENCE_SPACE_CHANGE_PENDING)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr EventDataReferenceSpaceChangePending
p Ptr EventDataReferenceSpaceChangePending -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr (Ptr Session_T) -> Ptr Session_T -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr EventDataReferenceSpaceChangePending
p Ptr EventDataReferenceSpaceChangePending
-> Int -> Ptr (Ptr Session_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr (Ptr Session_T))) (Ptr Session_T
session)
    Ptr ReferenceSpaceType -> ReferenceSpaceType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr EventDataReferenceSpaceChangePending
p Ptr EventDataReferenceSpaceChangePending
-> Int -> Ptr ReferenceSpaceType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr ReferenceSpaceType)) (ReferenceSpaceType
referenceSpaceType)
    Ptr Duration -> Duration -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr EventDataReferenceSpaceChangePending
p Ptr EventDataReferenceSpaceChangePending -> Int -> Ptr Duration
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Time)) (Duration
changeTime)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr EventDataReferenceSpaceChangePending
p Ptr EventDataReferenceSpaceChangePending -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
poseValid))
    Ptr Posef -> Posef -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr EventDataReferenceSpaceChangePending
p Ptr EventDataReferenceSpaceChangePending -> Int -> Ptr Posef
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 44 :: Ptr Posef)) (Posef
poseInPreviousSpace)
    IO b
f
  cStructSize :: Int
cStructSize = 72
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr EventDataReferenceSpaceChangePending -> IO b -> IO b
pokeZeroCStruct p :: Ptr EventDataReferenceSpaceChangePending
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr EventDataReferenceSpaceChangePending
p Ptr EventDataReferenceSpaceChangePending
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_EVENT_DATA_REFERENCE_SPACE_CHANGE_PENDING)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr EventDataReferenceSpaceChangePending
p Ptr EventDataReferenceSpaceChangePending -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr (Ptr Session_T) -> Ptr Session_T -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr EventDataReferenceSpaceChangePending
p Ptr EventDataReferenceSpaceChangePending
-> Int -> Ptr (Ptr Session_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr (Ptr Session_T))) (Ptr Session_T
forall a. Zero a => a
zero)
    Ptr ReferenceSpaceType -> ReferenceSpaceType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr EventDataReferenceSpaceChangePending
p Ptr EventDataReferenceSpaceChangePending
-> Int -> Ptr ReferenceSpaceType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr ReferenceSpaceType)) (ReferenceSpaceType
forall a. Zero a => a
zero)
    Ptr Duration -> Duration -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr EventDataReferenceSpaceChangePending
p Ptr EventDataReferenceSpaceChangePending -> Int -> Ptr Duration
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Time)) (Duration
forall a. Zero a => a
zero)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr EventDataReferenceSpaceChangePending
p Ptr EventDataReferenceSpaceChangePending -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Posef -> Posef -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr EventDataReferenceSpaceChangePending
p Ptr EventDataReferenceSpaceChangePending -> Int -> Ptr Posef
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 44 :: Ptr Posef)) (Posef
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct EventDataReferenceSpaceChangePending where
  peekCStruct :: Ptr EventDataReferenceSpaceChangePending
-> IO EventDataReferenceSpaceChangePending
peekCStruct p :: Ptr EventDataReferenceSpaceChangePending
p = do
    Ptr Session_T
session <- Ptr (Ptr Session_T) -> IO (Ptr Session_T)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Session_T) ((Ptr EventDataReferenceSpaceChangePending
p Ptr EventDataReferenceSpaceChangePending
-> Int -> Ptr (Ptr Session_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr (Ptr Session_T)))
    ReferenceSpaceType
referenceSpaceType <- Ptr ReferenceSpaceType -> IO ReferenceSpaceType
forall a. Storable a => Ptr a -> IO a
peek @ReferenceSpaceType ((Ptr EventDataReferenceSpaceChangePending
p Ptr EventDataReferenceSpaceChangePending
-> Int -> Ptr ReferenceSpaceType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr ReferenceSpaceType))
    Duration
changeTime <- Ptr Duration -> IO Duration
forall a. Storable a => Ptr a -> IO a
peek @Time ((Ptr EventDataReferenceSpaceChangePending
p Ptr EventDataReferenceSpaceChangePending -> Int -> Ptr Duration
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Time))
    Bool32
poseValid <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr EventDataReferenceSpaceChangePending
p Ptr EventDataReferenceSpaceChangePending -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr Bool32))
    Posef
poseInPreviousSpace <- Ptr Posef -> IO Posef
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Posef ((Ptr EventDataReferenceSpaceChangePending
p Ptr EventDataReferenceSpaceChangePending -> Int -> Ptr Posef
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 44 :: Ptr Posef))
    EventDataReferenceSpaceChangePending
-> IO EventDataReferenceSpaceChangePending
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EventDataReferenceSpaceChangePending
 -> IO EventDataReferenceSpaceChangePending)
-> EventDataReferenceSpaceChangePending
-> IO EventDataReferenceSpaceChangePending
forall a b. (a -> b) -> a -> b
$ Ptr Session_T
-> ReferenceSpaceType
-> Duration
-> Bool
-> Posef
-> EventDataReferenceSpaceChangePending
EventDataReferenceSpaceChangePending
             Ptr Session_T
session ReferenceSpaceType
referenceSpaceType Duration
changeTime (Bool32 -> Bool
bool32ToBool Bool32
poseValid) Posef
poseInPreviousSpace

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

instance Zero EventDataReferenceSpaceChangePending where
  zero :: EventDataReferenceSpaceChangePending
zero = Ptr Session_T
-> ReferenceSpaceType
-> Duration
-> Bool
-> Posef
-> EventDataReferenceSpaceChangePending
EventDataReferenceSpaceChangePending
           Ptr Session_T
forall a. Zero a => a
zero
           ReferenceSpaceType
forall a. Zero a => a
zero
           Duration
forall a. Zero a => a
zero
           Bool
forall a. Zero a => a
zero
           Posef
forall a. Zero a => a
zero


-- | XrEventDataInteractionProfileChanged - Notifies the application than the
-- active interaction profile has changed
--
-- == Member Descriptions
--
-- = Description
--
-- The 'EventDataInteractionProfileChanged' event is sent to the
-- application to notify it that the active input form factor for one or
-- more top level user paths has changed. This event /must/ only be sent
-- for interaction profiles that the application indicated its support for
-- via 'OpenXR.Core10.Input.suggestInteractionProfileBindings'. This event
-- /must/ only be sent for running sessions.
--
-- The application /can/ call
-- 'OpenXR.Core10.Input.getCurrentInteractionProfile' if it wants to change
-- its own behavior based on the active hardware.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Session',
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'OpenXR.Core10.Input.getCurrentInteractionProfile',
-- 'OpenXR.Core10.Input.suggestInteractionProfileBindings'
data EventDataInteractionProfileChanged = EventDataInteractionProfileChanged
  { -- | @session@ is the 'OpenXR.Core10.Handles.Session' for which at least one
    -- of the interaction profiles for a top level path has changed.
    --
    -- #VUID-XrEventDataInteractionProfileChanged-session-parameter# @session@
    -- /must/ be a valid 'OpenXR.Core10.Handles.Session' handle
    EventDataInteractionProfileChanged -> Ptr Session_T
session :: Ptr Session_T }
  deriving (Typeable, EventDataInteractionProfileChanged
-> EventDataInteractionProfileChanged -> Bool
(EventDataInteractionProfileChanged
 -> EventDataInteractionProfileChanged -> Bool)
-> (EventDataInteractionProfileChanged
    -> EventDataInteractionProfileChanged -> Bool)
-> Eq EventDataInteractionProfileChanged
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventDataInteractionProfileChanged
-> EventDataInteractionProfileChanged -> Bool
$c/= :: EventDataInteractionProfileChanged
-> EventDataInteractionProfileChanged -> Bool
== :: EventDataInteractionProfileChanged
-> EventDataInteractionProfileChanged -> Bool
$c== :: EventDataInteractionProfileChanged
-> EventDataInteractionProfileChanged -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (EventDataInteractionProfileChanged)
#endif
deriving instance Show EventDataInteractionProfileChanged

instance IsEventData EventDataInteractionProfileChanged where
  toEventDataBaseHeader :: EventDataInteractionProfileChanged -> EventDataBaseHeader
toEventDataBaseHeader EventDataInteractionProfileChanged{} = $WEventDataBaseHeader :: StructureType -> EventDataBaseHeader
EventDataBaseHeader{$sel:type':EventDataBaseHeader :: StructureType
type' = StructureType
TYPE_EVENT_DATA_INTERACTION_PROFILE_CHANGED}

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

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

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

instance Zero EventDataInteractionProfileChanged where
  zero :: EventDataInteractionProfileChanged
zero = Ptr Session_T -> EventDataInteractionProfileChanged
EventDataInteractionProfileChanged
           Ptr Session_T
forall a. Zero a => a
zero