{-# language CPP #-}
-- No documentation found for Chapter "FundamentalTypes"
module OpenXR.Core10.FundamentalTypes  ( boolToBool32
                                       , bool32ToBool
                                       , Offset2Df(..)
                                       , Extent2Df(..)
                                       , Rect2Df(..)
                                       , Offset2Di(..)
                                       , Extent2Di(..)
                                       , Rect2Di(..)
                                       , Bool32( FALSE
                                               , TRUE
                                               , ..
                                               )
                                       , Flags64
                                       , Time
                                       , Duration
                                       ) where

import OpenXR.Internal.Utils (enumReadPrec)
import OpenXR.Internal.Utils (enumShowsPrec)
import Data.Bool (bool)
import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Ptr (plusPtr)
import GHC.Show (showsPrec)
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 OpenXR.Zero (Zero(..))
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 Data.Int (Int32)
import Data.Int (Int64)
import Foreign.Ptr (Ptr)
import GHC.Read (Read(readPrec))
import GHC.Show (Show(showsPrec))
import Data.Word (Word64)
import Data.Kind (Type)

boolToBool32 :: Bool -> Bool32
boolToBool32 :: Bool -> Bool32
boolToBool32 = Bool32 -> Bool32 -> Bool -> Bool32
forall a. a -> a -> Bool -> a
bool Bool32
FALSE Bool32
TRUE

bool32ToBool :: Bool32 -> Bool
bool32ToBool :: Bool32 -> Bool
bool32ToBool = \case
  FALSE -> Bool
False
  TRUE  -> Bool
True


-- | XrOffset2Df - Float offset in two dimensions
--
-- == Member Descriptions
--
-- = Description
--
-- This structure is used for component values that may be fractional
-- (floating-point). If used to represent physical distances, values /must/
-- be in meters.
--
-- = See Also
--
-- 'Extent2Df', 'Rect2Df'
data Offset2Df = Offset2Df
  { -- | @x@ the floating-point offset in the x direction.
    Offset2Df -> Float
x :: Float
  , -- | @y@ the floating-point offset in the y direction.
    Offset2Df -> Float
y :: Float
  }
  deriving (Typeable, Offset2Df -> Offset2Df -> Bool
(Offset2Df -> Offset2Df -> Bool)
-> (Offset2Df -> Offset2Df -> Bool) -> Eq Offset2Df
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Offset2Df -> Offset2Df -> Bool
$c/= :: Offset2Df -> Offset2Df -> Bool
== :: Offset2Df -> Offset2Df -> Bool
$c== :: Offset2Df -> Offset2Df -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (Offset2Df)
#endif
deriving instance Show Offset2Df

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

instance FromCStruct Offset2Df where
  peekCStruct :: Ptr Offset2Df -> IO Offset2Df
peekCStruct p :: Ptr Offset2Df
p = do
    CFloat
x <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr Offset2Df
p Ptr Offset2Df -> 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 Offset2Df
p Ptr Offset2Df -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr CFloat))
    Offset2Df -> IO Offset2Df
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Offset2Df -> IO Offset2Df) -> Offset2Df -> IO Offset2Df
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Offset2Df
Offset2Df
             (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)

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

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


