{-# language CPP #-}
-- | = Name
--
-- XR_KHR_composition_layer_cube - instance extension
--
-- = Specification
--
-- See
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_KHR_composition_layer_cube  XR_KHR_composition_layer_cube>
-- in the main specification for complete information.
--
-- = Registered Extension Number
--
-- 7
--
-- = Revision
--
-- 8
--
-- = Extension and Version Dependencies
--
-- -   Requires OpenXR 1.0
--
-- = See Also
--
-- 'CompositionLayerCubeKHR'
--
-- = Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_KHR_composition_layer_cube OpenXR Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module OpenXR.Extensions.XR_KHR_composition_layer_cube  ( CompositionLayerCubeKHR(..)
                                                        , KHR_composition_layer_cube_SPEC_VERSION
                                                        , pattern KHR_composition_layer_cube_SPEC_VERSION
                                                        , KHR_COMPOSITION_LAYER_CUBE_EXTENSION_NAME
                                                        , pattern KHR_COMPOSITION_LAYER_CUBE_EXTENSION_NAME
                                                        ) where

import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import OpenXR.CStruct (FromCStruct)
import OpenXR.CStruct (FromCStruct(..))
import OpenXR.CStruct (ToCStruct)
import OpenXR.CStruct (ToCStruct(..))
import OpenXR.Zero (Zero(..))
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Kind (Type)
import OpenXR.Core10.OtherTypes (CompositionLayerBaseHeader(..))
import OpenXR.Core10.Enums.CompositionLayerFlags (CompositionLayerFlags)
import OpenXR.Core10.Enums.EyeVisibility (EyeVisibility)
import OpenXR.Core10.OtherTypes (IsCompositionLayer(..))
import OpenXR.Core10.Space (Quaternionf)
import OpenXR.Core10.Handles (Space_T)
import OpenXR.Core10.Enums.StructureType (StructureType)
import OpenXR.Core10.Handles (Swapchain_T)
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_COMPOSITION_LAYER_CUBE_KHR))
-- | XrCompositionLayerCubeKHR - Cube map layer composition info
--
-- == Member Descriptions
--
-- = Description
--
-- 'CompositionLayerCubeKHR' contains the information needed to render a
-- cube map when calling 'OpenXR.Core10.DisplayTiming.endFrame'.
-- 'CompositionLayerCubeKHR' is an alias type for the base struct
-- 'OpenXR.Core10.OtherTypes.CompositionLayerBaseHeader' used in
-- 'OpenXR.Core10.DisplayTiming.FrameEndInfo'.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrCompositionLayerCubeKHR-extension-notenabled# The @@
--     extension /must/ be enabled prior to using 'CompositionLayerCubeKHR'
--
-- -   #VUID-XrCompositionLayerCubeKHR-type-type# @type@ /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_COMPOSITION_LAYER_CUBE_KHR'
--
-- -   #VUID-XrCompositionLayerCubeKHR-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-XrCompositionLayerCubeKHR-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-XrCompositionLayerCubeKHR-space-parameter# @space@ /must/ be a
--     valid 'OpenXR.Core10.Handles.Space' handle
--
-- -   #VUID-XrCompositionLayerCubeKHR-eyeVisibility-parameter#
--     @eyeVisibility@ /must/ be a valid
--     'OpenXR.Core10.Enums.EyeVisibility.EyeVisibility' value
--
-- -   #VUID-XrCompositionLayerCubeKHR-swapchain-parameter# @swapchain@
--     /must/ be a valid 'OpenXR.Core10.Handles.Swapchain' handle
--
-- -   #VUID-XrCompositionLayerCubeKHR-commonparent# Both of @space@ and
--     @swapchain@ /must/ have been created, allocated, or retrieved from
--     the same 'OpenXR.Core10.Handles.Session'
--
-- = See Also
--
-- 'OpenXR.Core10.OtherTypes.CompositionLayerBaseHeader',
-- 'OpenXR.Core10.Enums.CompositionLayerFlags.CompositionLayerFlags',
-- 'OpenXR.Core10.Enums.EyeVisibility.EyeVisibility',
-- 'OpenXR.Core10.DisplayTiming.FrameEndInfo',
-- 'OpenXR.Core10.Space.Quaternionf', 'OpenXR.Core10.Handles.Space',
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'OpenXR.Core10.Handles.Swapchain',
-- 'OpenXR.Core10.DisplayTiming.endFrame'
data CompositionLayerCubeKHR = CompositionLayerCubeKHR
  { -- | @layerFlags@ is any flags to apply to this layer.
    CompositionLayerCubeKHR -> CompositionLayerFlags
layerFlags :: CompositionLayerFlags
  , -- | @space@ is the 'OpenXR.Core10.Handles.Space' in which the @orientation@
    -- of the cube layer is evaluated over time.
    CompositionLayerCubeKHR -> Ptr Space_T
space :: Ptr Space_T
  , -- No documentation found for Nested "XrCompositionLayerCubeKHR" "eyeVisibility"
    CompositionLayerCubeKHR -> EyeVisibility
eyeVisibility :: EyeVisibility
  , -- | @swapchain@ is the swapchain.
    CompositionLayerCubeKHR -> Ptr Swapchain_T
swapchain :: Ptr Swapchain_T
  , -- | @imageArrayIndex@ is the image array index, with 0 meaning the first or
    -- only array element.
    CompositionLayerCubeKHR -> Word32
imageArrayIndex :: Word32
  , -- | @orientation@ is the orientation of the environment map in the @space@.
    CompositionLayerCubeKHR -> Quaternionf
orientation :: Quaternionf
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CompositionLayerCubeKHR)
#endif
deriving instance Show CompositionLayerCubeKHR

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

