{-# language CPP #-}
-- | = Name
--
-- XR_EXT_view_configuration_depth_range - instance extension
--
-- = Specification
--
-- See
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_EXT_view_configuration_depth_range  XR_EXT_view_configuration_depth_range>
-- in the main specification for complete information.
--
-- = Registered Extension Number
--
-- 47
--
-- = Revision
--
-- 1
--
-- = Extension and Version Dependencies
--
-- -   Requires OpenXR 1.0
--
-- = See Also
--
-- 'ViewConfigurationDepthRangeEXT'
--
-- = Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_EXT_view_configuration_depth_range OpenXR Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module OpenXR.Extensions.XR_EXT_view_configuration_depth_range  ( ViewConfigurationDepthRangeEXT(..)
                                                                , EXT_view_configuration_depth_range_SPEC_VERSION
                                                                , pattern EXT_view_configuration_depth_range_SPEC_VERSION
                                                                , EXT_VIEW_CONFIGURATION_DEPTH_RANGE_EXTENSION_NAME
                                                                , pattern EXT_VIEW_CONFIGURATION_DEPTH_RANGE_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.Enums.StructureType (StructureType(TYPE_VIEW_CONFIGURATION_DEPTH_RANGE_EXT))
-- | XrViewConfigurationDepthRangeEXT - View configuration depth range
-- information
--
-- == Member Descriptions
--
-- = Description
--
-- When enumerating the view configurations with
-- 'OpenXR.Core10.ViewConfigurations.enumerateViewConfigurationViews', the
-- application /can/ provide a pointer to an
-- 'ViewConfigurationDepthRangeEXT' in the @next@ chain of
-- 'OpenXR.Core10.ViewConfigurations.ViewConfigurationView'.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrViewConfigurationDepthRangeEXT-extension-notenabled# The @@
--     extension /must/ be enabled prior to using
--     'ViewConfigurationDepthRangeEXT'
--
-- -   #VUID-XrViewConfigurationDepthRangeEXT-type-type# @type@ /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_VIEW_CONFIGURATION_DEPTH_RANGE_EXT'
--
-- -   #VUID-XrViewConfigurationDepthRangeEXT-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.Core10.Enums.StructureType.StructureType',
-- 'OpenXR.Core10.ViewConfigurations.ViewConfigurationView',
-- 'OpenXR.Core10.ViewConfigurations.enumerateViewConfigurationViews'
data ViewConfigurationDepthRangeEXT = ViewConfigurationDepthRangeEXT
  { -- | @recommendedNearZ@ is the recommended minimum positive distance in
    -- meters that content should be rendered for the view to achieve the best
    -- user experience.
    ViewConfigurationDepthRangeEXT -> Float
recommendedNearZ :: Float
  , -- | @minNearZ@ is the absolute minimum positive distance in meters that
    -- content should be rendered for the view.
    ViewConfigurationDepthRangeEXT -> Float
minNearZ :: Float
  , -- | @recommendedFarZ@ is the recommended maximum positive distance in meters
    -- that content should be rendered for the view to achieve the best user
    -- experience.
    ViewConfigurationDepthRangeEXT -> Float
recommendedFarZ :: Float
  , -- | @maxFarZ@ is the absolute maximum positive distance in meters that
    -- content should be rendered for the view.
    ViewConfigurationDepthRangeEXT -> Float
maxFarZ :: Float
  }
  deriving (Typeable, ViewConfigurationDepthRangeEXT
-> ViewConfigurationDepthRangeEXT -> Bool
(ViewConfigurationDepthRangeEXT
 -> ViewConfigurationDepthRangeEXT -> Bool)
-> (ViewConfigurationDepthRangeEXT
    -> ViewConfigurationDepthRangeEXT -> Bool)
-> Eq ViewConfigurationDepthRangeEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ViewConfigurationDepthRangeEXT
-> ViewConfigurationDepthRangeEXT -> Bool
$c/= :: ViewConfigurationDepthRangeEXT
-> ViewConfigurationDepthRangeEXT -> Bool
== :: ViewConfigurationDepthRangeEXT
-> ViewConfigurationDepthRangeEXT -> Bool
$c== :: ViewConfigurationDepthRangeEXT
-> ViewConfigurationDepthRangeEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ViewConfigurationDepthRangeEXT)
#endif
deriving instance Show ViewConfigurationDepthRangeEXT

instance ToCStruct ViewConfigurationDepthRangeEXT where
  withCStruct :: ViewConfigurationDepthRangeEXT
-> (Ptr ViewConfigurationDepthRangeEXT -> IO b) -> IO b
withCStruct x :: ViewConfigurationDepthRangeEXT
x f :: Ptr ViewConfigurationDepthRangeEXT -> IO b
f = Int -> Int -> (Ptr ViewConfigurationDepthRangeEXT -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((Ptr ViewConfigurationDepthRangeEXT -> IO b) -> IO b)
-> (Ptr ViewConfigurationDepthRangeEXT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr ViewConfigurationDepthRangeEXT
p -> Ptr ViewConfigurationDepthRangeEXT
-> ViewConfigurationDepthRangeEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ViewConfigurationDepthRangeEXT
p ViewConfigurationDepthRangeEXT
x (Ptr ViewConfigurationDepthRangeEXT -> IO b
f Ptr ViewConfigurationDepthRangeEXT
p)
  pokeCStruct :: Ptr ViewConfigurationDepthRangeEXT
-> ViewConfigurationDepthRangeEXT -> IO b -> IO b
pokeCStruct p :: Ptr ViewConfigurationDepthRangeEXT
p ViewConfigurationDepthRangeEXT{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ViewConfigurationDepthRangeEXT
p Ptr ViewConfigurationDepthRangeEXT -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_VIEW_CONFIGURATION_DEPTH_RANGE_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ViewConfigurationDepthRangeEXT
p Ptr ViewConfigurationDepthRangeEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ViewConfigurationDepthRangeEXT
p Ptr ViewConfigurationDepthRangeEXT -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
recommendedNearZ))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ViewConfigurationDepthRangeEXT
p Ptr ViewConfigurationDepthRangeEXT -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
minNearZ))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ViewConfigurationDepthRangeEXT
p Ptr ViewConfigurationDepthRangeEXT -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
recommendedFarZ))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ViewConfigurationDepthRangeEXT
p Ptr ViewConfigurationDepthRangeEXT -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 28 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
maxFarZ))
    IO b