-- | XrExtent2Df - Extent in two dimensions
--
-- == Member Descriptions
--
-- = Description
--
-- This structure is used for component values that may be fractional
-- (floating-point). If used to represent physical distances, values /must/
-- be in meters.
--
-- The @width@ and @height@ value /must/ be non-negative.
--
-- = See Also
--
-- 'OpenXR.Core10.OtherTypes.CompositionLayerQuad', 'Offset2Df', 'Rect2Df',
-- 'OpenXR.Core10.Space.getReferenceSpaceBoundsRect'
data Extent2Df = Extent2Df
  { -- | @width@ the floating-point width of the extent.
    Extent2Df -> Float
width :: Float
  , -- | @height@ the floating-point height of the extent.
    Extent2Df -> Float
height :: Float
  }
  deriving (Typeable, Extent2Df -> Extent2Df -> Bool
(Extent2Df -> Extent2Df -> Bool)
-> (Extent2Df -> Extent2Df -> Bool) -> Eq Extent2Df
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Extent2Df -> Extent2Df -> Bool
$c/= :: Extent2Df -> Extent2Df -> Bool
== :: Extent2Df -> Extent2Df -> Bool
$c== :: Extent2Df -> Extent2Df -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (Extent2Df)
#endif
deriving instance Show Extent2Df

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

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

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

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


-- | XrRect2Df - Rect in two dimensions
--
-- == Member Descriptions
--
-- = Description
--
-- This structure is used for component values that may be fractional
-- (floating-point).
--
-- = See Also
--
-- 'Extent2Df', 'Offset2Df'
data Rect2Df = Rect2Df
  { -- | @offset@ is the 'Offset2Df' specifying the rectangle offset.
    Rect2Df -> Offset2Df
offset :: Offset2Df
  , -- | @extent@ is the 'Extent2Df' specifying the rectangle extent.
    Rect2Df -> Extent2Df
extent :: Extent2Df
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (Rect2Df)
#endif
deriving instance Show Rect2Df

instance ToCStruct Rect2Df where
  withCStruct :: Rect2Df -> (Ptr Rect2Df -> IO b) -> IO b
withCStruct x :: Rect2Df
x f :: Ptr Rect2Df -> IO b
f = Int -> Int -> (Ptr Rect2Df -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 16 4 ((Ptr Rect2Df -> IO b) -> IO b) -> (Ptr Rect2Df -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr Rect2Df
p -> Ptr Rect2Df -> Rect2Df -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr Rect2Df
p Rect2Df
x (Ptr Rect2Df -> IO b
f Ptr Rect2Df
p)
  pokeCStruct :: Ptr Rect2Df -> Rect2Df -> IO b -> IO b
pokeCStruct p :: Ptr Rect2Df
p Rect2Df{..} f :: IO b
f = do
    Ptr Offset2Df -> Offset2Df -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Rect2Df
p Ptr Rect2Df -> Int -> Ptr Offset2Df
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Offset2Df)) (Offset2Df
offset)
    Ptr Extent2Df -> Extent2Df -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Rect2Df
p Ptr Rect2Df -> Int -> Ptr Extent2Df
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Extent2Df)) (Extent2Df
extent)
    IO b
f
  cStructSize :: Int
cStructSize = 16
  cStructAlignment :: Int
cStructAlignment = 4
  pokeZeroCStruct :: Ptr Rect2Df -> IO b -> IO b
pokeZeroCStruct p :: Ptr Rect2Df
p f :: IO b
f = do
    Ptr Offset2Df -> Offset2Df -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Rect2Df
p Ptr Rect2Df -> Int -> Ptr Offset2Df
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Offset2Df)) (Offset2Df
forall a. Zero a => a
zero)
    Ptr Extent2Df -> Extent2Df -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Rect2Df
p Ptr Rect2Df -> Int -> Ptr Extent2Df
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Extent2Df)) (Extent2Df
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct Rect2Df where
  peekCStruct :: Ptr Rect2Df -> IO Rect2Df
peekCStruct p :: Ptr Rect2Df
p = do
    Offset2Df
offset <- Ptr Offset2Df -> IO Offset2Df
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Offset2Df ((Ptr Rect2Df
p Ptr Rect2Df -> Int -> Ptr Offset2Df
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Offset2Df))
    Extent2Df
extent <- Ptr Extent2Df -> IO Extent2Df
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent2Df ((Ptr Rect2Df
p Ptr Rect2Df -> Int -> Ptr Extent2Df
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Extent2Df))
    Rect2Df -> IO Rect2Df
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rect2Df -> IO Rect2Df) -> Rect2Df -> IO Rect2Df
forall a b. (a -> b) -> a -> b
$ Offset2Df -> Extent2Df -> Rect2Df
Rect2Df
             Offset2Df
offset Extent2Df
extent

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

instance Zero Rect2Df where
  zero :: Rect2Df
zero = Offset2Df -> Extent2Df -> Rect2Df
Rect2Df
           Offset2Df
forall a. Zero a => a
zero
           Extent2Df
