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

import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Data.Coerce (coerce)
import OpenXR.CStruct (FromCStruct)
import OpenXR.CStruct (FromCStruct(..))
import OpenXR.CStruct (ToCStruct)
import OpenXR.CStruct (ToCStruct(..))
import OpenXR.Zero (Zero(..))
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.C.Types (CFloat)
import Foreign.C.Types (CFloat(..))
import Foreign.C.Types (CFloat(CFloat))
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import Foreign.Ptr (Ptr)
import Data.Kind (Type)
import OpenXR.Core10.Enums.StructureType (StructureType)
import OpenXR.Core10.OtherTypes (SwapchainSubImage)
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_COMPOSITION_LAYER_DEPTH_INFO_KHR))
-- | XrCompositionLayerDepthInfoKHR - Depth map layer info
--
-- == Member Descriptions
--
-- = Description
--
-- 'CompositionLayerDepthInfoKHR' contains the information needed to
-- specify an extra layer with depth information. When submitting depth
-- buffers along with projection layers, add the
-- 'CompositionLayerDepthInfoKHR' to the @next@ chain for all
-- 'OpenXR.Core10.OtherTypes.CompositionLayerProjectionView' structures in
-- the given layer.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrCompositionLayerDepthInfoKHR-extension-notenabled# The @@
--     extension /must/ be enabled prior to using
--     'CompositionLayerDepthInfoKHR'
--
-- -   #VUID-XrCompositionLayerDepthInfoKHR-type-type# @type@ /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_COMPOSITION_LAYER_DEPTH_INFO_KHR'
--
-- -   #VUID-XrCompositionLayerDepthInfoKHR-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-XrCompositionLayerDepthInfoKHR-subImage-parameter# @subImage@
--     /must/ be a valid 'OpenXR.Core10.OtherTypes.SwapchainSubImage'
--     structure
--
-- = See Also
--
-- 'OpenXR.Core10.OtherTypes.CompositionLayerBaseHeader',
-- 'OpenXR.Core10.OtherTypes.CompositionLayerProjection',
-- 'OpenXR.Core10.OtherTypes.CompositionLayerProjectionView',
-- 'OpenXR.Core10.DisplayTiming.FrameEndInfo',
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'OpenXR.Core10.OtherTypes.SwapchainSubImage',
-- 'OpenXR.Core10.DisplayTiming.endFrame'
data CompositionLayerDepthInfoKHR = CompositionLayerDepthInfoKHR
  { -- | @subImage@ identifies the depth image
    -- 'OpenXR.Core10.OtherTypes.SwapchainSubImage' to be associated with the
    -- color swapchain. The contained @imageRect@ specifies the valid portion
    -- of the depth image to use, in pixels. It also implicitly defines the
    -- transform from normalized image coordinates into pixel coordinates. The
    -- contained @imageArrayIndex@ is the depth image array index, with 0
    -- meaning the first or only array element.
    CompositionLayerDepthInfoKHR -> SwapchainSubImage
subImage :: SwapchainSubImage
  , -- | @minDepth@ and @maxDepth@ are the range of depth values the
    -- @depthSwapchain@ could have, in the range of [0.0,1.0]. This is akin to
    -- min and max values of OpenGL’s @glDepthRange@, but with the requirement
    -- here that maxDepth ≥ minDepth.
    CompositionLayerDepthInfoKHR -> Float
minDepth :: Float
  , -- No documentation found for Nested "XrCompositionLayerDepthInfoKHR" "maxDepth"
    CompositionLayerDepthInfoKHR -> Float
maxDepth :: Float
  , -- | @nearZ@ is the positive distance in meters of the @minDepth@ value in
    -- the depth swapchain. Applications /may/ use a @nearZ@ that is greater
    -- than @farZ@ to indicate depth values are reversed. @nearZ@ can be
    -- infinite.
    CompositionLayerDepthInfoKHR -> Float
nearZ :: Float
  , -- | @farZ@ is the positive distance in meters of the @maxDepth@ value in the
    -- depth swapchain. @farZ@ can be infinite. Applications /must/ not use the
    -- same value as @nearZ@.
    CompositionLayerDepthInfoKHR -> Float
farZ :: Float
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CompositionLayerDepthInfoKHR)
#endif
deriving instance Show CompositionLayerDepthInfoKHR

instance ToCStruct CompositionLayerDepthInfoKHR where
  withCStruct :: CompositionLayerDepthInfoKHR
-> (Ptr CompositionLayerDepthInfoKHR -> IO b) -> IO b
withCStruct x :: CompositionLayerDepthInfoKHR
x f :: Ptr CompositionLayerDepthInfoKHR -> IO b
f = Int -> Int -> (Ptr CompositionLayerDepthInfoKHR -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 64 8 ((Ptr CompositionLayerDepthInfoKHR -> IO b) -> IO b)
-> (Ptr CompositionLayerDepthInfoKHR -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr CompositionLayerDepthInfoKHR
p -> Ptr CompositionLayerDepthInfoKHR
-> CompositionLayerDepthInfoKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr CompositionLayerDepthInfoKHR
p CompositionLayerDepthInfoKHR
x (Ptr CompositionLayerDepthInfoKHR -> IO b
f Ptr CompositionLayerDepthInfoKHR
p)
  pokeCStruct :: Ptr CompositionLayerDepthInfoKHR
-> CompositionLayerDepthInfoKHR -> IO b -> IO b
pokeCStruct p :: Ptr CompositionLayerDepthInfoKHR
p CompositionLayerDepthInfoKHR{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerDepthInfoKHR
p Ptr CompositionLayerDepthInfoKHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_COMPOSITION_LAYER_DEPTH_INFO_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerDepthInfoKHR
p Ptr CompositionLayerDepthInfoKHR -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr SwapchainSubImage -> SwapchainSubImage -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerDepthInfoKHR
p Ptr CompositionLayerDepthInfoKHR -> Int -> Ptr SwapchainSubImage
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr SwapchainSubImage)) (SwapchainSubImage
subImage)
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerDepthInfoKHR
p Ptr CompositionLayerDepthInfoKHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
minDepth))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerDepthInfoKHR
p Ptr CompositionLayerDepthInfoKHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 52 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
maxDepth))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerDepthInfoKHR
p Ptr CompositionLayerDepthInfoKHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 56 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
nearZ))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerDepthInfoKHR
p Ptr CompositionLayerDepthInfoKHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 60 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
farZ))
    IO b