f
  cStructSize :: Int
cStructSize = 32
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr ViewConfigurationDepthRangeEXT -> IO b -> IO b
pokeZeroCStruct p :: Ptr ViewConfigurationDepthRangeEXT
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ViewConfigurationDepthRangeEXT
p Ptr ViewConfigurationDepthRangeEXT -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_VIEW_CONFIGURATION_DEPTH_RANGE_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ViewConfigurationDepthRangeEXT
p Ptr ViewConfigurationDepthRangeEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ViewConfigurationDepthRangeEXT
p Ptr ViewConfigurationDepthRangeEXT -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: 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 ViewConfigurationDepthRangeEXT
p Ptr ViewConfigurationDepthRangeEXT -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: 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 ViewConfigurationDepthRangeEXT
p Ptr ViewConfigurationDepthRangeEXT -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: 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 ViewConfigurationDepthRangeEXT
p Ptr ViewConfigurationDepthRangeEXT -> 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 ViewConfigurationDepthRangeEXT where
  peekCStruct :: Ptr ViewConfigurationDepthRangeEXT
-> IO ViewConfigurationDepthRangeEXT
peekCStruct p :: Ptr ViewConfigurationDepthRangeEXT
p = do
    CFloat
recommendedNearZ <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr ViewConfigurationDepthRangeEXT
p Ptr ViewConfigurationDepthRangeEXT -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr CFloat))
    CFloat
minNearZ <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr ViewConfigurationDepthRangeEXT
p Ptr ViewConfigurationDepthRangeEXT -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr CFloat))
    CFloat
recommendedFarZ <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr ViewConfigurationDepthRangeEXT
p Ptr ViewConfigurationDepthRangeEXT -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr CFloat))
    CFloat
maxFarZ <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr ViewConfigurationDepthRangeEXT
p Ptr ViewConfigurationDepthRangeEXT -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 28 :: Ptr CFloat))
    ViewConfigurationDepthRangeEXT -> IO ViewConfigurationDepthRangeEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ViewConfigurationDepthRangeEXT
 -> IO ViewConfigurationDepthRangeEXT)
-> ViewConfigurationDepthRangeEXT
-> IO ViewConfigurationDepthRangeEXT
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Float -> ViewConfigurationDepthRangeEXT
ViewConfigurationDepthRangeEXT
             (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
recommendedNearZ) (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
minNearZ) (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
recommendedFarZ) (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
maxFarZ)

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

instance Zero ViewConfigurationDepthRangeEXT where
  zero :: ViewConfigurationDepthRangeEXT
zero = Float -> Float -> Float -> Float -> ViewConfigurationDepthRangeEXT
ViewConfigurationDepthRangeEXT
           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 EXT_view_configuration_depth_range_SPEC_VERSION = 1

-- No documentation found for TopLevel "XR_EXT_view_configuration_depth_range_SPEC_VERSION"
pattern EXT_view_configuration_depth_range_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_view_configuration_depth_range_SPEC_VERSION :: a
$mEXT_view_configuration_depth_range_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
EXT_view_configuration_depth_range_SPEC_VERSION = 1


type EXT_VIEW_CONFIGURATION_DEPTH_RANGE_EXTENSION_NAME = "XR_EXT_view_configuration_depth_range"

-- No documentation found for TopLevel "XR_EXT_VIEW_CONFIGURATION_DEPTH_RANGE_EXTENSION_NAME"
pattern EXT_VIEW_CONFIGURATION_DEPTH_RANGE_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_VIEW_CONFIGURATION_DEPTH_RANGE_EXTENSION_NAME :: a
$mEXT_VIEW_CONFIGURATION_DEPTH_RANGE_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
EXT_VIEW_CONFIGURATION_DEPTH_RANGE_EXTENSION_NAME = "XR_EXT_view_configuration_depth_range"