forall a. Zero a => a
zero


-- | XrOffset2Di - Offset in two dimensions
--
-- == Member Descriptions
--
-- = Description
--
-- This variant is for representing discrete values such as texels. For
-- representing physical distances, the floating-point variant /must/ be
-- used instead.
--
-- = See Also
--
-- 'Extent2Di', 'Rect2Di'
data Offset2Di = Offset2Di
  { -- | @x@ the integer offset in the x direction.
    Offset2Di -> Int32
x :: Int32
  , -- | @y@ the integer offset in the y direction.
    Offset2Di -> Int32
y :: Int32
  }
  deriving (Typeable, Offset2Di -> Offset2Di -> Bool
(Offset2Di -> Offset2Di -> Bool)
-> (Offset2Di -> Offset2Di -> Bool) -> Eq Offset2Di
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Offset2Di -> Offset2Di -> Bool
$c/= :: Offset2Di -> Offset2Di -> Bool
== :: Offset2Di -> Offset2Di -> Bool
$c== :: Offset2Di -> Offset2Di -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (Offset2Di)
#endif
deriving instance Show Offset2Di

instance ToCStruct Offset2Di where
  withCStruct :: Offset2Di -> (Ptr Offset2Di -> IO b) -> IO b
withCStruct x :: Offset2Di
x f :: Ptr Offset2Di -> IO b
f = Int -> Int -> (Ptr Offset2Di -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 8 4 ((Ptr Offset2Di -> IO b) -> IO b)
-> (Ptr Offset2Di -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr Offset2Di
p -> Ptr Offset2Di -> Offset2Di -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr Offset2Di
p Offset2Di
x (Ptr Offset2Di -> IO b
f Ptr Offset2Di
p)
  pokeCStruct :: Ptr Offset2Di -> Offset2Di -> IO b -> IO b
pokeCStruct p :: Ptr Offset2Di
p Offset2Di{..} f :: IO b
f = do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Offset2Di
p Ptr Offset2Di -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Int32)) (Int32
x)
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Offset2Di
p Ptr Offset2Di -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Int32)) (Int32
y)
    IO b
f
  cStructSize :: Int
cStructSize = 8
  cStructAlignment :: Int
cStructAlignment = 4
  pokeZeroCStruct :: Ptr Offset2Di -> IO b -> IO b
pokeZeroCStruct p :: Ptr Offset2Di
p f :: IO b
f = do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Offset2Di
p Ptr Offset2Di -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Int32)) (Int32
forall a. Zero a => a
zero)
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Offset2Di
p Ptr Offset2Di -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Int32)) (Int32
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct Offset2Di where
  peekCStruct :: Ptr Offset2Di -> IO Offset2Di
peekCStruct p :: Ptr Offset2Di
p = do
    Int32
x <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek @Int32 ((Ptr Offset2Di
p Ptr Offset2Di -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Int32))
    Int32
y <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek @Int32 ((Ptr Offset2Di
p Ptr Offset2Di -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Int32))
    Offset2Di -> IO Offset2Di
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Offset2Di -> IO Offset2Di) -> Offset2Di -> IO Offset2Di
forall a b. (a -> b) -> a -> b
$ Int32 -> Int32 -> Offset2Di
Offset2Di
             Int32
x Int32
y

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

instance Zero Offset2Di where
  zero :: Offset2Di
zero = Int32 -> Int32 -> Offset2Di
Offset2Di
           Int32
forall a. Zero a => a
zero
           Int32
forall a. Zero a => a
zero