f
  cStructSize :: Int
cStructSize = 64
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr CompositionLayerDepthInfoKHR -> IO b -> IO b
pokeZeroCStruct p :: Ptr CompositionLayerDepthInfoKHR
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerDepthInfoKHR
p Ptr CompositionLayerDepthInfoKHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_COMPOSITION_LAYER_DEPTH_INFO_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerDepthInfoKHR
p Ptr CompositionLayerDepthInfoKHR -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr SwapchainSubImage -> SwapchainSubImage -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerDepthInfoKHR
p Ptr CompositionLayerDepthInfoKHR -> Int -> Ptr SwapchainSubImage
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr SwapchainSubImage)) (SwapchainSubImage
forall a. Zero a => a
zero)
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CompositionLayerDepthInfoKHR
p Ptr CompositionLayerDepthInfoKHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48 :: 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 CompositionLayerDepthInfoKHR
p Ptr CompositionLayerDepthInfoKHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 52 :: 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 CompositionLayerDepthInfoKHR
p Ptr CompositionLayerDepthInfoKHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 56 :: 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 CompositionLayerDepthInfoKHR
p Ptr CompositionLayerDepthInfoKHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 60 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct CompositionLayerDepthInfoKHR where
  peekCStruct :: Ptr CompositionLayerDepthInfoKHR -> IO CompositionLayerDepthInfoKHR
peekCStruct p :: Ptr CompositionLayerDepthInfoKHR
p = do
    SwapchainSubImage
subImage <- Ptr SwapchainSubImage -> IO SwapchainSubImage
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @SwapchainSubImage ((Ptr CompositionLayerDepthInfoKHR
p Ptr CompositionLayerDepthInfoKHR -> Int -> Ptr SwapchainSubImage
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr SwapchainSubImage))
    CFloat
minDepth <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr CompositionLayerDepthInfoKHR
p Ptr CompositionLayerDepthInfoKHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48 :: Ptr CFloat))
    CFloat
maxDepth <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr CompositionLayerDepthInfoKHR
p Ptr CompositionLayerDepthInfoKHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 52 :: Ptr CFloat))
    CFloat
nearZ <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr CompositionLayerDepthInfoKHR
p Ptr CompositionLayerDepthInfoKHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 56 :: Ptr CFloat))
    CFloat
farZ <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr CompositionLayerDepthInfoKHR
p Ptr CompositionLayerDepthInfoKHR -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 60 :: Ptr CFloat))
    CompositionLayerDepthInfoKHR -> IO CompositionLayerDepthInfoKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompositionLayerDepthInfoKHR -> IO CompositionLayerDepthInfoKHR)
-> CompositionLayerDepthInfoKHR -> IO CompositionLayerDepthInfoKHR
forall a b. (a -> b) -> a -> b
$ SwapchainSubImage
-> Float -> Float -> Float -> Float -> CompositionLayerDepthInfoKHR
CompositionLayerDepthInfoKHR
             SwapchainSubImage
subImage (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
minDepth) (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
maxDepth) (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
nearZ) (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
farZ)

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

instance Zero CompositionLayerDepthInfoKHR where
  zero :: CompositionLayerDepthInfoKHR
zero = SwapchainSubImage
-> Float -> Float -> Float -> Float -> CompositionLayerDepthInfoKHR
CompositionLayerDepthInfoKHR
           SwapchainSubImage
forall a. Zero a => a
zero
           Float
forall a. Zero a => a
zero
           Float
forall a. Zero a => a
zero
           Float
forall a. Zero a => a
zero
           Float
forall a. Zero a => a
zero


type KHR_composition_layer_depth_SPEC_VERSION = 5

-- No documentation found for TopLevel "XR_KHR_composition_layer_depth_SPEC_VERSION"
pattern KHR_composition_layer_depth_SPEC_VERSION :: forall a . Integral a => a
pattern $bKHR_composition_layer_depth_SPEC_VERSION :: a
$mKHR_composition_layer_depth_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
KHR_composition_layer_depth_SPEC_VERSION = 5


type KHR_COMPOSITION_LAYER_DEPTH_EXTENSION_NAME = "XR_KHR_composition_layer_depth"

-- No documentation found for TopLevel "XR_KHR_COMPOSITION_LAYER_DEPTH_EXTENSION_NAME"
pattern KHR_COMPOSITION_LAYER_DEPTH_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bKHR_COMPOSITION_LAYER_DEPTH_EXTENSION_NAME :: a
$mKHR_COMPOSITION_LAYER_DEPTH_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
KHR_COMPOSITION_LAYER_DEPTH_EXTENSION_NAME = "XR_KHR_composition_layer_depth"