{-# language CPP #-}
-- | = Name
--
-- XR_EPIC_view_configuration_fov - instance extension
--
-- = Specification
--
-- See
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_EPIC_view_configuration_fov  XR_EPIC_view_configuration_fov>
-- in the main specification for complete information.
--
-- = Registered Extension Number
--
-- 60
--
-- = Revision
--
-- 2
--
-- = Extension and Version Dependencies
--
-- -   Requires OpenXR 1.0
--
-- = See Also
--
-- 'ViewConfigurationViewFovEPIC'
--
-- = Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_EPIC_view_configuration_fov OpenXR Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module OpenXR.Extensions.XR_EPIC_view_configuration_fov  ( ViewConfigurationViewFovEPIC(..)
                                                         , EPIC_view_configuration_fov_SPEC_VERSION
                                                         , pattern EPIC_view_configuration_fov_SPEC_VERSION
                                                         , EPIC_VIEW_CONFIGURATION_FOV_EXTENSION_NAME
                                                         , pattern EPIC_VIEW_CONFIGURATION_FOV_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(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import Foreign.Ptr (Ptr)
import Data.Kind (Type)
import OpenXR.Core10.OtherTypes (Fovf)
import OpenXR.Core10.Enums.StructureType (StructureType)
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_VIEW_CONFIGURATION_VIEW_FOV_EPIC))
-- | XrViewConfigurationViewFovEPIC - View Configuration Field-of-View
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrViewConfigurationViewFovEPIC-extension-notenabled# The @@
--     extension /must/ be enabled prior to using
--     'ViewConfigurationViewFovEPIC'
--
-- -   #VUID-XrViewConfigurationViewFovEPIC-type-type# @type@ /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_VIEW_CONFIGURATION_VIEW_FOV_EPIC'
--
-- -   #VUID-XrViewConfigurationViewFovEPIC-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.OtherTypes.Fovf',
-- 'OpenXR.Core10.Enums.StructureType.StructureType'
data ViewConfigurationViewFovEPIC = ViewConfigurationViewFovEPIC
  { -- | @recommendedFov@ is the recommended field-of-view based on the current
    -- user IPD.
    ViewConfigurationViewFovEPIC -> Fovf
recommendedFov :: Fovf
  , -- | @maxMutableFov@ is the maximum field-of-view that the runtime can
    -- display.
    ViewConfigurationViewFovEPIC -> Fovf
maxMutableFov :: Fovf
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ViewConfigurationViewFovEPIC)
#endif
deriving instance Show ViewConfigurationViewFovEPIC

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

instance FromCStruct ViewConfigurationViewFovEPIC where
  peekCStruct :: Ptr ViewConfigurationViewFovEPIC -> IO ViewConfigurationViewFovEPIC
peekCStruct p :: Ptr ViewConfigurationViewFovEPIC
p = do
    Fovf
recommendedFov <- Ptr Fovf -> IO Fovf
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Fovf ((Ptr ViewConfigurationViewFovEPIC
p Ptr ViewConfigurationViewFovEPIC -> Int -> Ptr Fovf
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Fovf))
    Fovf
maxMutableFov <- Ptr Fovf -> IO Fovf
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Fovf ((Ptr ViewConfigurationViewFovEPIC
p Ptr ViewConfigurationViewFovEPIC -> Int -> Ptr Fovf
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Fovf))
    ViewConfigurationViewFovEPIC -> IO ViewConfigurationViewFovEPIC
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ViewConfigurationViewFovEPIC -> IO ViewConfigurationViewFovEPIC)
-> ViewConfigurationViewFovEPIC -> IO ViewConfigurationViewFovEPIC
forall a b. (a -> b) -> a -> b
$ Fovf -> Fovf -> ViewConfigurationViewFovEPIC
ViewConfigurationViewFovEPIC
             Fovf
recommendedFov Fovf
maxMutableFov

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

instance Zero ViewConfigurationViewFovEPIC where
  zero :: ViewConfigurationViewFovEPIC
zero = Fovf -> Fovf -> ViewConfigurationViewFovEPIC
ViewConfigurationViewFovEPIC
           Fovf
forall a. Zero a => a
zero
           Fovf
forall a. Zero a => a
zero


type EPIC_view_configuration_fov_SPEC_VERSION = 2

-- No documentation found for TopLevel "XR_EPIC_view_configuration_fov_SPEC_VERSION"
pattern EPIC_view_configuration_fov_SPEC_VERSION :: forall a . Integral a => a
pattern $bEPIC_view_configuration_fov_SPEC_VERSION :: a
$mEPIC_view_configuration_fov_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
EPIC_view_configuration_fov_SPEC_VERSION = 2


type EPIC_VIEW_CONFIGURATION_FOV_EXTENSION_NAME = "XR_EPIC_view_configuration_fov"

-- No documentation found for TopLevel "XR_EPIC_VIEW_CONFIGURATION_FOV_EXTENSION_NAME"
pattern EPIC_VIEW_CONFIGURATION_FOV_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEPIC_VIEW_CONFIGURATION_FOV_EXTENSION_NAME :: a
$mEPIC_VIEW_CONFIGURATION_FOV_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
EPIC_VIEW_CONFIGURATION_FOV_EXTENSION_NAME = "XR_EPIC_view_configuration_fov"