-- | XrExtent2Di - Extent in two dimensions
--
-- == Member Descriptions
--
-- = Description
--
-- This variant is for representing discrete values such as texels. For
-- representing physical distances, the floating-point variant /must/ be
-- used instead.
--
-- The @width@ and @height@ value /must/ be non-negative.
--
-- = See Also
--
-- 'Offset2Di', 'Rect2Di'
data Extent2Di = Extent2Di
  { -- | @width@ the integer width of the extent.
    Extent2Di -> Int32
width :: Int32
  , -- | @height@ the integer height of the extent.
    Extent2Di -> Int32
height :: Int32
  }
  deriving (Typeable, Extent2Di -> Extent2Di -> Bool
(Extent2Di -> Extent2Di -> Bool)
-> (Extent2Di -> Extent2Di -> Bool) -> Eq Extent2Di
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Extent2Di -> Extent2Di -> Bool
$c/= :: Extent2Di -> Extent2Di -> Bool
== :: Extent2Di -> Extent2Di -> Bool
$c== :: Extent2Di -> Extent2Di -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (Extent2Di)
#endif
deriving instance Show Extent2Di

instance ToCStruct Extent2Di where
  withCStruct :: Extent2Di -> (Ptr Extent2Di -> IO b) -> IO b
withCStruct x :: Extent2Di
x f :: Ptr Extent2Di -> IO b
f = Int -> Int -> (Ptr Extent2Di -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 8 4 ((Ptr Extent2Di -> IO b) -> IO b)
-> (Ptr Extent2Di -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr Extent2Di
p -> Ptr Extent2Di -> Extent2Di -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr Extent2Di
p Extent2Di
x (Ptr Extent2Di -> IO b
f Ptr Extent2Di
p)
  pokeCStruct :: Ptr Extent2Di -> Extent2Di -> IO b -> IO b
pokeCStruct p :: Ptr Extent2Di
p Extent2Di{..} f :: IO b
f = do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Extent2Di
p Ptr Extent2Di -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Int32)) (Int32
width)
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Extent2Di
p Ptr Extent2Di -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Int32)) (Int32
height)
    IO b
f
  cStructSize :: Int
cStructSize = 8
  cStructAlignment :: Int
cStructAlignment = 4
  pokeZeroCStruct :: Ptr Extent2Di -> IO b -> IO b
pokeZeroCStruct p :: Ptr Extent2Di
p f :: IO b
f = do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Extent2Di
p Ptr Extent2Di -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Int32)) (Int32
forall a. Zero a => a
zero)
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Extent2Di
p Ptr Extent2Di -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Int32)) (Int32
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct Extent2Di where
  peekCStruct :: Ptr Extent2Di -> IO Extent2Di
peekCStruct p :: Ptr Extent2Di
p = do
    Int32
width <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek @Int32 ((Ptr Extent2Di
p Ptr Extent2Di -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Int32))
    Int32
height <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek @Int32 ((Ptr Extent2Di
p Ptr Extent2Di -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Int32))
    Extent2Di -> IO Extent2Di
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Extent2Di -> IO Extent2Di) -> Extent2Di -> IO Extent2Di
forall a b. (a -> b) -> a -> b
$ Int32 -> Int32 -> Extent2Di
Extent2Di
             Int32
width Int32
height

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

instance Zero Extent2Di where
  zero :: Extent2Di
zero = Int32 -> Int32 -> Extent2Di
Extent2Di
           Int32
forall a. Zero a => a
zero
           Int32
forall a. Zero a => a
zero


-- | XrRect2Di - Rect in two dimensions
--
-- == Member Descriptions
--
-- = Description
--
-- This variant is for representing discrete values such as texels. For
-- representing physical distances, the floating-point variant /must/ be
-- used instead.
--
-- = See Also
--
-- 'Extent2Di', 'Offset2Di', 'OpenXR.Core10.OtherTypes.SwapchainSubImage'
data Rect2Di = Rect2Di
  { -- | @offset@ is the 'Offset2Di' specifying the integer rectangle offset.
    Rect2Di -> Offset2Di
offset :: Offset2Di
  , -- | @extent@ is the 'Extent2Di' specifying the integer rectangle extent.
    Rect2Di -> Extent2Di
extent :: Extent2Di
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (Rect2Di)
#endif
deriving instance Show Rect2Di

instance ToCStruct Rect2Di where
  withCStruct :: Rect2Di -> (Ptr Rect2Di -> IO b) -> IO b
withCStruct x :: Rect2Di
x f :: Ptr Rect2Di -> IO b
f = Int -> Int -> (Ptr Rect2Di -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 16 4 ((Ptr Rect2Di -> IO b) -> IO b) -> (Ptr Rect2Di -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr Rect2Di
p -> Ptr Rect2Di -> Rect2Di -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr Rect2Di
p Rect2Di
x (Ptr Rect2Di -> IO b
f Ptr Rect2Di
p)
  pokeCStruct :: Ptr Rect2Di -> Rect2Di -> IO b -> IO b
pokeCStruct p :: Ptr Rect2Di
p Rect2Di{..} f :: IO b
f = do
    Ptr Offset2Di -> Offset2Di -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Rect2Di
p Ptr Rect2Di -> Int -> Ptr Offset2Di
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Offset2Di)) (Offset2Di
offset)
    Ptr Extent2Di -> Extent2Di -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Rect2Di
p Ptr Rect2Di -> Int -> Ptr Extent2Di
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Extent2Di)) (Extent2Di
extent)
    IO b