instance ToCStruct CompositionLayerCubeKHR where
  withCStruct :: CompositionLayerCubeKHR
-> (Ptr CompositionLayerCubeKHR -> IO b) -> IO b
withCStruct x :: CompositionLayerCubeKHR
x f :: Ptr CompositionLayerCubeKHR -> IO b
f = Int -> Int -> (Ptr CompositionLayerCubeKHR -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 72 8 ((Ptr CompositionLayerCubeKHR -> IO b) -> IO b)
-> (Ptr CompositionLayerCubeKHR -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr CompositionLayerCubeKHR
p -> Ptr CompositionLayerCubeKHR
-> CompositionLayerCubeKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr CompositionLayerCubeKHR
p CompositionLayerCubeKHR
x (Ptr CompositionLayerCubeKHR -> IO b
f Ptr CompositionLayerCubeKHR
p)
  pokeCStruct :: Ptr CompositionLayerCubeKHR
-> CompositionLayerCubeKHR -> IO b -> IO b
pokeCStruct p :: Ptr CompositionLayerCubeKHR
p CompositionLayerCubeKHR{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCubeKHR
p Ptr CompositionLayerCubeKHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_COMPOSITION_LAYER_CUBE_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCubeKHR
p Ptr CompositionLayerCubeKHR -> 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 CompositionLayerCubeKHR
p Ptr CompositionLayerCubeKHR -> 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 CompositionLayerCubeKHR
p Ptr CompositionLayerCubeKHR -> 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 CompositionLayerCubeKHR
p Ptr CompositionLayerCubeKHR -> Int -> Ptr EyeVisibility
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr EyeVisibility)) (EyeVisibility
eyeVisibility)
    Ptr (Ptr Swapchain_T) -> Ptr Swapchain_T -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCubeKHR
p Ptr CompositionLayerCubeKHR -> Int -> Ptr (Ptr Swapchain_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr (Ptr Swapchain_T))) (Ptr Swapchain_T
swapchain)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCubeKHR
p Ptr CompositionLayerCubeKHR -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48 :: Ptr Word32)) (Word32
imageArrayIndex)
    Ptr Quaternionf -> Quaternionf -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCubeKHR
p Ptr CompositionLayerCubeKHR -> Int -> Ptr Quaternionf
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 52 :: Ptr Quaternionf)) (Quaternionf
orientation)
    IO b
f
  cStructSize :: Int
cStructSize = 72
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr CompositionLayerCubeKHR -> IO b -> IO b
pokeZeroCStruct p :: Ptr CompositionLayerCubeKHR
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCubeKHR
p Ptr CompositionLayerCubeKHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_COMPOSITION_LAYER_CUBE_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCubeKHR
p Ptr CompositionLayerCubeKHR -> 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 CompositionLayerCubeKHR
p Ptr CompositionLayerCubeKHR -> 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 CompositionLayerCubeKHR
p Ptr CompositionLayerCubeKHR -> Int -> Ptr EyeVisibility
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr EyeVisibility)) (EyeVisibility
forall a. Zero a => a
zero)
    Ptr (Ptr Swapchain_T) -> Ptr Swapchain_T -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCubeKHR
p Ptr CompositionLayerCubeKHR -> Int -> Ptr (Ptr Swapchain_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr (Ptr Swapchain_T))) (Ptr Swapchain_T
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCubeKHR
p Ptr CompositionLayerCubeKHR -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Quaternionf -> Quaternionf -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerCubeKHR
p Ptr CompositionLayerCubeKHR -> Int -> Ptr Quaternionf
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 52 :: Ptr Quaternionf)) (Quaternionf
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct CompositionLayerCubeKHR where
  peekCStruct :: Ptr CompositionLayerCubeKHR -> IO CompositionLayerCubeKHR
peekCStruct p :: Ptr CompositionLayerCubeKHR
p = do
    CompositionLayerFlags
layerFlags <- Ptr CompositionLayerFlags -> IO CompositionLayerFlags
forall a. Storable a => Ptr a -> IO a
peek @CompositionLayerFlags ((Ptr CompositionLayerCubeKHR
p Ptr CompositionLayerCubeKHR -> 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 CompositionLayerCubeKHR
p Ptr CompositionLayerCubeKHR -> 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 CompositionLayerCubeKHR
p Ptr CompositionLayerCubeKHR -> Int -> Ptr EyeVisibility
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr EyeVisibility))
    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 CompositionLayerCubeKHR
p Ptr CompositionLayerCubeKHR -> Int -> Ptr (Ptr Swapchain_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr (Ptr Swapchain_T)))
    Word32
imageArrayIndex <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr CompositionLayerCubeKHR
p Ptr CompositionLayerCubeKHR -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48 :: Ptr Word32))
    Quaternionf
orientation <- Ptr Quaternionf -> IO Quaternionf
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Quaternionf ((Ptr CompositionLayerCubeKHR
p Ptr CompositionLayerCubeKHR -> Int -> Ptr Quaternionf
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 52 :: Ptr Quaternionf))
    CompositionLayerCubeKHR -> IO CompositionLayerCubeKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompositionLayerCubeKHR -> IO CompositionLayerCubeKHR)
-> CompositionLayerCubeKHR -> IO CompositionLayerCubeKHR
forall a b. (a -> b) -> a -> b
$ CompositionLayerFlags
-> Ptr Space_T
-> EyeVisibility
-> Ptr Swapchain_T
-> Word32
-> Quaternionf
-> CompositionLayerCubeKHR
CompositionLayerCubeKHR
             CompositionLayerFlags
layerFlags Ptr Space_T
space EyeVisibility
eyeVisibility Ptr Swapchain_T
swapchain Word32
imageArrayIndex Quaternionf
orientation

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

instance Zero CompositionLayerCubeKHR where
  zero :: CompositionLayerCubeKHR
zero = CompositionLayerFlags
-> Ptr Space_T
-> EyeVisibility
-> Ptr Swapchain_T
-> Word32
-> Quaternionf
-> CompositionLayerCubeKHR
CompositionLayerCubeKHR
           CompositionLayerFlags
forall a. Zero a => a
zero
           Ptr Space_T
forall a. Zero a => a
zero
           EyeVisibility
forall a. Zero a => a
zero
           Ptr Swapchain_T
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           Quaternionf
forall a. Zero a => a
zero


type KHR_composition_layer_cube_SPEC_VERSION = 8

-- No documentation found for TopLevel "XR_KHR_composition_layer_cube_SPEC_VERSION"
pattern KHR_composition_layer_cube_SPEC_VERSION :: forall a . Integral a => a
pattern $bKHR_composition_layer_cube_SPEC_VERSION :: a
$mKHR_composition_layer_cube_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
KHR_composition_layer_cube_SPEC_VERSION = 8


type KHR_COMPOSITION_LAYER_CUBE_EXTENSION_NAME = "XR_KHR_composition_layer_cube"

-- No documentation found for TopLevel "XR_KHR_COMPOSITION_LAYER_CUBE_EXTENSION_NAME"
pattern KHR_COMPOSITION_LAYER_CUBE_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bKHR_COMPOSITION_LAYER_CUBE_EXTENSION_NAME :: a
$mKHR_COMPOSITION_LAYER_CUBE_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
KHR_COMPOSITION_LAYER_CUBE_EXTENSION_NAME = "XR_KHR_composition_layer_cube"