f
  cStructSize :: Int
cStructSize = 16
  cStructAlignment :: Int
cStructAlignment = 4
  pokeZeroCStruct :: Ptr Rect2Di -> IO b -> IO b
pokeZeroCStruct p :: Ptr Rect2Di
p f :: IO b
f = do
    Ptr Offset2Di -> Offset2Di -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Rect2Di
p Ptr Rect2Di -> Int -> Ptr Offset2Di
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Offset2Di)) (Offset2Di
forall a. Zero a => a
zero)
    Ptr Extent2Di -> Extent2Di -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Rect2Di
p Ptr Rect2Di -> Int -> Ptr Extent2Di
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Extent2Di)) (Extent2Di
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct Rect2Di where
  peekCStruct :: Ptr Rect2Di -> IO Rect2Di
peekCStruct p :: Ptr Rect2Di
p = do
    Offset2Di
offset <- Ptr Offset2Di -> IO Offset2Di
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Offset2Di ((Ptr Rect2Di
p Ptr Rect2Di -> Int -> Ptr Offset2Di
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Offset2Di))
    Extent2Di
extent <- Ptr Extent2Di -> IO Extent2Di
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent2Di ((Ptr Rect2Di
p Ptr Rect2Di -> Int -> Ptr Extent2Di
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Extent2Di))
    Rect2Di -> IO Rect2Di
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rect2Di -> IO Rect2Di) -> Rect2Di -> IO Rect2Di
forall a b. (a -> b) -> a -> b
$ Offset2Di -> Extent2Di -> Rect2Di
Rect2Di
             Offset2Di
offset Extent2Di
extent

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

instance Zero Rect2Di where
  zero :: Rect2Di
zero = Offset2Di -> Extent2Di -> Rect2Di
Rect2Di
           Offset2Di
forall a. Zero a => a
zero
           Extent2Di
forall a. Zero a => a
zero


-- | XrBool32 - Boolean value
--
-- = Description
--
-- Boolean values used by OpenXR are of type
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrBool32 >
-- and are 32-bits wide as suggested by the name. The only valid values are
-- the following:
--
-- == Enumerant Descriptions
--
-- = See Also
--
-- 'OpenXR.Core10.Input.ActionStateBoolean',
-- 'OpenXR.Core10.Input.ActionStateFloat',
-- 'OpenXR.Core10.Input.ActionStatePose',
-- 'OpenXR.Core10.Input.ActionStateVector2f',
-- 'OpenXR.Extensions.XR_EXTX_overlay.EventDataMainSessionVisibilityChangedEXTX',
-- 'OpenXR.Core10.OtherTypes.EventDataReferenceSpaceChangePending',
-- 'OpenXR.Core10.DisplayTiming.FrameState',
-- 'OpenXR.Extensions.XR_EXT_hand_tracking.HandJointLocationsEXT',
-- 'OpenXR.Extensions.XR_MSFT_hand_tracking_mesh.HandMeshMSFT',
-- 'OpenXR.Extensions.XR_MSFT_secondary_view_configuration.SecondaryViewConfigurationStateMSFT',
-- 'OpenXR.Extensions.XR_EXT_eye_gaze_interaction.SystemEyeGazeInteractionPropertiesEXT',
-- 'OpenXR.Extensions.XR_MSFT_hand_tracking_mesh.SystemHandTrackingMeshPropertiesMSFT',
-- 'OpenXR.Extensions.XR_EXT_hand_tracking.SystemHandTrackingPropertiesEXT',
-- 'OpenXR.Core10.Device.SystemTrackingProperties',
-- 'OpenXR.Core10.ViewConfigurations.ViewConfigurationProperties',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#xrSetInputDeviceActiveEXT xrSetInputDeviceActiveEXT>,
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#xrSetInputDeviceStateBoolEXT xrSetInputDeviceStateBoolEXT>
newtype Bool32 = Bool32 Int32
  deriving newtype (Bool32 -> Bool32 -> Bool
(Bool32 -> Bool32 -> Bool)
-> (Bool32 -> Bool32 -> Bool) -> Eq Bool32
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bool32 -> Bool32 -> Bool
$c/= :: Bool32 -> Bool32 -> Bool
== :: Bool32 -> Bool32 -> Bool
$c== :: Bool32 -> Bool32 -> Bool
Eq, Eq Bool32
Eq Bool32 =>
(Bool32 -> Bool32 -> Ordering)
-> (Bool32 -> Bool32 -> Bool)
-> (Bool32 -> Bool32 -> Bool)
-> (Bool32 -> Bool32 -> Bool)
-> (Bool32 -> Bool32 -> Bool)
-> (Bool32 -> Bool32 -> Bool32)
-> (Bool32 -> Bool32 -> Bool32)
-> Ord Bool32
Bool32 -> Bool32 -> Bool
Bool32 -> Bool32 -> Ordering
Bool32 -> Bool32 -> Bool32
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Bool32 -> Bool32 -> Bool32
$cmin :: Bool32 -> Bool32 -> Bool32
max :: Bool32 -> Bool32 -> Bool32
$cmax :: Bool32 -> Bool32 -> Bool32
>= :: Bool32 -> Bool32 -> Bool
$c>= :: Bool32 -> Bool32 -> Bool
> :: Bool32 -> Bool32 -> Bool
$c> :: Bool32 -> Bool32 -> Bool
<= :: Bool32 -> Bool32 -> Bool
$c<= :: Bool32 -> Bool32 -> Bool
< :: Bool32 -> Bool32 -> Bool
$c< :: Bool32 -> Bool32 -> Bool
compare :: Bool32 -> Bool32 -> Ordering
$ccompare :: Bool32 -> Bool32 -> Ordering
$cp1Ord :: Eq Bool32
Ord, Ptr b -> Int -> IO Bool32
Ptr b -> Int -> Bool32 -> IO ()
Ptr Bool32 -> IO Bool32
Ptr Bool32 -> Int -> IO Bool32
Ptr Bool32 -> Int -> Bool32 -> IO ()
Ptr Bool32 -> Bool32 -> IO ()
Bool32 -> Int
(Bool32 -> Int)
-> (Bool32 -> Int)
-> (Ptr Bool32 -> Int -> IO Bool32)
-> (Ptr Bool32 -> Int -> Bool32 -> IO ())
-> (forall b. Ptr b -> Int -> IO Bool32)
-> (forall b. Ptr b -> Int -> Bool32 -> IO ())
-> (Ptr Bool32 -> IO Bool32)
-> (Ptr Bool32 -> Bool32 -> IO ())
-> Storable Bool32
forall b. Ptr b -> Int -> IO Bool32
forall b. Ptr b -> Int -> Bool32 -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr Bool32 -> Bool32 -> IO ()
$cpoke :: Ptr Bool32 -> Bool32 -> IO ()
peek :: Ptr Bool32 -> IO Bool32
$cpeek :: Ptr Bool32 -> IO Bool32
pokeByteOff :: Ptr b -> Int -> Bool32 -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Bool32 -> IO ()
peekByteOff :: Ptr b -> Int -> IO Bool32
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Bool32
pokeElemOff :: Ptr Bool32 -> Int -> Bool32 -> IO ()
$cpokeElemOff :: Ptr Bool32 -> Int -> Bool32 -> IO ()
peekElemOff :: Ptr Bool32 -> Int -> IO Bool32
$cpeekElemOff :: Ptr Bool32 -> Int -> IO Bool32
alignment :: Bool32 -> Int
$calignment :: Bool32 -> Int
sizeOf :: Bool32 -> Int
$csizeOf :: Bool32 -> Int
Storable, Bool32
Bool32 -> Zero Bool32
forall a. a -> Zero a
zero :: Bool32
$czero :: Bool32
Zero)

-- | 'FALSE' represents a false value.
pattern $bFALSE :: Bool32
$mFALSE :: forall r. Bool32 -> (Void# -> r) -> (Void# -> r) -> r
FALSE = Bool32 0
-- | 'TRUE' represents a true value.
pattern $bTRUE :: Bool32
$mTRUE :: forall r. Bool32 -> (Void# -> r) -> (Void# -> r) -> r
TRUE  = Bool32 1
{-# complete FALSE,
             TRUE :: Bool32 #-}

conNameBool32 :: String
conNameBool32 :: String
conNameBool32 = "Bool32"

enumPrefixBool32 :: String
enumPrefixBool32 :: String
enumPrefixBool32 = ""

showTableBool32 :: [(Bool32, String)]
showTableBool32 :: [(Bool32, String)]
showTableBool32 = [(Bool32
FALSE, "FALSE"), (Bool32
TRUE, "TRUE")]

instance Show Bool32 where
  showsPrec :: Int -> Bool32 -> ShowS
showsPrec = String
-> [(Bool32, String)]
-> String
-> (Bool32 -> Int32)
-> (Int32 -> ShowS)
-> Int
-> Bool32
-> ShowS
forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec String
enumPrefixBool32 [(Bool32, String)]
showTableBool32 String
conNameBool32 (\(Bool32 x :: Int32
x) -> Int32
x) (Int -> Int32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 11)

instance Read Bool32 where
  readPrec :: ReadPrec Bool32
readPrec = String
-> [(Bool32, String)]
-> String
-> (Int32 -> Bool32)
-> ReadPrec Bool32
forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec String
enumPrefixBool32 [(Bool32, String)]
showTableBool32 String
conNameBool32 Int32 -> Bool32
Bool32


-- | XrFlags64 - OpenXR bitmasks
--
-- = Description
--
-- Bitmasks are passed to many functions and structures to compactly
-- represent options and are stored in memory defined by the
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrFlags64 >
-- type. But the API does not use the
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrFlags64 >
-- type directly. Instead, a @Xr*Flags@ type is used which is an alias of
-- the
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrFlags64 >
-- type. The API also defines a set of constant bit definitions used to set
-- the bitmasks.
--
-- = See Also
--
-- 'OpenXR.Core10.Enums.CompositionLayerFlags.CompositionLayerFlags',
-- 'OpenXR.Core10.Enums.InstanceCreateFlags.InstanceCreateFlags',
-- 'OpenXR.Core10.Enums.SessionCreateFlags.SessionCreateFlags',
-- 'OpenXR.Core10.Enums.SpaceLocationFlags.SpaceLocationFlags',
-- 'OpenXR.Core10.Enums.SwapchainCreateFlags.SwapchainCreateFlags',
-- 'OpenXR.Core10.Enums.SwapchainUsageFlags.SwapchainUsageFlags',
-- 'OpenXR.Core10.Enums.ViewStateFlags.ViewStateFlags'
type Flags64 = Word64


-- | XrTime - Basic type for time
--
-- = Description
--
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >
-- is a base value type that represents time as a signed 64-bit integer,
-- representing the monotonically-increasing count of nanoseconds that have
-- elapsed since a runtime-chosen epoch.
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >
-- always represents the time elasped since that constant epoch, rather
-- than a duration or a time point relative to some moving epoch such as
-- vsync time, etc. Durations are instead represented by
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrDuration >.
--
-- A single runtime /must/ use the same epoch for all simultaneous
-- applications. Time /must/ be represented the same regardless of multiple
-- processors or threads present in the system.
--
-- The period precision of time reported by the runtime is
-- runtime-dependent, and /may/ change. One nanosecond is the finest
-- possible period precision. A runtime /may/, for example, report time
-- progression with only microsecond-level granularity.
--
-- Time /must/ not be assumed to correspond to a system clock time.
--
-- Unless specified otherwise, zero or a negative value is not a valid
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >,
-- and related functions /must/ return error
-- 'OpenXR.Core10.Enums.Result.ERROR_TIME_INVALID'. Applications /must/ not
-- initialize such
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >
-- fields to a zero value. Instead, applications /should/ always assign
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >
-- fields to the meaningful point in time they are choosing to reason
-- about, such as a frame’s predicted display time, or an action’s last
-- change time.
--
-- The behavior of a runtime is undefined when time overflows beyond the
-- maximum positive value that can be represented by an
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >.
-- Runtimes /should/ choose an epoch that minimizes the chance of overflow.
-- Runtimes /should/ also choose an epoch that minimizes the chance of
-- underflow below 0 for applications performing a reasonable amount of
-- historical pose lookback. For example, if the runtime chooses an epoch
-- relative to its startup time, it /should/ push the epoch into the past
-- by enough time to avoid applications performing reasonable pose lookback
-- from reaching a negative
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >
-- value.
--
-- An application cannot assume that the system’s clock and the runtime’s
-- clock will maintain a constant relationship across frames and /should/
-- avoid storing such an offset, as this may cause time drift. Applications
-- /should/ instead always use time interop functions to convert a relevant
-- time point across the system’s clock and the runtime’s clock using
-- extensions, for example,
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_KHR_win32_convert_performance_counter_time>
-- or
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_KHR_convert_timespec_time>.
--
-- = See Also
--
-- 'OpenXR.Core10.Input.ActionStateBoolean',
-- 'OpenXR.Core10.Input.ActionStateFloat',
-- 'OpenXR.Core10.Input.ActionStateVector2f',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrDuration >,
-- 'OpenXR.Core10.OtherTypes.EventDataInstanceLossPending',
-- 'OpenXR.Core10.OtherTypes.EventDataReferenceSpaceChangePending',
-- 'OpenXR.Core10.OtherTypes.EventDataSessionStateChanged',
-- 'OpenXR.Extensions.XR_EXT_eye_gaze_interaction.EyeGazeSampleTimeEXT',
-- 'OpenXR.Core10.DisplayTiming.FrameEndInfo',
-- 'OpenXR.Core10.DisplayTiming.FrameState',
-- 'OpenXR.Extensions.XR_EXT_hand_tracking.HandJointsLocateInfoEXT',
-- 'OpenXR.Extensions.XR_MSFT_hand_tracking_mesh.HandMeshUpdateInfoMSFT',
-- 'OpenXR.Extensions.XR_MSFT_hand_tracking_mesh.HandMeshVertexBufferMSFT',
-- 'OpenXR.Extensions.XR_MSFT_spatial_anchor.SpatialAnchorCreateInfoMSFT',
-- 'OpenXR.Core10.DisplayTiming.ViewLocateInfo',
-- 'OpenXR.Extensions.XR_KHR_convert_timespec_time.convertTimeToTimespecTimeKHR',
-- 'OpenXR.Extensions.XR_KHR_win32_convert_performance_counter_time.convertTimeToWin32PerformanceCounterKHR',
-- 'OpenXR.Extensions.XR_KHR_convert_timespec_time.convertTimespecTimeToTimeKHR',
-- 'OpenXR.Extensions.XR_KHR_win32_convert_performance_counter_time.convertWin32PerformanceCounterToTimeKHR',
-- 'OpenXR.Core10.Space.locateSpace'
type Time = Int64


-- | XrDuration - Bounded range of time
--
-- = Description
--
-- The difference between two timepoints is a duration, and thus the
-- difference between two
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >
-- values is an
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrDuration >
-- value.
--
-- Functions that refer to durations use
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrDuration >
-- as opposed to
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >.
--
-- = See Also
--
-- 'OpenXR.Core10.DisplayTiming.FrameState',
-- 'OpenXR.Core10.OtherTypes.HapticVibration',
-- 'OpenXR.Core10.Image.SwapchainImageWaitInfo',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >
type Duration = Int64