{-# language CPP #-}
-- No documentation found for Chapter "DisplayTiming"
module OpenXR.Core10.DisplayTiming  ( beginFrame
                                    , useFrame
                                    , locateViews
                                    , endFrame
                                    , waitFrame
                                    , waitFrameSafe
                                    , View(..)
                                    , ViewLocateInfo(..)
                                    , ViewState(..)
                                    , FrameBeginInfo(..)
                                    , FrameEndInfo(..)
                                    , FrameWaitInfo(..)
                                    , FrameState(..)
                                    ) where

import OpenXR.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (castPtr)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import qualified Data.Vector (null)
import OpenXR.CStruct (FromCStruct)
import OpenXR.CStruct (FromCStruct(..))
import OpenXR.CStruct (ToCStruct)
import OpenXR.CStruct (ToCStruct(..))
import OpenXR.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.Type.Equality ((:~:)(Refl))
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 GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import OpenXR.CStruct.Utils (advancePtrBytes)
import OpenXR.Core10.FundamentalTypes (bool32ToBool)
import OpenXR.Core10.FundamentalTypes (boolToBool32)
import OpenXR.CStruct.Extends (forgetExtensions)
import OpenXR.CStruct.Extends (withSomeChild)
import OpenXR.NamedType ((:::))
import OpenXR.Core10.FundamentalTypes (Bool32)
import OpenXR.CStruct.Extends (Chain)
import OpenXR.Core10.OtherTypes (CompositionLayerBaseHeader)
import OpenXR.Core10.FundamentalTypes (Duration)
import OpenXR.Core10.Enums.EnvironmentBlendMode (EnvironmentBlendMode)
import OpenXR.CStruct.Extends (Extends)
import OpenXR.CStruct.Extends (Extendss)
import OpenXR.CStruct.Extends (Extensible(..))
import OpenXR.Core10.OtherTypes (Fovf)
import OpenXR.CStruct.Extends (Inheritable(peekSomeCChild))
import OpenXR.Dynamic (InstanceCmds(pXrBeginFrame))
import OpenXR.Dynamic (InstanceCmds(pXrEndFrame))
import OpenXR.Dynamic (InstanceCmds(pXrLocateViews))
import OpenXR.Dynamic (InstanceCmds(pXrWaitFrame))
import OpenXR.Exception (OpenXrException(..))
import OpenXR.CStruct.Extends (PeekChain)
import OpenXR.CStruct.Extends (PeekChain(..))
import OpenXR.CStruct.Extends (PokeChain)
import OpenXR.CStruct.Extends (PokeChain(..))
import OpenXR.Core10.Space (Posef)
import OpenXR.Core10.Enums.Result (Result)
import OpenXR.Core10.Enums.Result (Result(..))
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_secondary_view_configuration (SecondaryViewConfigurationFrameEndInfoMSFT)
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_secondary_view_configuration (SecondaryViewConfigurationFrameStateMSFT)
import OpenXR.Core10.Handles (Session)
import OpenXR.Core10.Handles (Session(..))
import OpenXR.Core10.Handles (Session_T)
import OpenXR.CStruct.Extends (SomeChild)
import OpenXR.CStruct.Extends (SomeStruct)
import OpenXR.Core10.Handles (Space_T)
import OpenXR.Core10.Enums.StructureType (StructureType)
import OpenXR.Core10.FundamentalTypes (Time)
import OpenXR.Core10.Enums.ViewConfigurationType (ViewConfigurationType)
import OpenXR.Core10.Enums.ViewStateFlags (ViewStateFlags)
import OpenXR.Core10.Enums.Result (Result(SUCCESS))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_FRAME_BEGIN_INFO))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_FRAME_END_INFO))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_FRAME_STATE))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_FRAME_WAIT_INFO))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_VIEW))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_VIEW_LOCATE_INFO))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_VIEW_STATE))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrBeginFrame
  :: FunPtr (Ptr Session_T -> Ptr FrameBeginInfo -> IO Result) -> Ptr Session_T -> Ptr FrameBeginInfo -> IO Result

-- | xrBeginFrame - Marks a frame
--
-- == Parameter Descriptions
--
-- = Description
--
-- 'beginFrame' is called prior to the start of frame rendering. The
-- application /should/ still call 'beginFrame' but omit rendering work for
-- the frame if 'FrameState'::@shouldRender@ is
-- 'OpenXR.Core10.FundamentalTypes.FALSE'.
--
-- The runtime /must/ return the error code
-- 'OpenXR.Core10.Enums.Result.ERROR_CALL_ORDER_INVALID' if there was no
-- corresponding successful call to 'waitFrame'.
--
-- The runtime /must/ return the success code
-- 'OpenXR.Core10.Enums.Result.FRAME_DISCARDED' if a prior 'beginFrame' has
-- been called without an intervening call to 'endFrame'.
--
-- The runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_SESSION_NOT_RUNNING' if the @session@
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#session_not_running is not running>.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-xrBeginFrame-session-parameter# @session@ /must/ be a valid
--     'OpenXR.Core10.Handles.Session' handle
--
-- -   #VUID-xrBeginFrame-frameBeginInfo-parameter# If @frameBeginInfo@ is
--     not @NULL@, @frameBeginInfo@ /must/ be a pointer to a valid
--     'FrameBeginInfo' structure
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
--     -   'OpenXR.Core10.Enums.Result.SESSION_LOSS_PENDING'
--
--     -   'OpenXR.Core10.Enums.Result.FRAME_DISCARDED'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_CALL_ORDER_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_NOT_RUNNING'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
-- = See Also
--
-- 'FrameBeginInfo', 'OpenXR.Core10.Handles.Session', 'endFrame',
-- 'waitFrame'
beginFrame :: forall io
            . (MonadIO io)
           => -- | @session@ is a valid 'OpenXR.Core10.Handles.Session' handle.
              Session
           -> -- | @frameBeginInfo@ exists for extensibility purposes, it is @NULL@ or a
              -- pointer to a valid 'FrameBeginInfo'.
              ("frameBeginInfo" ::: Maybe FrameBeginInfo)
           -> io (Result)
beginFrame :: Session -> ("frameBeginInfo" ::: Maybe FrameBeginInfo) -> io Result
beginFrame session :: Session
session frameBeginInfo :: "frameBeginInfo" ::: Maybe FrameBeginInfo
frameBeginInfo = IO Result -> io Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> io Result)
-> (ContT Result IO Result -> IO Result)
-> ContT Result IO Result
-> io Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Result IO Result -> IO Result
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Result IO Result -> io Result)
-> ContT Result IO Result -> io Result
forall a b. (a -> b) -> a -> b
$ do
  let xrBeginFramePtr :: FunPtr (Ptr Session_T -> Ptr FrameBeginInfo -> IO Result)
xrBeginFramePtr = InstanceCmds
-> FunPtr (Ptr Session_T -> Ptr FrameBeginInfo -> IO Result)
pXrBeginFrame (Session -> InstanceCmds
instanceCmds (Session
session :: Session))
  IO () -> ContT Result IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Result IO ()) -> IO () -> ContT Result IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr (Ptr Session_T -> Ptr FrameBeginInfo -> IO Result)
xrBeginFramePtr FunPtr (Ptr Session_T -> Ptr FrameBeginInfo -> IO Result)
-> FunPtr (Ptr Session_T -> Ptr FrameBeginInfo -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr (Ptr Session_T -> Ptr FrameBeginInfo -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for xrBeginFrame is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrBeginFrame' :: Ptr Session_T -> Ptr FrameBeginInfo -> IO Result
xrBeginFrame' = FunPtr (Ptr Session_T -> Ptr FrameBeginInfo -> IO Result)
-> Ptr Session_T -> Ptr FrameBeginInfo -> IO Result
mkXrBeginFrame FunPtr (Ptr Session_T -> Ptr FrameBeginInfo -> IO Result)
xrBeginFramePtr
  Ptr FrameBeginInfo
frameBeginInfo' <- case ("frameBeginInfo" ::: Maybe FrameBeginInfo
frameBeginInfo) of
    Nothing -> Ptr FrameBeginInfo -> ContT Result IO (Ptr FrameBeginInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr FrameBeginInfo
forall a. Ptr a
nullPtr
    Just j :: FrameBeginInfo
j -> ((Ptr FrameBeginInfo -> IO Result) -> IO Result)
-> ContT Result IO (Ptr FrameBeginInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr FrameBeginInfo -> IO Result) -> IO Result)
 -> ContT Result IO (Ptr FrameBeginInfo))
-> ((Ptr FrameBeginInfo -> IO Result) -> IO Result)
-> ContT Result IO (Ptr FrameBeginInfo)
forall a b. (a -> b) -> a -> b
$ FrameBeginInfo -> (Ptr FrameBeginInfo -> IO Result) -> IO Result
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (FrameBeginInfo
j)
  Result
r <- IO Result -> ContT Result IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT Result IO Result)
-> IO Result -> ContT Result IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrBeginFrame" (Ptr Session_T -> Ptr FrameBeginInfo -> IO Result
xrBeginFrame' (Session -> Ptr Session_T
sessionHandle (Session
session)) Ptr FrameBeginInfo
frameBeginInfo')
  IO () -> ContT Result IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Result IO ()) -> IO () -> ContT Result IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))
  Result -> ContT Result IO Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> ContT Result IO Result)
-> Result -> ContT Result IO Result
forall a b. (a -> b) -> a -> b
$ (Result
r)

-- | This function will call the supplied action between calls to
-- 'beginFrame' and 'endFrame'
--
-- Note that 'endFrame' is *not* called if an exception is thrown by the
-- inner action.
useFrame :: forall a io r . (Extendss FrameEndInfo a, PokeChain a, MonadIO io) => Session -> Maybe FrameBeginInfo -> FrameEndInfo a -> (Result -> io r) -> io (Result, r)
useFrame :: Session
-> ("frameBeginInfo" ::: Maybe FrameBeginInfo)
-> FrameEndInfo a
-> (Result -> io r)
-> io (Result, r)
useFrame session :: Session
session frameBeginInfo :: "frameBeginInfo" ::: Maybe FrameBeginInfo
frameBeginInfo frameEndInfo :: FrameEndInfo a
frameEndInfo a :: Result -> io r
a =
  do
    Result
x <- Session -> ("frameBeginInfo" ::: Maybe FrameBeginInfo) -> io Result
forall (io :: * -> *).
MonadIO io =>
Session -> ("frameBeginInfo" ::: Maybe FrameBeginInfo) -> io Result
beginFrame Session
session "frameBeginInfo" ::: Maybe FrameBeginInfo
frameBeginInfo
    r
r <- Result -> io r
a Result
x
    Result
d <- (\(Result
_) -> Session -> FrameEndInfo a -> io Result
forall (a :: [*]) (io :: * -> *).
(Extendss FrameEndInfo a, PokeChain a, MonadIO io) =>
Session -> FrameEndInfo a -> io Result
endFrame Session
session FrameEndInfo a
frameEndInfo) Result
x
    (Result, r) -> io (Result, r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result
d, r
r)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrLocateViews
  :: FunPtr (Ptr Session_T -> Ptr ViewLocateInfo -> Ptr ViewState -> Word32 -> Ptr Word32 -> Ptr View -> IO Result) -> Ptr Session_T -> Ptr ViewLocateInfo -> Ptr ViewState -> Word32 -> Ptr Word32 -> Ptr View -> IO Result

-- | xrLocateViews - Gets view and projection info
--
-- == Parameter Descriptions
--
-- -   @session@ is a handle to the provided
--     'OpenXR.Core10.Handles.Session'.
--
-- -   @viewLocateInfo@ is a pointer to a valid 'ViewLocateInfo' structure.
--
-- -   @viewState@ is the output structure with the viewer state
--     information.
--
-- -   @viewCapacityInput@ is an input parameter which specifies the
--     capacity of the @views@ array. The required capacity /must/ be same
--     as defined by the corresponding
--     'OpenXR.Core10.Enums.ViewConfigurationType.ViewConfigurationType'.
--
-- -   @viewCountOutput@ is an output parameter which identifies the valid
--     count of @views@.
--
-- -   @views@ is an array of 'View'.
--
-- -   See
--     <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#buffer-size-parameters Buffer Size Parameters>
--     chapter for a detailed description of retrieving the required
--     @views@ size.
--
-- = Description
--
-- The 'locateViews' function returns the view and projection info for a
-- particular display time. This time is typically the target display time
-- for a given frame. Repeatedly calling 'locateViews' with the same time
-- /may/ not necessarily return the same result. Instead the prediction
-- gets increasingly accurate as the function is called closer to the given
-- time for which a prediction is made. This allows an application to get
-- the predicted views as late as possible in its pipeline to get the least
-- amount of latency and prediction error.
--
-- 'locateViews' returns an array of 'View' elements, one for each view of
-- the specified view configuration type, along with an 'ViewState'
-- containing additional state data shared across all views. The eye each
-- view corresponds to is statically defined in
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#view_configuration_type >
-- in case the application wants to apply eye-specific rendering traits.
-- The 'ViewState' and 'View' member data may change on subsequent calls to
-- 'locateViews', and so applications /must/ not assume it to be constant.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-xrLocateViews-session-parameter# @session@ /must/ be a valid
--     'OpenXR.Core10.Handles.Session' handle
--
-- -   #VUID-xrLocateViews-viewLocateInfo-parameter# @viewLocateInfo@
--     /must/ be a pointer to a valid 'ViewLocateInfo' structure
--
-- -   #VUID-xrLocateViews-viewState-parameter# @viewState@ /must/ be a
--     pointer to an 'ViewState' structure
--
-- -   #VUID-xrLocateViews-viewCountOutput-parameter# @viewCountOutput@
--     /must/ be a pointer to a @uint32_t@ value
--
-- -   #VUID-xrLocateViews-views-parameter# If @viewCapacityInput@ is not
--     @0@, @views@ /must/ be a pointer to an array of @viewCapacityInput@
--     'View' structures
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
--     -   'OpenXR.Core10.Enums.Result.SESSION_LOSS_PENDING'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SIZE_INSUFFICIENT'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VIEW_CONFIGURATION_TYPE_UNSUPPORTED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_TIME_INVALID'
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Session', 'View', 'ViewLocateInfo', 'ViewState'
locateViews :: forall io
             . (MonadIO io)
            => -- No documentation found for Nested "xrLocateViews" "session"
               Session
            -> -- No documentation found for Nested "xrLocateViews" "viewLocateInfo"
               ViewLocateInfo
            -> io (Result, ViewState, ("views" ::: Vector View))
locateViews :: Session
-> ViewLocateInfo
-> io (Result, ViewState, "views" ::: Vector View)
locateViews session :: Session
session viewLocateInfo :: ViewLocateInfo
viewLocateInfo = IO (Result, ViewState, "views" ::: Vector View)
-> io (Result, ViewState, "views" ::: Vector View)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result, ViewState, "views" ::: Vector View)
 -> io (Result, ViewState, "views" ::: Vector View))
-> (ContT
      (Result, ViewState, "views" ::: Vector View)
      IO
      (Result, ViewState, "views" ::: Vector View)
    -> IO (Result, ViewState, "views" ::: Vector View))
-> ContT
     (Result, ViewState, "views" ::: Vector View)
     IO
     (Result, ViewState, "views" ::: Vector View)
-> io (Result, ViewState, "views" ::: Vector View)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  (Result, ViewState, "views" ::: Vector View)
  IO
  (Result, ViewState, "views" ::: Vector View)
-> IO (Result, ViewState, "views" ::: Vector View)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   (Result, ViewState, "views" ::: Vector View)
   IO
   (Result, ViewState, "views" ::: Vector View)
 -> io (Result, ViewState, "views" ::: Vector View))
-> ContT
     (Result, ViewState, "views" ::: Vector View)
     IO
     (Result, ViewState, "views" ::: Vector View)
-> io (Result, ViewState, "views" ::: Vector View)
forall a b. (a -> b) -> a -> b
$ do
  let xrLocateViewsPtr :: FunPtr
  (Ptr Session_T
   -> Ptr ViewLocateInfo
   -> Ptr ViewState
   -> ("viewCapacityInput" ::: Word32)
   -> ("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32))
   -> ("views" ::: Ptr View)
   -> IO Result)
xrLocateViewsPtr = InstanceCmds
-> FunPtr
     (Ptr Session_T
      -> Ptr ViewLocateInfo
      -> Ptr ViewState
      -> ("viewCapacityInput" ::: Word32)
      -> ("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32))
      -> ("views" ::: Ptr View)
      -> IO Result)
pXrLocateViews (Session -> InstanceCmds
instanceCmds (Session
session :: Session))
  IO () -> ContT (Result, ViewState, "views" ::: Vector View) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, ViewState, "views" ::: Vector View) IO ())
-> IO ()
-> ContT (Result, ViewState, "views" ::: Vector View) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Session_T
   -> Ptr ViewLocateInfo
   -> Ptr ViewState
   -> ("viewCapacityInput" ::: Word32)
   -> ("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32))
   -> ("views" ::: Ptr View)
   -> IO Result)
xrLocateViewsPtr FunPtr
  (Ptr Session_T
   -> Ptr ViewLocateInfo
   -> Ptr ViewState
   -> ("viewCapacityInput" ::: Word32)
   -> ("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32))
   -> ("views" ::: Ptr View)
   -> IO Result)
-> FunPtr
     (Ptr Session_T
      -> Ptr ViewLocateInfo
      -> Ptr ViewState
      -> ("viewCapacityInput" ::: Word32)
      -> ("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32))
      -> ("views" ::: Ptr View)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Session_T
   -> Ptr ViewLocateInfo
   -> Ptr ViewState
   -> ("viewCapacityInput" ::: Word32)
   -> ("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32))
   -> ("views" ::: Ptr View)
   -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for xrLocateViews is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrLocateViews' :: Ptr Session_T
-> Ptr ViewLocateInfo
-> Ptr ViewState
-> ("viewCapacityInput" ::: Word32)
-> ("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32))
-> ("views" ::: Ptr View)
-> IO Result
xrLocateViews' = FunPtr
  (Ptr Session_T
   -> Ptr ViewLocateInfo
   -> Ptr ViewState
   -> ("viewCapacityInput" ::: Word32)
   -> ("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32))
   -> ("views" ::: Ptr View)
   -> IO Result)
-> Ptr Session_T
-> Ptr ViewLocateInfo
-> Ptr ViewState
-> ("viewCapacityInput" ::: Word32)
-> ("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32))
-> ("views" ::: Ptr View)
-> IO Result
mkXrLocateViews FunPtr
  (Ptr Session_T
   -> Ptr ViewLocateInfo
   -> Ptr ViewState
   -> ("viewCapacityInput" ::: Word32)
   -> ("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32))
   -> ("views" ::: Ptr View)
   -> IO Result)
xrLocateViewsPtr
  let session' :: Ptr Session_T
session' = Session -> Ptr Session_T
sessionHandle (Session
session)
  Ptr ViewLocateInfo
viewLocateInfo' <- ((Ptr ViewLocateInfo
  -> IO (Result, ViewState, "views" ::: Vector View))
 -> IO (Result, ViewState, "views" ::: Vector View))
-> ContT
     (Result, ViewState, "views" ::: Vector View)
     IO
     (Ptr ViewLocateInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ViewLocateInfo
   -> IO (Result, ViewState, "views" ::: Vector View))
  -> IO (Result, ViewState, "views" ::: Vector View))
 -> ContT
      (Result, ViewState, "views" ::: Vector View)
      IO
      (Ptr ViewLocateInfo))
-> ((Ptr ViewLocateInfo
     -> IO (Result, ViewState, "views" ::: Vector View))
    -> IO (Result, ViewState, "views" ::: Vector View))
-> ContT
     (Result, ViewState, "views" ::: Vector View)
     IO
     (Ptr ViewLocateInfo)
forall a b. (a -> b) -> a -> b
$ ViewLocateInfo
-> (Ptr ViewLocateInfo
    -> IO (Result, ViewState, "views" ::: Vector View))
-> IO (Result, ViewState, "views" ::: Vector View)
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (ViewLocateInfo
viewLocateInfo)
  Ptr ViewState
pViewState <- ((Ptr ViewState -> IO (Result, ViewState, "views" ::: Vector View))
 -> IO (Result, ViewState, "views" ::: Vector View))
-> ContT
     (Result, ViewState, "views" ::: Vector View) IO (Ptr ViewState)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b. ToCStruct ViewState => (Ptr ViewState -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @ViewState)
  "viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32)
pViewCountOutput <- ((("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32))
  -> IO (Result, ViewState, "views" ::: Vector View))
 -> IO (Result, ViewState, "views" ::: Vector View))
-> ContT
     (Result, ViewState, "views" ::: Vector View)
     IO
     ("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32))
   -> IO (Result, ViewState, "views" ::: Vector View))
  -> IO (Result, ViewState, "views" ::: Vector View))
 -> ContT
      (Result, ViewState, "views" ::: Vector View)
      IO
      ("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32)))
-> ((("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32))
     -> IO (Result, ViewState, "views" ::: Vector View))
    -> IO (Result, ViewState, "views" ::: Vector View))
-> ContT
     (Result, ViewState, "views" ::: Vector View)
     IO
     ("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32))
forall a b. (a -> b) -> a -> b
$ IO ("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32))
-> (("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32))
    -> IO ())
-> (("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32))
    -> IO (Result, ViewState, "views" ::: Vector View))
-> IO (Result, ViewState, "views" ::: Vector View)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int
-> IO ("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32))
forall a. Int -> IO (Ptr a)
callocBytes @Word32 4) ("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32))
-> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result
-> ContT (Result, ViewState, "views" ::: Vector View) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT (Result, ViewState, "views" ::: Vector View) IO Result)
-> IO Result
-> ContT (Result, ViewState, "views" ::: Vector View) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrLocateViews" (Ptr Session_T
-> Ptr ViewLocateInfo
-> Ptr ViewState
-> ("viewCapacityInput" ::: Word32)
-> ("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32))
-> ("views" ::: Ptr View)
-> IO Result
xrLocateViews' Ptr Session_T
session' Ptr ViewLocateInfo
viewLocateInfo' (Ptr ViewState
pViewState) (0) ("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32)
pViewCountOutput) ("views" ::: Ptr View
forall a. Ptr a
nullPtr))
  IO () -> ContT (Result, ViewState, "views" ::: Vector View) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, ViewState, "views" ::: Vector View) IO ())
-> IO ()
-> ContT (Result, ViewState, "views" ::: Vector View) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))
  "viewCapacityInput" ::: Word32
viewCountOutput <- IO ("viewCapacityInput" ::: Word32)
-> ContT
     (Result, ViewState, "views" ::: Vector View)
     IO
     ("viewCapacityInput" ::: Word32)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("viewCapacityInput" ::: Word32)
 -> ContT
      (Result, ViewState, "views" ::: Vector View)
      IO
      ("viewCapacityInput" ::: Word32))
-> IO ("viewCapacityInput" ::: Word32)
-> ContT
     (Result, ViewState, "views" ::: Vector View)
     IO
     ("viewCapacityInput" ::: Word32)
forall a b. (a -> b) -> a -> b
$ ("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32))
-> IO ("viewCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 "viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32)
pViewCountOutput
  "views" ::: Ptr View
pViews <- ((("views" ::: Ptr View)
  -> IO (Result, ViewState, "views" ::: Vector View))
 -> IO (Result, ViewState, "views" ::: Vector View))
-> ContT
     (Result, ViewState, "views" ::: Vector View)
     IO
     ("views" ::: Ptr View)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("views" ::: Ptr View)
   -> IO (Result, ViewState, "views" ::: Vector View))
  -> IO (Result, ViewState, "views" ::: Vector View))
 -> ContT
      (Result, ViewState, "views" ::: Vector View)
      IO
      ("views" ::: Ptr View))
-> ((("views" ::: Ptr View)
     -> IO (Result, ViewState, "views" ::: Vector View))
    -> IO (Result, ViewState, "views" ::: Vector View))
-> ContT
     (Result, ViewState, "views" ::: Vector View)
     IO
     ("views" ::: Ptr View)
forall a b. (a -> b) -> a -> b
$ IO ("views" ::: Ptr View)
-> (("views" ::: Ptr View) -> IO ())
-> (("views" ::: Ptr View)
    -> IO (Result, ViewState, "views" ::: Vector View))
-> IO (Result, ViewState, "views" ::: Vector View)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("views" ::: Ptr View)
forall a. Int -> IO (Ptr a)
callocBytes @View ((("viewCapacityInput" ::: Word32) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ("viewCapacityInput" ::: Word32
viewCountOutput)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 64)) ("views" ::: Ptr View) -> IO ()
forall a. Ptr a -> IO ()
free
  [()]
_ <- (Int -> ContT (Result, ViewState, "views" ::: Vector View) IO ())
-> [Int]
-> ContT (Result, ViewState, "views" ::: Vector View) IO [()]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\i :: Int
i -> ((() -> IO (Result, ViewState, "views" ::: Vector View))
 -> IO (Result, ViewState, "views" ::: Vector View))
-> ContT (Result, ViewState, "views" ::: Vector View) IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO (Result, ViewState, "views" ::: Vector View))
  -> IO (Result, ViewState, "views" ::: Vector View))
 -> ContT (Result, ViewState, "views" ::: Vector View) IO ())
-> ((() -> IO (Result, ViewState, "views" ::: Vector View))
    -> IO (Result, ViewState, "views" ::: Vector View))
-> ContT (Result, ViewState, "views" ::: Vector View) IO ()
forall a b. (a -> b) -> a -> b
$ ("views" ::: Ptr View)
-> IO (Result, ViewState, "views" ::: Vector View)
-> IO (Result, ViewState, "views" ::: Vector View)
forall a b. ToCStruct a => Ptr a -> IO b -> IO b
pokeZeroCStruct ("views" ::: Ptr View
pViews ("views" ::: Ptr View) -> Int -> "views" ::: Ptr View
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* 64) :: Ptr View) (IO (Result, ViewState, "views" ::: Vector View)
 -> IO (Result, ViewState, "views" ::: Vector View))
-> ((() -> IO (Result, ViewState, "views" ::: Vector View))
    -> IO (Result, ViewState, "views" ::: Vector View))
-> (() -> IO (Result, ViewState, "views" ::: Vector View))
-> IO (Result, ViewState, "views" ::: Vector View)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO (Result, ViewState, "views" ::: Vector View))
-> () -> IO (Result, ViewState, "views" ::: Vector View)
forall a b. (a -> b) -> a -> b
$ ())) [0..(("viewCapacityInput" ::: Word32) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ("viewCapacityInput" ::: Word32
viewCountOutput)) Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1]
  Result
r' <- IO Result
-> ContT (Result, ViewState, "views" ::: Vector View) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT (Result, ViewState, "views" ::: Vector View) IO Result)
-> IO Result
-> ContT (Result, ViewState, "views" ::: Vector View) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrLocateViews" (Ptr Session_T
-> Ptr ViewLocateInfo
-> Ptr ViewState
-> ("viewCapacityInput" ::: Word32)
-> ("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32))
-> ("views" ::: Ptr View)
-> IO Result
xrLocateViews' Ptr Session_T
session' Ptr ViewLocateInfo
viewLocateInfo' (Ptr ViewState
pViewState) (("viewCapacityInput" ::: Word32
viewCountOutput)) ("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32)
pViewCountOutput) (("views" ::: Ptr View
pViews)))
  IO () -> ContT (Result, ViewState, "views" ::: Vector View) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, ViewState, "views" ::: Vector View) IO ())
-> IO ()
-> ContT (Result, ViewState, "views" ::: Vector View) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r' Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r'))
  ViewState
viewState <- IO ViewState
-> ContT (Result, ViewState, "views" ::: Vector View) IO ViewState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ViewState
 -> ContT (Result, ViewState, "views" ::: Vector View) IO ViewState)
-> IO ViewState
-> ContT (Result, ViewState, "views" ::: Vector View) IO ViewState
forall a b. (a -> b) -> a -> b
$ Ptr ViewState -> IO ViewState
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ViewState Ptr ViewState
pViewState
  "viewCapacityInput" ::: Word32
viewCountOutput' <- IO ("viewCapacityInput" ::: Word32)
-> ContT
     (Result, ViewState, "views" ::: Vector View)
     IO
     ("viewCapacityInput" ::: Word32)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("viewCapacityInput" ::: Word32)
 -> ContT
      (Result, ViewState, "views" ::: Vector View)
      IO
      ("viewCapacityInput" ::: Word32))
-> IO ("viewCapacityInput" ::: Word32)
-> ContT
     (Result, ViewState, "views" ::: Vector View)
     IO
     ("viewCapacityInput" ::: Word32)
forall a b. (a -> b) -> a -> b
$ ("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32))
-> IO ("viewCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 "viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32)
pViewCountOutput
  "views" ::: Vector View
views' <- IO ("views" ::: Vector View)
-> ContT
     (Result, ViewState, "views" ::: Vector View)
     IO
     ("views" ::: Vector View)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("views" ::: Vector View)
 -> ContT
      (Result, ViewState, "views" ::: Vector View)
      IO
      ("views" ::: Vector View))
-> IO ("views" ::: Vector View)
-> ContT
     (Result, ViewState, "views" ::: Vector View)
     IO
     ("views" ::: Vector View)
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> IO View) -> IO ("views" ::: Vector View)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (("viewCapacityInput" ::: Word32) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ("viewCapacityInput" ::: Word32
viewCountOutput')) (\i :: Int
i -> ("views" ::: Ptr View) -> IO View
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @View ((("views" ::: Ptr View
pViews) ("views" ::: Ptr View) -> Int -> "views" ::: Ptr View
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (64 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr View)))
  (Result, ViewState, "views" ::: Vector View)
-> ContT
     (Result, ViewState, "views" ::: Vector View)
     IO
     (Result, ViewState, "views" ::: Vector View)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result, ViewState, "views" ::: Vector View)
 -> ContT
      (Result, ViewState, "views" ::: Vector View)
      IO
      (Result, ViewState, "views" ::: Vector View))
-> (Result, ViewState, "views" ::: Vector View)
-> ContT
     (Result, ViewState, "views" ::: Vector View)
     IO
     (Result, ViewState, "views" ::: Vector View)
forall a b. (a -> b) -> a -> b
$ ((Result
r'), ViewState
viewState, "views" ::: Vector View
views')


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrEndFrame
  :: FunPtr (Ptr Session_T -> Ptr (SomeStruct FrameEndInfo) -> IO Result) -> Ptr Session_T -> Ptr (SomeStruct FrameEndInfo) -> IO Result

-- | xrEndFrame - Marks a frame
--
-- == Parameter Descriptions
--
-- = Description
--
-- 'endFrame' /may/ return immediately to the application.
-- 'FrameEndInfo'::@displayTime@ /should/ be computed using values returned
-- by 'waitFrame'. The runtime /should/ be robust against variations in the
-- timing of calls to 'waitFrame', since a pipelined system may call
-- 'waitFrame' on a separate thread from 'beginFrame' and 'endFrame'
-- without any synchronization guarantees.
--
-- Note
--
-- An accurate predicted display time is very important to avoid black
-- pull-in by reprojection and to reduce motion judder in case the runtime
-- does not implement a translational reprojection. Reprojection should
-- never display images before the display refresh period they were
-- predicted for, even if they are completed early, because this will cause
-- motion judder just the same. In other words, the better the predicted
-- display time, the less latency experienced by the user.
--
-- Every call to 'endFrame' /must/ be preceded by a successful call to
-- 'beginFrame'. Failure to do so /must/ result in
-- 'OpenXR.Core10.Enums.Result.ERROR_CALL_ORDER_INVALID' being returned by
-- 'endFrame'. 'FrameEndInfo' /may/ reference swapchains into which the
-- application has rendered for this frame. From each
-- 'OpenXR.Core10.Handles.Swapchain' only one image index is implicitly
-- referenced per frame, the one corresponding to the last call to
-- 'OpenXR.Core10.Image.releaseSwapchainImage'. However, a specific
-- swapchain (and by extension a specific swapchain image index) /may/ be
-- referenced in 'FrameEndInfo' multiple times. This can be used for
-- example to render a side by side image into a single swapchain image and
-- referencing it twice with differing image rectangles in different
-- layers.
--
-- If no layers are provided then the display /must/ be cleared.
--
-- 'OpenXR.Core10.Enums.Result.ERROR_LAYER_INVALID' /must/ be returned if
-- an unknown, unsupported layer type, or @NULL@ pointer is passed as one
-- of the 'FrameEndInfo'::layers.
--
-- 'OpenXR.Core10.Enums.Result.ERROR_LAYER_INVALID' /must/ be returned if a
-- layer references a swapchain that has no released swapchain image.
--
-- 'OpenXR.Core10.Enums.Result.ERROR_LAYER_LIMIT_EXCEEDED' /must/ be
-- returned if 'FrameEndInfo'::layerCount exceeds
-- 'OpenXR.Core10.Device.SystemGraphicsProperties'::maxLayerCount or if the
-- runtime is unable to composite the specified layers due to resource
-- constraints.
--
-- 'OpenXR.Core10.Enums.Result.ERROR_SWAPCHAIN_RECT_INVALID' /must/ be
-- returned if 'FrameEndInfo'::layers contains a composition layer which
-- references pixels outside of the associated swapchain image or if
-- negatively sized.
--
-- 'OpenXR.Core10.Enums.Result.ERROR_ENVIRONMENT_BLEND_MODE_UNSUPPORTED'
-- /must/ be returned if 'FrameEndInfo'::environmentBlendMode is not
-- supported.
--
-- 'OpenXR.Core10.Enums.Result.ERROR_SESSION_NOT_RUNNING' /must/ be
-- returned if the @session@
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#session_not_running is not running>.
--
-- Note
--
-- Applications should discard frames for which 'endFrame' returns a
-- recoverable error over attempting to resubmit the frame with different
-- frame parameters to provide a more consistent experience across
-- different runtime implementations.
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
--     -   'OpenXR.Core10.Enums.Result.SESSION_LOSS_PENDING'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_CALL_ORDER_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_LAYER_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SWAPCHAIN_RECT_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_ENVIRONMENT_BLEND_MODE_UNSUPPORTED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_NOT_RUNNING'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_LAYER_LIMIT_EXCEEDED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_TIME_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_POSE_INVALID'
--
-- = See Also
--
-- 'FrameEndInfo', 'OpenXR.Core10.Handles.Session', 'beginFrame',
-- 'waitFrame'
endFrame :: forall a io
          . (Extendss FrameEndInfo a, PokeChain a, MonadIO io)
         => -- | @session@ is a valid 'OpenXR.Core10.Handles.Session' handle.
            --
            -- #VUID-xrEndFrame-session-parameter# @session@ /must/ be a valid
            -- 'OpenXR.Core10.Handles.Session' handle
            Session
         -> -- | @frameEndInfo@ is a pointer to a valid 'FrameEndInfo'.
            --
            -- #VUID-xrEndFrame-frameEndInfo-parameter# @frameEndInfo@ /must/ be a
            -- pointer to a valid 'FrameEndInfo' structure
            (FrameEndInfo a)
         -> io (Result)
endFrame :: Session -> FrameEndInfo a -> io Result
endFrame session :: Session
session frameEndInfo :: FrameEndInfo a
frameEndInfo = IO Result -> io Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> io Result)
-> (ContT Result IO Result -> IO Result)
-> ContT Result IO Result
-> io Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Result IO Result -> IO Result
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Result IO Result -> io Result)
-> ContT Result IO Result -> io Result
forall a b. (a -> b) -> a -> b
$ do
  let xrEndFramePtr :: FunPtr
  (Ptr Session_T
   -> ("frameEndInfo" ::: Ptr (SomeStruct FrameEndInfo)) -> IO Result)
xrEndFramePtr = InstanceCmds
-> FunPtr
     (Ptr Session_T
      -> ("frameEndInfo" ::: Ptr (SomeStruct FrameEndInfo)) -> IO Result)
pXrEndFrame (Session -> InstanceCmds
instanceCmds (Session
session :: Session))
  IO () -> ContT Result IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Result IO ()) -> IO () -> ContT Result IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Session_T
   -> ("frameEndInfo" ::: Ptr (SomeStruct FrameEndInfo)) -> IO Result)
xrEndFramePtr FunPtr
  (Ptr Session_T
   -> ("frameEndInfo" ::: Ptr (SomeStruct FrameEndInfo)) -> IO Result)
-> FunPtr
     (Ptr Session_T
      -> ("frameEndInfo" ::: Ptr (SomeStruct FrameEndInfo)) -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Session_T
   -> ("frameEndInfo" ::: Ptr (SomeStruct FrameEndInfo)) -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for xrEndFrame is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrEndFrame' :: Ptr Session_T
-> ("frameEndInfo" ::: Ptr (SomeStruct FrameEndInfo)) -> IO Result
xrEndFrame' = FunPtr
  (Ptr Session_T
   -> ("frameEndInfo" ::: Ptr (SomeStruct FrameEndInfo)) -> IO Result)
-> Ptr Session_T
-> ("frameEndInfo" ::: Ptr (SomeStruct FrameEndInfo))
-> IO Result
mkXrEndFrame FunPtr
  (Ptr Session_T
   -> ("frameEndInfo" ::: Ptr (SomeStruct FrameEndInfo)) -> IO Result)
xrEndFramePtr
  Ptr (FrameEndInfo a)
frameEndInfo' <- ((Ptr (FrameEndInfo a) -> IO Result) -> IO Result)
-> ContT Result IO (Ptr (FrameEndInfo a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (FrameEndInfo a) -> IO Result) -> IO Result)
 -> ContT Result IO (Ptr (FrameEndInfo a)))
-> ((Ptr (FrameEndInfo a) -> IO Result) -> IO Result)
-> ContT Result IO (Ptr (FrameEndInfo a))
forall a b. (a -> b) -> a -> b
$ FrameEndInfo a -> (Ptr (FrameEndInfo a) -> IO Result) -> IO Result
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (FrameEndInfo a
frameEndInfo)
  Result
r <- IO Result -> ContT Result IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT Result IO Result)
-> IO Result -> ContT Result IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrEndFrame" (Ptr Session_T
-> ("frameEndInfo" ::: Ptr (SomeStruct FrameEndInfo)) -> IO Result
xrEndFrame' (Session -> Ptr Session_T
sessionHandle (Session
session)) (Ptr (FrameEndInfo a)
-> "frameEndInfo" ::: Ptr (SomeStruct FrameEndInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (FrameEndInfo a)
frameEndInfo'))
  IO () -> ContT Result IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Result IO ()) -> IO () -> ContT Result IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))
  Result -> ContT Result IO Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> ContT Result IO Result)
-> Result -> ContT Result IO Result
forall a b. (a -> b) -> a -> b
$ (Result
r)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrWaitFrameUnsafe
  :: FunPtr (Ptr Session_T -> Ptr FrameWaitInfo -> Ptr (SomeStruct FrameState) -> IO Result) -> Ptr Session_T -> Ptr FrameWaitInfo -> Ptr (SomeStruct FrameState) -> IO Result

foreign import ccall
  "dynamic" mkXrWaitFrameSafe
  :: FunPtr (Ptr Session_T -> Ptr FrameWaitInfo -> Ptr (SomeStruct FrameState) -> IO Result) -> Ptr Session_T -> Ptr FrameWaitInfo -> Ptr (SomeStruct FrameState) -> IO Result

-- | waitFrame with selectable safeness
waitFrameSafeOrUnsafe :: forall a io
                       . (Extendss FrameState a, PokeChain a, PeekChain a, MonadIO io)
                      => (FunPtr (Ptr Session_T -> Ptr FrameWaitInfo -> Ptr (SomeStruct FrameState) -> IO Result) -> Ptr Session_T -> Ptr FrameWaitInfo -> Ptr (SomeStruct FrameState) -> IO Result)
                      -> -- | @session@ is a valid 'OpenXR.Core10.Handles.Session' handle.
                         Session
                      -> -- | @frameWaitInfo@ exists for extensibility purposes, it is @NULL@ or a
                         -- pointer to a valid 'FrameWaitInfo'.
                         ("frameWaitInfo" ::: Maybe FrameWaitInfo)
                      -> io (Result, FrameState a)
waitFrameSafeOrUnsafe :: (FunPtr
   (Ptr Session_T
    -> Ptr FrameWaitInfo -> Ptr (SomeStruct FrameState) -> IO Result)
 -> Ptr Session_T
 -> Ptr FrameWaitInfo
 -> Ptr (SomeStruct FrameState)
 -> IO Result)
-> Session
-> ("frameWaitInfo" ::: Maybe FrameWaitInfo)
-> io (Result, FrameState a)
waitFrameSafeOrUnsafe mkXrWaitFrame :: FunPtr
  (Ptr Session_T
   -> Ptr FrameWaitInfo -> Ptr (SomeStruct FrameState) -> IO Result)
-> Ptr Session_T
-> Ptr FrameWaitInfo
-> Ptr (SomeStruct FrameState)
-> IO Result
mkXrWaitFrame session :: Session
session frameWaitInfo :: "frameWaitInfo" ::: Maybe FrameWaitInfo
frameWaitInfo = IO (Result, FrameState a) -> io (Result, FrameState a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result, FrameState a) -> io (Result, FrameState a))
-> (ContT (Result, FrameState a) IO (Result, FrameState a)
    -> IO (Result, FrameState a))
-> ContT (Result, FrameState a) IO (Result, FrameState a)
-> io (Result, FrameState a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT (Result, FrameState a) IO (Result, FrameState a)
-> IO (Result, FrameState a)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT (Result, FrameState a) IO (Result, FrameState a)
 -> io (Result, FrameState a))
-> ContT (Result, FrameState a) IO (Result, FrameState a)
-> io (Result, FrameState a)
forall a b. (a -> b) -> a -> b
$ do
  let xrWaitFramePtr :: FunPtr
  (Ptr Session_T
   -> Ptr FrameWaitInfo -> Ptr (SomeStruct FrameState) -> IO Result)
xrWaitFramePtr = InstanceCmds
-> FunPtr
     (Ptr Session_T
      -> Ptr FrameWaitInfo -> Ptr (SomeStruct FrameState) -> IO Result)
pXrWaitFrame (Session -> InstanceCmds
instanceCmds (Session
session :: Session))
  IO () -> ContT (Result, FrameState a) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, FrameState a) IO ())
-> IO () -> ContT (Result, FrameState a) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Session_T
   -> Ptr FrameWaitInfo -> Ptr (SomeStruct FrameState) -> IO Result)
xrWaitFramePtr FunPtr
  (Ptr Session_T
   -> Ptr FrameWaitInfo -> Ptr (SomeStruct FrameState) -> IO Result)
-> FunPtr
     (Ptr Session_T
      -> Ptr FrameWaitInfo -> Ptr (SomeStruct FrameState) -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Session_T
   -> Ptr FrameWaitInfo -> Ptr (SomeStruct FrameState) -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for xrWaitFrame is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrWaitFrame' :: Ptr Session_T
-> Ptr FrameWaitInfo -> Ptr (SomeStruct FrameState) -> IO Result
xrWaitFrame' = FunPtr
  (Ptr Session_T
   -> Ptr FrameWaitInfo -> Ptr (SomeStruct FrameState) -> IO Result)
-> Ptr Session_T
-> Ptr FrameWaitInfo
-> Ptr (SomeStruct FrameState)
-> IO Result
mkXrWaitFrame FunPtr
  (Ptr Session_T
   -> Ptr FrameWaitInfo -> Ptr (SomeStruct FrameState) -> IO Result)
xrWaitFramePtr
  Ptr FrameWaitInfo
frameWaitInfo' <- case ("frameWaitInfo" ::: Maybe FrameWaitInfo
frameWaitInfo) of
    Nothing -> Ptr FrameWaitInfo
-> ContT (Result, FrameState a) IO (Ptr FrameWaitInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr FrameWaitInfo
forall a. Ptr a
nullPtr
    Just j :: FrameWaitInfo
j -> ((Ptr FrameWaitInfo -> IO (Result, FrameState a))
 -> IO (Result, FrameState a))
-> ContT (Result, FrameState a) IO (Ptr FrameWaitInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr FrameWaitInfo -> IO (Result, FrameState a))
  -> IO (Result, FrameState a))
 -> ContT (Result, FrameState a) IO (Ptr FrameWaitInfo))
-> ((Ptr FrameWaitInfo -> IO (Result, FrameState a))
    -> IO (Result, FrameState a))
-> ContT (Result, FrameState a) IO (Ptr FrameWaitInfo)
forall a b. (a -> b) -> a -> b
$ FrameWaitInfo
-> (Ptr FrameWaitInfo -> IO (Result, FrameState a))
-> IO (Result, FrameState a)
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (FrameWaitInfo
j)
  Ptr (FrameState a)
pFrameState <- ((Ptr (FrameState a) -> IO (Result, FrameState a))
 -> IO (Result, FrameState a))
-> ContT (Result, FrameState a) IO (Ptr (FrameState a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct (FrameState a) =>
(Ptr (FrameState a) -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @(FrameState _))
  Result
r <- IO Result -> ContT (Result, FrameState a) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT (Result, FrameState a) IO Result)
-> IO Result -> ContT (Result, FrameState a) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrWaitFrame" (Ptr Session_T
-> Ptr FrameWaitInfo -> Ptr (SomeStruct FrameState) -> IO Result
xrWaitFrame' (Session -> Ptr Session_T
sessionHandle (Session
session)) Ptr FrameWaitInfo
frameWaitInfo' (Ptr (FrameState a) -> Ptr (SomeStruct FrameState)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (FrameState a)
pFrameState)))
  IO () -> ContT (Result, FrameState a) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, FrameState a) IO ())
-> IO () -> ContT (Result, FrameState a) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))
  FrameState a
frameState <- IO (FrameState a) -> ContT (Result, FrameState a) IO (FrameState a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (FrameState a)
 -> ContT (Result, FrameState a) IO (FrameState a))
-> IO (FrameState a)
-> ContT (Result, FrameState a) IO (FrameState a)
forall a b. (a -> b) -> a -> b
$ Ptr (FrameState a) -> IO (FrameState a)
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @(FrameState _) Ptr (FrameState a)
pFrameState
  (Result, FrameState a)
-> ContT (Result, FrameState a) IO (Result, FrameState a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result, FrameState a)
 -> ContT (Result, FrameState a) IO (Result, FrameState a))
-> (Result, FrameState a)
-> ContT (Result, FrameState a) IO (Result, FrameState a)
forall a b. (a -> b) -> a -> b
$ (Result
r, FrameState a
frameState)

-- | xrWaitFrame - Frame timing function
--
-- == Parameter Descriptions
--
-- = Description
--
-- 'waitFrame' throttles the application frame loop in order to synchronize
-- application frame submissions with the display. 'waitFrame' returns a
-- predicted display time for the next time that the runtime predicts a
-- composited frame will be displayed. The runtime /may/ affect this
-- computation by changing the return values and throttling of 'waitFrame'
-- in response to feedback from frame submission and completion times in
-- 'endFrame'. An application /must/ eventually match each 'waitFrame' call
-- with one call to 'beginFrame'. A subsequent 'waitFrame' call /must/
-- block until the previous frame has been begun with 'beginFrame' and
-- /must/ unblock independently of the corresponding call to 'endFrame'.
-- When less than one frame interval has passed since the previous return
-- from 'waitFrame', the runtime /should/ block until the beginning of the
-- next frame interval. If more than one frame interval has passed since
-- the last return from 'waitFrame', the runtime /may/ return immediately
-- or block until the beginning of the next frame interval.
--
-- In the case that an application has pipelined frame submissions, the
-- application /should/ compute the appropriate target display time using
-- both the predicted display time and predicted display interval. The
-- application /should/ use the computed target display time when
-- requesting space and view locations for rendering.
--
-- The 'FrameState'::@predictedDisplayTime@ returned by 'waitFrame' /must/
-- be monotonically increasing.
--
-- The runtime /may/ dynamically adjust the start time of the frame
-- interval relative to the display hardware’s refresh cycle to minimize
-- graphics processor contention between the application and the
-- compositor.
--
-- 'waitFrame' /must/ be callable from any thread, including a different
-- thread than 'beginFrame'\/'endFrame' are being called from.
--
-- Calling 'waitFrame' /must/ be externally synchronized by the
-- application, concurrent calls /may/ result in undefined behavior.
--
-- The runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_SESSION_NOT_RUNNING' if the @session@
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#session_not_running is not running>.
--
-- Note
--
-- The engine simulation /should/ advance based on the display time. Every
-- stage in the engine pipeline should use the exact same display time for
-- one particular application-generated frame. An accurate and consistent
-- display time across all stages and threads in the engine pipeline is
-- important to avoid object motion judder. If the application has multiple
-- pipeline stages, the application should pass its computed display time
-- through its pipeline, as 'waitFrame' must be called only once per frame.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-xrWaitFrame-session-parameter# @session@ /must/ be a valid
--     'OpenXR.Core10.Handles.Session' handle
--
-- -   #VUID-xrWaitFrame-frameWaitInfo-parameter# If @frameWaitInfo@ is not
--     @NULL@, @frameWaitInfo@ /must/ be a pointer to a valid
--     'FrameWaitInfo' structure
--
-- -   #VUID-xrWaitFrame-frameState-parameter# @frameState@ /must/ be a
--     pointer to an 'FrameState' structure
--
-- == Thread Safety
--
-- -   Access to the @session@ parameter by any other 'waitFrame' call
--     /must/ be externally synchronized
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
--     -   'OpenXR.Core10.Enums.Result.SESSION_LOSS_PENDING'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_NOT_RUNNING'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
-- = See Also
--
-- 'FrameState', 'FrameWaitInfo', 'OpenXR.Core10.Handles.Session',
-- 'beginFrame', 'endFrame'
waitFrame :: forall a io
           . (Extendss FrameState a, PokeChain a, PeekChain a, MonadIO io)
          => -- | @session@ is a valid 'OpenXR.Core10.Handles.Session' handle.
             Session
          -> -- | @frameWaitInfo@ exists for extensibility purposes, it is @NULL@ or a
             -- pointer to a valid 'FrameWaitInfo'.
             ("frameWaitInfo" ::: Maybe FrameWaitInfo)
          -> io (Result, FrameState a)
waitFrame :: Session
-> ("frameWaitInfo" ::: Maybe FrameWaitInfo)
-> io (Result, FrameState a)
waitFrame = (FunPtr
   (Ptr Session_T
    -> Ptr FrameWaitInfo -> Ptr (SomeStruct FrameState) -> IO Result)
 -> Ptr Session_T
 -> Ptr FrameWaitInfo
 -> Ptr (SomeStruct FrameState)
 -> IO Result)
-> Session
-> ("frameWaitInfo" ::: Maybe FrameWaitInfo)
-> io (Result, FrameState a)
forall (a :: [*]) (io :: * -> *).
(Extendss FrameState a, PokeChain a, PeekChain a, MonadIO io) =>
(FunPtr
   (Ptr Session_T
    -> Ptr FrameWaitInfo -> Ptr (SomeStruct FrameState) -> IO Result)
 -> Ptr Session_T
 -> Ptr FrameWaitInfo
 -> Ptr (SomeStruct FrameState)
 -> IO Result)
-> Session
-> ("frameWaitInfo" ::: Maybe FrameWaitInfo)
-> io (Result, FrameState a)
waitFrameSafeOrUnsafe FunPtr
  (Ptr Session_T
   -> Ptr FrameWaitInfo -> Ptr (SomeStruct FrameState) -> IO Result)
-> Ptr Session_T
-> Ptr FrameWaitInfo
-> Ptr (SomeStruct FrameState)
-> IO Result
mkXrWaitFrameUnsafe

-- | A variant of 'waitFrame' which makes a *safe* FFI call
waitFrameSafe :: forall a io
               . (Extendss FrameState a, PokeChain a, PeekChain a, MonadIO io)
              => -- | @session@ is a valid 'OpenXR.Core10.Handles.Session' handle.
                 Session
              -> -- | @frameWaitInfo@ exists for extensibility purposes, it is @NULL@ or a
                 -- pointer to a valid 'FrameWaitInfo'.
                 ("frameWaitInfo" ::: Maybe FrameWaitInfo)
              -> io (Result, FrameState a)
waitFrameSafe :: Session
-> ("frameWaitInfo" ::: Maybe FrameWaitInfo)
-> io (Result, FrameState a)
waitFrameSafe = (FunPtr
   (Ptr Session_T
    -> Ptr FrameWaitInfo -> Ptr (SomeStruct FrameState) -> IO Result)
 -> Ptr Session_T
 -> Ptr FrameWaitInfo
 -> Ptr (SomeStruct FrameState)
 -> IO Result)
-> Session
-> ("frameWaitInfo" ::: Maybe FrameWaitInfo)
-> io (Result, FrameState a)
forall (a :: [*]) (io :: * -> *).
(Extendss FrameState a, PokeChain a, PeekChain a, MonadIO io) =>
(FunPtr
   (Ptr Session_T
    -> Ptr FrameWaitInfo -> Ptr (SomeStruct FrameState) -> IO Result)
 -> Ptr Session_T
 -> Ptr FrameWaitInfo
 -> Ptr (SomeStruct FrameState)
 -> IO Result)
-> Session
-> ("frameWaitInfo" ::: Maybe FrameWaitInfo)
-> io (Result, FrameState a)
waitFrameSafeOrUnsafe FunPtr
  (Ptr Session_T
   -> Ptr FrameWaitInfo -> Ptr (SomeStruct FrameState) -> IO Result)
-> Ptr Session_T
-> Ptr FrameWaitInfo
-> Ptr (SomeStruct FrameState)
-> IO Result
mkXrWaitFrameSafe


-- | XrView - Struct containing view projection state
--
-- == Member Descriptions
--
-- = Description
--
-- The 'View' structure contains view pose and projection state necessary
-- to render a single projection view in the view configuration.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'OpenXR.Core10.OtherTypes.Fovf', 'OpenXR.Core10.Space.Posef',
-- 'OpenXR.Core10.Enums.StructureType.StructureType', 'ViewLocateInfo',
-- 'ViewState', 'locateViews'
data View = View
  { -- | @pose@ is an 'OpenXR.Core10.Space.Posef' defining the location and
    -- orientation of the view in the @space@ specified by the 'locateViews'
    -- function.
    View -> Posef
pose :: Posef
  , -- | @fov@ is the 'OpenXR.Core10.OtherTypes.Fovf' for the four sides of the
    -- projection.
    View -> Fovf
fov :: Fovf
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (View)
#endif
deriving instance Show View

instance ToCStruct View where
  withCStruct :: View -> (("views" ::: Ptr View) -> IO b) -> IO b
withCStruct x :: View
x f :: ("views" ::: Ptr View) -> IO b
f = Int -> Int -> (("views" ::: Ptr View) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 64 8 ((("views" ::: Ptr View) -> IO b) -> IO b)
-> (("views" ::: Ptr View) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: "views" ::: Ptr View
p -> ("views" ::: Ptr View) -> View -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "views" ::: Ptr View
p View
x (("views" ::: Ptr View) -> IO b
f "views" ::: Ptr View
p)
  pokeCStruct :: ("views" ::: Ptr View) -> View -> IO b -> IO b
pokeCStruct p :: "views" ::: Ptr View
p View{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("views" ::: Ptr View
p ("views" ::: Ptr View) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_VIEW)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("views" ::: Ptr View
p ("views" ::: Ptr View) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Posef -> Posef -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("views" ::: Ptr View
p ("views" ::: Ptr View) -> Int -> Ptr Posef
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Posef)) (Posef
pose)
    Ptr Fovf -> Fovf -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("views" ::: Ptr View
p ("views" ::: Ptr View) -> Int -> Ptr Fovf
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 44 :: Ptr Fovf)) (Fovf
fov)
    IO b
f
  cStructSize :: Int
cStructSize = 64
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: ("views" ::: Ptr View) -> IO b -> IO b
pokeZeroCStruct p :: "views" ::: Ptr View
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("views" ::: Ptr View
p ("views" ::: Ptr View) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_VIEW)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("views" ::: Ptr View
p ("views" ::: Ptr View) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Posef -> Posef -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("views" ::: Ptr View
p ("views" ::: Ptr View) -> Int -> Ptr Posef
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Posef)) (Posef
forall a. Zero a => a
zero)
    Ptr Fovf -> Fovf -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("views" ::: Ptr View
p ("views" ::: Ptr View) -> Int -> Ptr Fovf
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 44 :: Ptr Fovf)) (Fovf
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct View where
  peekCStruct :: ("views" ::: Ptr View) -> IO View
peekCStruct p :: "views" ::: Ptr View
p = do
    Posef
pose <- Ptr Posef -> IO Posef
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Posef (("views" ::: Ptr View
p ("views" ::: Ptr View) -> Int -> Ptr Posef
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Posef))
    Fovf
fov <- Ptr Fovf -> IO Fovf
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Fovf (("views" ::: Ptr View
p ("views" ::: Ptr View) -> Int -> Ptr Fovf
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 44 :: Ptr Fovf))
    View -> IO View
forall (f :: * -> *) a. Applicative f => a -> f a
pure (View -> IO View) -> View -> IO View
forall a b. (a -> b) -> a -> b
$ Posef -> Fovf -> View
View
             Posef
pose Fovf
fov

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

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


-- | XrViewLocateInfo - Struct containing view locate information
--
-- == Member Descriptions
--
-- = Description
--
-- The 'ViewLocateInfo' structure contains the display time and space used
-- to locate the view 'View' structures.
--
-- The runtime /must/ return error
-- 'OpenXR.Core10.Enums.Result.ERROR_VIEW_CONFIGURATION_TYPE_UNSUPPORTED'
-- if the given @viewConfigurationType@ is not one of the supported type
-- reported by
-- 'OpenXR.Core10.ViewConfigurations.enumerateViewConfigurations'.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Space',
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >,
-- 'View',
-- 'OpenXR.Core10.Enums.ViewConfigurationType.ViewConfigurationType',
-- 'ViewState', 'locateViews'
data ViewLocateInfo = ViewLocateInfo
  { -- | @viewConfigurationType@ is
    -- 'OpenXR.Core10.Enums.ViewConfigurationType.ViewConfigurationType' to
    -- query for.
    --
    -- #VUID-XrViewLocateInfo-viewConfigurationType-parameter#
    -- @viewConfigurationType@ /must/ be a valid
    -- 'OpenXR.Core10.Enums.ViewConfigurationType.ViewConfigurationType' value
    ViewLocateInfo -> ViewConfigurationType
viewConfigurationType :: ViewConfigurationType
  , -- | @displayTime@ is the time for which the view poses are predicted.
    ViewLocateInfo -> Time
displayTime :: Time
  , -- | @space@ is the 'OpenXR.Core10.Handles.Space' in which the @pose@ in each
    -- 'View' is expressed.
    --
    -- #VUID-XrViewLocateInfo-space-parameter# @space@ /must/ be a valid
    -- 'OpenXR.Core10.Handles.Space' handle
    ViewLocateInfo -> Ptr Space_T
space :: Ptr Space_T
  }
  deriving (Typeable, ViewLocateInfo -> ViewLocateInfo -> Bool
(ViewLocateInfo -> ViewLocateInfo -> Bool)
-> (ViewLocateInfo -> ViewLocateInfo -> Bool) -> Eq ViewLocateInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ViewLocateInfo -> ViewLocateInfo -> Bool
$c/= :: ViewLocateInfo -> ViewLocateInfo -> Bool
== :: ViewLocateInfo -> ViewLocateInfo -> Bool
$c== :: ViewLocateInfo -> ViewLocateInfo -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ViewLocateInfo)
#endif
deriving instance Show ViewLocateInfo

instance ToCStruct ViewLocateInfo where
  withCStruct :: ViewLocateInfo -> (Ptr ViewLocateInfo -> IO b) -> IO b
withCStruct x :: ViewLocateInfo
x f :: Ptr ViewLocateInfo -> IO b
f = Int -> Int -> (Ptr ViewLocateInfo -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 40 8 ((Ptr ViewLocateInfo -> IO b) -> IO b)
-> (Ptr ViewLocateInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr ViewLocateInfo
p -> Ptr ViewLocateInfo -> ViewLocateInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ViewLocateInfo
p ViewLocateInfo
x (Ptr ViewLocateInfo -> IO b
f Ptr ViewLocateInfo
p)
  pokeCStruct :: Ptr ViewLocateInfo -> ViewLocateInfo -> IO b -> IO b
pokeCStruct p :: Ptr ViewLocateInfo
p ViewLocateInfo{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ViewLocateInfo
p Ptr ViewLocateInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_VIEW_LOCATE_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ViewLocateInfo
p Ptr ViewLocateInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ViewConfigurationType -> ViewConfigurationType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ViewLocateInfo
p Ptr ViewLocateInfo -> Int -> Ptr ViewConfigurationType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr ViewConfigurationType)) (ViewConfigurationType
viewConfigurationType)
    Ptr Time -> Time -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ViewLocateInfo
p Ptr ViewLocateInfo -> Int -> Ptr Time
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Time)) (Time
displayTime)
    Ptr (Ptr Space_T) -> Ptr Space_T -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ViewLocateInfo
p Ptr ViewLocateInfo -> Int -> Ptr (Ptr Space_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr Space_T))) (Ptr Space_T
space)
    IO b
f
  cStructSize :: Int
cStructSize = 40
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr ViewLocateInfo -> IO b -> IO b
pokeZeroCStruct p :: Ptr ViewLocateInfo
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ViewLocateInfo
p Ptr ViewLocateInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_VIEW_LOCATE_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ViewLocateInfo
p Ptr ViewLocateInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ViewConfigurationType -> ViewConfigurationType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ViewLocateInfo
p Ptr ViewLocateInfo -> Int -> Ptr ViewConfigurationType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr ViewConfigurationType)) (ViewConfigurationType
forall a. Zero a => a
zero)
    Ptr Time -> Time -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ViewLocateInfo
p Ptr ViewLocateInfo -> Int -> Ptr Time
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Time)) (Time
forall a. Zero a => a
zero)
    Ptr (Ptr Space_T) -> Ptr Space_T -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ViewLocateInfo
p Ptr ViewLocateInfo -> Int -> Ptr (Ptr Space_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr Space_T))) (Ptr Space_T
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct ViewLocateInfo where
  peekCStruct :: Ptr ViewLocateInfo -> IO ViewLocateInfo
peekCStruct p :: Ptr ViewLocateInfo
p = do
    ViewConfigurationType
viewConfigurationType <- Ptr ViewConfigurationType -> IO ViewConfigurationType
forall a. Storable a => Ptr a -> IO a
peek @ViewConfigurationType ((Ptr ViewLocateInfo
p Ptr ViewLocateInfo -> Int -> Ptr ViewConfigurationType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr ViewConfigurationType))
    Time
displayTime <- Ptr Time -> IO Time
forall a. Storable a => Ptr a -> IO a
peek @Time ((Ptr ViewLocateInfo
p Ptr ViewLocateInfo -> Int -> Ptr Time
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Time))
    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 ViewLocateInfo
p Ptr ViewLocateInfo -> Int -> Ptr (Ptr Space_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr Space_T)))
    ViewLocateInfo -> IO ViewLocateInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ViewLocateInfo -> IO ViewLocateInfo)
-> ViewLocateInfo -> IO ViewLocateInfo
forall a b. (a -> b) -> a -> b
$ ViewConfigurationType -> Time -> Ptr Space_T -> ViewLocateInfo
ViewLocateInfo
             ViewConfigurationType
viewConfigurationType Time
displayTime Ptr Space_T
space

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

instance Zero ViewLocateInfo where
  zero :: ViewLocateInfo
zero = ViewConfigurationType -> Time -> Ptr Space_T -> ViewLocateInfo
ViewLocateInfo
           ViewConfigurationType
forall a. Zero a => a
zero
           Time
forall a. Zero a => a
zero
           Ptr Space_T
forall a. Zero a => a
zero


-- | XrViewState - Struct containing additional view state
--
-- == Member Descriptions
--
-- = Description
--
-- The 'ViewState' contains additional view state from 'locateViews' common
-- to all views of the active view configuration.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'OpenXR.Core10.Enums.StructureType.StructureType', 'View',
-- 'OpenXR.Core10.Enums.ViewStateFlags.ViewStateFlags', 'locateViews'
data ViewState = ViewState
  { -- | @viewStateFlags@ is a bitmask of
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrViewStateFlagBits XrViewStateFlagBits>
    -- indicating state for all views.
    --
    -- #VUID-XrViewState-viewStateFlags-parameter# @viewStateFlags@ /must/ be
    -- @0@ or a valid combination of
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrViewStateFlagBits XrViewStateFlagBits>
    -- values
    ViewState -> ViewStateFlags
viewStateFlags :: ViewStateFlags }
  deriving (Typeable, ViewState -> ViewState -> Bool
(ViewState -> ViewState -> Bool)
-> (ViewState -> ViewState -> Bool) -> Eq ViewState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ViewState -> ViewState -> Bool
$c/= :: ViewState -> ViewState -> Bool
== :: ViewState -> ViewState -> Bool
$c== :: ViewState -> ViewState -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ViewState)
#endif
deriving instance Show ViewState

instance ToCStruct ViewState where
  withCStruct :: ViewState -> (Ptr ViewState -> IO b) -> IO b
withCStruct x :: ViewState
x f :: Ptr ViewState -> IO b
f = Int -> Int -> (Ptr ViewState -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 24 8 ((Ptr ViewState -> IO b) -> IO b)
-> (Ptr ViewState -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr ViewState
p -> Ptr ViewState -> ViewState -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ViewState
p ViewState
x (Ptr ViewState -> IO b
f Ptr ViewState
p)
  pokeCStruct :: Ptr ViewState -> ViewState -> IO b -> IO b
pokeCStruct p :: Ptr ViewState
p ViewState{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ViewState
p Ptr ViewState -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_VIEW_STATE)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ViewState
p Ptr ViewState -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ViewStateFlags -> ViewStateFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ViewState
p Ptr ViewState -> Int -> Ptr ViewStateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr ViewStateFlags)) (ViewStateFlags
viewStateFlags)
    IO b
f
  cStructSize :: Int
cStructSize = 24
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr ViewState -> IO b -> IO b
pokeZeroCStruct p :: Ptr ViewState
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ViewState
p Ptr ViewState -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_VIEW_STATE)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ViewState
p Ptr ViewState -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO b
f

instance FromCStruct ViewState where
  peekCStruct :: Ptr ViewState -> IO ViewState
peekCStruct p :: Ptr ViewState
p = do
    ViewStateFlags
viewStateFlags <- Ptr ViewStateFlags -> IO ViewStateFlags
forall a. Storable a => Ptr a -> IO a
peek @ViewStateFlags ((Ptr ViewState
p Ptr ViewState -> Int -> Ptr ViewStateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr ViewStateFlags))
    ViewState -> IO ViewState
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ViewState -> IO ViewState) -> ViewState -> IO ViewState
forall a b. (a -> b) -> a -> b
$ ViewStateFlags -> ViewState
ViewState
             ViewStateFlags
viewStateFlags

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

instance Zero ViewState where
  zero :: ViewState
zero = ViewStateFlags -> ViewState
ViewState
           ViewStateFlags
forall a. Zero a => a
zero


-- | XrFrameBeginInfo - Begin frame information
--
-- == Member Descriptions
--
-- = Description
--
-- Because this structure only exists to support extension-specific
-- structures, 'beginFrame' will accept a @NULL@ argument for
-- @frameBeginInfo@ for applications that are not using any relevant
-- extensions.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'OpenXR.Core10.Enums.StructureType.StructureType', 'beginFrame',
-- 'waitFrame'
data FrameBeginInfo = FrameBeginInfo
  {}
  deriving (Typeable, FrameBeginInfo -> FrameBeginInfo -> Bool
(FrameBeginInfo -> FrameBeginInfo -> Bool)
-> (FrameBeginInfo -> FrameBeginInfo -> Bool) -> Eq FrameBeginInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FrameBeginInfo -> FrameBeginInfo -> Bool
$c/= :: FrameBeginInfo -> FrameBeginInfo -> Bool
== :: FrameBeginInfo -> FrameBeginInfo -> Bool
$c== :: FrameBeginInfo -> FrameBeginInfo -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (FrameBeginInfo)
#endif
deriving instance Show FrameBeginInfo

instance ToCStruct FrameBeginInfo where
  withCStruct :: FrameBeginInfo -> (Ptr FrameBeginInfo -> IO b) -> IO b
withCStruct x :: FrameBeginInfo
x f :: Ptr FrameBeginInfo -> IO b
f = Int -> Int -> (Ptr FrameBeginInfo -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 16 8 ((Ptr FrameBeginInfo -> IO b) -> IO b)
-> (Ptr FrameBeginInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr FrameBeginInfo
p -> Ptr FrameBeginInfo -> FrameBeginInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr FrameBeginInfo
p FrameBeginInfo
x (Ptr FrameBeginInfo -> IO b
f Ptr FrameBeginInfo
p)
  pokeCStruct :: Ptr FrameBeginInfo -> FrameBeginInfo -> IO b -> IO b
pokeCStruct p :: Ptr FrameBeginInfo
p FrameBeginInfo f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FrameBeginInfo
p Ptr FrameBeginInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_FRAME_BEGIN_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FrameBeginInfo
p Ptr FrameBeginInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO b
f
  cStructSize :: Int
cStructSize = 16
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr FrameBeginInfo -> IO b -> IO b
pokeZeroCStruct p :: Ptr FrameBeginInfo
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FrameBeginInfo
p Ptr FrameBeginInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_FRAME_BEGIN_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FrameBeginInfo
p Ptr FrameBeginInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO b
f

instance FromCStruct FrameBeginInfo where
  peekCStruct :: Ptr FrameBeginInfo -> IO FrameBeginInfo
peekCStruct _ = FrameBeginInfo -> IO FrameBeginInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FrameBeginInfo -> IO FrameBeginInfo)
-> FrameBeginInfo -> IO FrameBeginInfo
forall a b. (a -> b) -> a -> b
$ FrameBeginInfo
FrameBeginInfo
                           

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

instance Zero FrameBeginInfo where
  zero :: FrameBeginInfo
zero = FrameBeginInfo
FrameBeginInfo
           


-- | XrFrameEndInfo - End frame information
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrFrameEndInfo-type-type# @type@ /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_FRAME_END_INFO'
--
-- -   #VUID-XrFrameEndInfo-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.Extensions.XR_MSFT_secondary_view_configuration.SecondaryViewConfigurationFrameEndInfoMSFT'
--
-- -   #VUID-XrFrameEndInfo-environmentBlendMode-parameter#
--     @environmentBlendMode@ /must/ be a valid
--     'OpenXR.Core10.Enums.EnvironmentBlendMode.EnvironmentBlendMode'
--     value
--
-- -   #VUID-XrFrameEndInfo-layers-parameter# If @layerCount@ is not @0@,
--     @layers@ /must/ be a pointer to an array of @layerCount@ valid
--     'OpenXR.Core10.OtherTypes.CompositionLayerBaseHeader'-based
--     structures. See also:
--     'OpenXR.Extensions.XR_KHR_composition_layer_cube.CompositionLayerCubeKHR',
--     'OpenXR.Extensions.XR_KHR_composition_layer_cylinder.CompositionLayerCylinderKHR',
--     'OpenXR.Extensions.XR_KHR_composition_layer_equirect2.CompositionLayerEquirect2KHR',
--     'OpenXR.Extensions.XR_KHR_composition_layer_equirect.CompositionLayerEquirectKHR',
--     'OpenXR.Core10.OtherTypes.CompositionLayerProjection',
--     'OpenXR.Core10.OtherTypes.CompositionLayerQuad'
--
-- = See Also
--
-- 'OpenXR.Core10.OtherTypes.CompositionLayerBaseHeader',
-- 'OpenXR.Core10.Enums.EnvironmentBlendMode.EnvironmentBlendMode',
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >,
-- 'endFrame'
data FrameEndInfo (es :: [Type]) = FrameEndInfo
  { -- | @next@ is @NULL@ or a pointer to the next structure in a structure
    -- chain. No such structures are defined in core OpenXR.
    FrameEndInfo es -> Chain es
next :: Chain es
  , -- | @displayTime@ is the
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >
    -- at which this frame /should/ be displayed.
    FrameEndInfo es -> Time
displayTime :: Time
  , -- | @environmentBlendMode@ is the
    -- 'OpenXR.Core10.Enums.EnvironmentBlendMode.EnvironmentBlendMode' value
    -- representing the desired
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#environment_blend_mode environment blend mode>
    -- for this frame.
    FrameEndInfo es -> EnvironmentBlendMode
environmentBlendMode :: EnvironmentBlendMode
  , -- | @layerCount@ is the number of composition layers in this frame. The
    -- maximum supported layer count is identified by
    -- 'OpenXR.Core10.Device.SystemGraphicsProperties'::maxLayerCount. If
    -- layerCount is greater than the maximum supported layer count then
    -- 'OpenXR.Core10.Enums.Result.ERROR_LAYER_LIMIT_EXCEEDED' /must/ be
    -- returned.
    FrameEndInfo es -> "viewCapacityInput" ::: Word32
layerCount :: Word32
  , -- | @layers@ is a pointer to an array of
    -- 'OpenXR.Core10.OtherTypes.CompositionLayerBaseHeader' pointers.
    FrameEndInfo es
-> Vector (SomeChild (CompositionLayerBaseHeader '[]))
layers :: Vector (SomeChild (CompositionLayerBaseHeader '[]))
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (FrameEndInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (FrameEndInfo es)

instance Extensible FrameEndInfo where
  extensibleTypeName :: String
extensibleTypeName = "FrameEndInfo"
  setNext :: FrameEndInfo ds -> Chain es -> FrameEndInfo es
setNext x :: FrameEndInfo ds
x next :: Chain es
next = FrameEndInfo ds
x{$sel:next:FrameEndInfo :: Chain es
next = Chain es
next}
  getNext :: FrameEndInfo es -> Chain es
getNext FrameEndInfo{..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends FrameEndInfo e => b) -> Maybe b
  extends :: proxy e -> (Extends FrameEndInfo e => b) -> Maybe b
extends _ f :: Extends FrameEndInfo e => b
f
    | Just Refl <- (Typeable e,
 Typeable SecondaryViewConfigurationFrameEndInfoMSFT) =>
Maybe (e :~: SecondaryViewConfigurationFrameEndInfoMSFT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @SecondaryViewConfigurationFrameEndInfoMSFT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends FrameEndInfo e => b
f
    | Bool
otherwise = Maybe b
forall a. Maybe a
Nothing

instance (Extendss FrameEndInfo es, PokeChain es) => ToCStruct (FrameEndInfo es) where
  withCStruct :: FrameEndInfo es -> (Ptr (FrameEndInfo es) -> IO b) -> IO b
withCStruct x :: FrameEndInfo es
x f :: Ptr (FrameEndInfo es) -> IO b
f = Int -> Int -> (Ptr (FrameEndInfo es) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 40 8 ((Ptr (FrameEndInfo es) -> IO b) -> IO b)
-> (Ptr (FrameEndInfo es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr (FrameEndInfo es)
p -> Ptr (FrameEndInfo es) -> FrameEndInfo es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (FrameEndInfo es)
p FrameEndInfo es
x (Ptr (FrameEndInfo es) -> IO b
f Ptr (FrameEndInfo es)
p)
  pokeCStruct :: Ptr (FrameEndInfo es) -> FrameEndInfo es -> IO b -> IO b
pokeCStruct p :: Ptr (FrameEndInfo es)
p FrameEndInfo{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (FrameEndInfo es)
p Ptr (FrameEndInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_FRAME_END_INFO)
    Ptr ()
next'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (FrameEndInfo es)
p Ptr (FrameEndInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
next''
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Time -> Time -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (FrameEndInfo es)
p Ptr (FrameEndInfo es) -> Int -> Ptr Time
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Time)) (Time
displayTime)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr EnvironmentBlendMode -> EnvironmentBlendMode -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (FrameEndInfo es)
p Ptr (FrameEndInfo es) -> Int -> Ptr EnvironmentBlendMode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr EnvironmentBlendMode)) (EnvironmentBlendMode
environmentBlendMode)
    let layersLength :: Int
layersLength = Vector (SomeChild (CompositionLayerBaseHeader '[])) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (SomeChild (CompositionLayerBaseHeader '[])) -> Int)
-> Vector (SomeChild (CompositionLayerBaseHeader '[])) -> Int
forall a b. (a -> b) -> a -> b
$ (Vector (SomeChild (CompositionLayerBaseHeader '[]))
layers)
    "viewCapacityInput" ::: Word32
layerCount'' <- IO ("viewCapacityInput" ::: Word32)
-> ContT b IO ("viewCapacityInput" ::: Word32)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("viewCapacityInput" ::: Word32)
 -> ContT b IO ("viewCapacityInput" ::: Word32))
-> IO ("viewCapacityInput" ::: Word32)
-> ContT b IO ("viewCapacityInput" ::: Word32)
forall a b. (a -> b) -> a -> b
$ if ("viewCapacityInput" ::: Word32
layerCount) ("viewCapacityInput" ::: Word32)
-> ("viewCapacityInput" ::: Word32) -> Bool
forall a. Eq a => a -> a -> Bool
== 0
      then ("viewCapacityInput" ::: Word32)
-> IO ("viewCapacityInput" ::: Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("viewCapacityInput" ::: Word32)
 -> IO ("viewCapacityInput" ::: Word32))
-> ("viewCapacityInput" ::: Word32)
-> IO ("viewCapacityInput" ::: Word32)
forall a b. (a -> b) -> a -> b
$ Int -> "viewCapacityInput" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
layersLength
      else do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int -> "viewCapacityInput" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
layersLength ("viewCapacityInput" ::: Word32)
-> ("viewCapacityInput" ::: Word32) -> Bool
forall a. Eq a => a -> a -> Bool
== ("viewCapacityInput" ::: Word32
layerCount) Bool -> Bool -> Bool
|| Int
layersLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "layers must be empty or have 'layerCount' elements" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
        ("viewCapacityInput" ::: Word32)
-> IO ("viewCapacityInput" ::: Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ("viewCapacityInput" ::: Word32
layerCount)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32))
-> ("viewCapacityInput" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (FrameEndInfo es)
p Ptr (FrameEndInfo es)
-> Int
-> "viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 28 :: Ptr Word32)) ("viewCapacityInput" ::: Word32
layerCount'')
    Ptr (Ptr Any)
layers'' <- if Vector (SomeChild (CompositionLayerBaseHeader '[])) -> Bool
forall a. Vector a -> Bool
Data.Vector.null (Vector (SomeChild (CompositionLayerBaseHeader '[]))
layers)
      then Ptr (Ptr Any) -> ContT b IO (Ptr (Ptr Any))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr (Ptr Any)
forall a. Ptr a
nullPtr
      else do
        Ptr (Ptr Any)
pLayers <- ((Ptr (Ptr Any) -> IO b) -> IO b) -> ContT b IO (Ptr (Ptr Any))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Ptr Any) -> IO b) -> IO b) -> ContT b IO (Ptr (Ptr Any)))
-> ((Ptr (Ptr Any) -> IO b) -> IO b) -> ContT b IO (Ptr (Ptr Any))
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr (Ptr Any) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @(Ptr _) (((Vector (SomeChild (CompositionLayerBaseHeader '[])) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (SomeChild (CompositionLayerBaseHeader '[]))
layers))) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) 8
        (Int
 -> SomeChild (CompositionLayerBaseHeader '[]) -> ContT b IO ())
-> Vector (SomeChild (CompositionLayerBaseHeader '[]))
-> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: SomeChild (CompositionLayerBaseHeader '[])
e -> do
          Ptr (SomeChild (CompositionLayerBaseHeader '[]))
layers' <- ((Ptr (SomeChild (CompositionLayerBaseHeader '[])) -> IO b)
 -> IO b)
-> ContT b IO (Ptr (SomeChild (CompositionLayerBaseHeader '[])))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (SomeChild (CompositionLayerBaseHeader '[])) -> IO b)
  -> IO b)
 -> ContT b IO (Ptr (SomeChild (CompositionLayerBaseHeader '[]))))
-> ((Ptr (SomeChild (CompositionLayerBaseHeader '[])) -> IO b)
    -> IO b)
-> ContT b IO (Ptr (SomeChild (CompositionLayerBaseHeader '[])))
forall a b. (a -> b) -> a -> b
$ SomeChild (CompositionLayerBaseHeader '[])
-> (Ptr (SomeChild (CompositionLayerBaseHeader '[])) -> IO b)
-> IO b
forall a b. SomeChild a -> (Ptr (SomeChild a) -> IO b) -> IO b
withSomeChild (SomeChild (CompositionLayerBaseHeader '[])
e)
          IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr (SomeChild (CompositionLayerBaseHeader '[])))
-> Ptr (SomeChild (CompositionLayerBaseHeader '[])) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr (Ptr Any)
pLayers Ptr (Ptr Any) -> Int -> Ptr (Ptr _)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr _)) Ptr (SomeChild (CompositionLayerBaseHeader '[]))
layers') ((Vector (SomeChild (CompositionLayerBaseHeader '[]))
layers))
        Ptr (Ptr Any) -> ContT b IO (Ptr (Ptr Any))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr (Ptr Any) -> ContT b IO (Ptr (Ptr Any)))
-> Ptr (Ptr Any) -> ContT b IO (Ptr (Ptr Any))
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr Any)
pLayers
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr (Ptr Any)) -> Ptr (Ptr Any) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (FrameEndInfo es)
p Ptr (FrameEndInfo es) -> Int -> Ptr (Ptr (Ptr _))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr (Ptr _)))) Ptr (Ptr Any)
layers''
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = 40
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr (FrameEndInfo es) -> IO b -> IO b
pokeZeroCStruct p :: Ptr (FrameEndInfo es)
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (FrameEndInfo es)
p Ptr (FrameEndInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_FRAME_END_INFO)
    Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ forall a. PokeChain es => (Ptr (Chain es) -> IO a) -> IO a
forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (FrameEndInfo es)
p Ptr (FrameEndInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext'
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Time -> Time -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (FrameEndInfo es)
p Ptr (FrameEndInfo es) -> Int -> Ptr Time
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Time)) (Time
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr EnvironmentBlendMode -> EnvironmentBlendMode -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (FrameEndInfo es)
p Ptr (FrameEndInfo es) -> Int -> Ptr EnvironmentBlendMode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr EnvironmentBlendMode)) (EnvironmentBlendMode
forall a. Zero a => a
zero)
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f

instance (Extendss FrameEndInfo es, PeekChain es) => FromCStruct (FrameEndInfo es) where
  peekCStruct :: Ptr (FrameEndInfo es) -> IO (FrameEndInfo es)
peekCStruct p :: Ptr (FrameEndInfo es)
p = do
    Ptr ()
next <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (FrameEndInfo es)
p Ptr (FrameEndInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ())))
    Chain es
next' <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
next)
    Time
displayTime <- Ptr Time -> IO Time
forall a. Storable a => Ptr a -> IO a
peek @Time ((Ptr (FrameEndInfo es)
p Ptr (FrameEndInfo es) -> Int -> Ptr Time
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Time))
    EnvironmentBlendMode
environmentBlendMode <- Ptr EnvironmentBlendMode -> IO EnvironmentBlendMode
forall a. Storable a => Ptr a -> IO a
peek @EnvironmentBlendMode ((Ptr (FrameEndInfo es)
p Ptr (FrameEndInfo es) -> Int -> Ptr EnvironmentBlendMode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr EnvironmentBlendMode))
    "viewCapacityInput" ::: Word32
layerCount <- ("viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32))
-> IO ("viewCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (FrameEndInfo es)
p Ptr (FrameEndInfo es)
-> Int
-> "viewCountOutput" ::: Ptr ("viewCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 28 :: Ptr Word32))
    Ptr (Ptr (SomeChild (CompositionLayerBaseHeader '[])))
layers <- Ptr (Ptr (Ptr (SomeChild (CompositionLayerBaseHeader '[]))))
-> IO (Ptr (Ptr (SomeChild (CompositionLayerBaseHeader '[]))))
forall a. Storable a => Ptr a -> IO a
peek @(Ptr (Ptr _)) ((Ptr (FrameEndInfo es)
p Ptr (FrameEndInfo es) -> Int -> Ptr (Ptr (Ptr _))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr (Ptr _))))
    let layersLength :: Int
layersLength = if Ptr (Ptr (SomeChild (CompositionLayerBaseHeader '[])))
layers Ptr (Ptr (SomeChild (CompositionLayerBaseHeader '[])))
-> Ptr (Ptr (SomeChild (CompositionLayerBaseHeader '[]))) -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr (Ptr (SomeChild (CompositionLayerBaseHeader '[])))
forall a. Ptr a
nullPtr then 0 else (("viewCapacityInput" ::: Word32) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral "viewCapacityInput" ::: Word32
layerCount)
    Vector (SomeChild (CompositionLayerBaseHeader '[]))
layers' <- Int
-> (Int -> IO (SomeChild (CompositionLayerBaseHeader '[])))
-> IO (Vector (SomeChild (CompositionLayerBaseHeader '[])))
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM Int
layersLength (\i :: Int
i -> Ptr (SomeChild (CompositionLayerBaseHeader '[]))
-> IO (SomeChild (CompositionLayerBaseHeader '[]))
forall a. Inheritable a => Ptr (SomeChild a) -> IO (SomeChild a)
peekSomeCChild (Ptr (SomeChild (CompositionLayerBaseHeader '[]))
 -> IO (SomeChild (CompositionLayerBaseHeader '[])))
-> IO (Ptr (SomeChild (CompositionLayerBaseHeader '[])))
-> IO (SomeChild (CompositionLayerBaseHeader '[]))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr (Ptr (SomeChild (CompositionLayerBaseHeader '[])))
-> IO (Ptr (SomeChild (CompositionLayerBaseHeader '[])))
forall a. Storable a => Ptr a -> IO a
peek ((Ptr (Ptr (SomeChild (CompositionLayerBaseHeader '[])))
layers Ptr (Ptr (SomeChild (CompositionLayerBaseHeader '[])))
-> Int -> Ptr (Ptr (SomeChild (CompositionLayerBaseHeader '[])))
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr _))))
    FrameEndInfo es -> IO (FrameEndInfo es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FrameEndInfo es -> IO (FrameEndInfo es))
-> FrameEndInfo es -> IO (FrameEndInfo es)
forall a b. (a -> b) -> a -> b
$ Chain es
-> Time
-> EnvironmentBlendMode
-> ("viewCapacityInput" ::: Word32)
-> Vector (SomeChild (CompositionLayerBaseHeader '[]))
-> FrameEndInfo es
forall (es :: [*]).
Chain es
-> Time
-> EnvironmentBlendMode
-> ("viewCapacityInput" ::: Word32)
-> Vector (SomeChild (CompositionLayerBaseHeader '[]))
-> FrameEndInfo es
FrameEndInfo
             Chain es
next' Time
displayTime EnvironmentBlendMode
environmentBlendMode "viewCapacityInput" ::: Word32
layerCount Vector (SomeChild (CompositionLayerBaseHeader '[]))
layers'

instance es ~ '[] => Zero (FrameEndInfo es) where
  zero :: FrameEndInfo es
zero = Chain es
-> Time
-> EnvironmentBlendMode
-> ("viewCapacityInput" ::: Word32)
-> Vector (SomeChild (CompositionLayerBaseHeader '[]))
-> FrameEndInfo es
forall (es :: [*]).
Chain es
-> Time
-> EnvironmentBlendMode
-> ("viewCapacityInput" ::: Word32)
-> Vector (SomeChild (CompositionLayerBaseHeader '[]))
-> FrameEndInfo es
FrameEndInfo
           ()
           Time
forall a. Zero a => a
zero
           EnvironmentBlendMode
forall a. Zero a => a
zero
           "viewCapacityInput" ::: Word32
forall a. Zero a => a
zero
           Vector (SomeChild (CompositionLayerBaseHeader '[]))
forall a. Monoid a => a
mempty


-- | XrFrameWaitInfo - Wait frame information structure
--
-- == Member Descriptions
--
-- = Description
--
-- Because this structure only exists to support extension-specific
-- structures, 'waitFrame' /must/ accept a @NULL@ argument for
-- @frameWaitInfo@ for applications that are not using any relevant
-- extensions.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'FrameState', 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'waitFrame'
data FrameWaitInfo = FrameWaitInfo
  {}
  deriving (Typeable, FrameWaitInfo -> FrameWaitInfo -> Bool
(FrameWaitInfo -> FrameWaitInfo -> Bool)
-> (FrameWaitInfo -> FrameWaitInfo -> Bool) -> Eq FrameWaitInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FrameWaitInfo -> FrameWaitInfo -> Bool
$c/= :: FrameWaitInfo -> FrameWaitInfo -> Bool
== :: FrameWaitInfo -> FrameWaitInfo -> Bool
$c== :: FrameWaitInfo -> FrameWaitInfo -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (FrameWaitInfo)
#endif
deriving instance Show FrameWaitInfo

instance ToCStruct FrameWaitInfo where
  withCStruct :: FrameWaitInfo -> (Ptr FrameWaitInfo -> IO b) -> IO b
withCStruct x :: FrameWaitInfo
x f :: Ptr FrameWaitInfo -> IO b
f = Int -> Int -> (Ptr FrameWaitInfo -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 16 8 ((Ptr FrameWaitInfo -> IO b) -> IO b)
-> (Ptr FrameWaitInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr FrameWaitInfo
p -> Ptr FrameWaitInfo -> FrameWaitInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr FrameWaitInfo
p FrameWaitInfo
x (Ptr FrameWaitInfo -> IO b
f Ptr FrameWaitInfo
p)
  pokeCStruct :: Ptr FrameWaitInfo -> FrameWaitInfo -> IO b -> IO b
pokeCStruct p :: Ptr FrameWaitInfo
p FrameWaitInfo f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FrameWaitInfo
p Ptr FrameWaitInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_FRAME_WAIT_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FrameWaitInfo
p Ptr FrameWaitInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO b
f
  cStructSize :: Int
cStructSize = 16
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr FrameWaitInfo -> IO b -> IO b
pokeZeroCStruct p :: Ptr FrameWaitInfo
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FrameWaitInfo
p Ptr FrameWaitInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_FRAME_WAIT_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FrameWaitInfo
p Ptr FrameWaitInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO b
f

instance FromCStruct FrameWaitInfo where
  peekCStruct :: Ptr FrameWaitInfo -> IO FrameWaitInfo
peekCStruct _ = FrameWaitInfo -> IO FrameWaitInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FrameWaitInfo -> IO FrameWaitInfo)
-> FrameWaitInfo -> IO FrameWaitInfo
forall a b. (a -> b) -> a -> b
$ FrameWaitInfo
FrameWaitInfo
                           

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

instance Zero FrameWaitInfo where
  zero :: FrameWaitInfo
zero = FrameWaitInfo
FrameWaitInfo
           


-- | XrFrameState - Frame prediction structure
--
-- == Member Descriptions
--
-- = Description
--
-- 'FrameState' describes the time at which the next frame will be
-- displayed to the user. @predictedDisplayTime@ /must/ refer to the
-- midpoint of the interval during which the frame is displayed. The
-- runtime /may/ report a different @predictedDisplayPeriod@ from the
-- hardware’s refresh cycle.
--
-- For any frame where @shouldRender@ is
-- 'OpenXR.Core10.FundamentalTypes.FALSE', the application /should/ avoid
-- heavy GPU work for that frame, for example by not rendering its layers.
-- This typically happens when the application is transitioning into or out
-- of a running session, or when some system UI is fully covering the
-- application at the moment. As long as the session
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#session_running is running>,
-- the application /should/ keep running the frame loop to maintain the
-- frame synchronization to the runtime, even if this requires calling
-- 'endFrame' with all layers omitted.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrBool32 >,
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrDuration >,
-- 'FrameWaitInfo', 'OpenXR.Core10.Enums.StructureType.StructureType',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >,
-- 'waitFrame'
data FrameState (es :: [Type]) = FrameState
  { -- | @next@ is @NULL@ or a pointer to the next structure in a structure
    -- chain. No such structures are defined in core OpenXR.
    --
    -- #VUID-XrFrameState-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.Extensions.XR_MSFT_secondary_view_configuration.SecondaryViewConfigurationFrameStateMSFT'
    FrameState es -> Chain es
next :: Chain es
  , -- | @predictedDisplayTime@ is the anticipated display
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >
    -- for the next application-generated frame.
    FrameState es -> Time
predictedDisplayTime :: Time
  , -- | @predictedDisplayPeriod@ is the
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrDuration >
    -- of the display period for the next application-generated frame, for use
    -- in predicting display times beyond the next one.
    FrameState es -> Time
predictedDisplayPeriod :: Duration
  , -- | @shouldRender@ is 'OpenXR.Core10.FundamentalTypes.TRUE' if the
    -- application /should/ render its layers as normal and submit them to
    -- 'endFrame'. When this value is 'OpenXR.Core10.FundamentalTypes.FALSE',
    -- the application /should/ avoid heavy GPU work where possible, for
    -- example by skipping layer rendering and then omitting those layers when
    -- calling 'endFrame'.
    FrameState es -> Bool
shouldRender :: Bool
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (FrameState (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (FrameState es)

instance Extensible FrameState where
  extensibleTypeName :: String
extensibleTypeName = "FrameState"
  setNext :: FrameState ds -> Chain es -> FrameState es
setNext x :: FrameState ds
x next :: Chain es
next = FrameState ds
x{$sel:next:FrameState :: Chain es
next = Chain es
next}
  getNext :: FrameState es -> Chain es
getNext FrameState{..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends FrameState e => b) -> Maybe b
  extends :: proxy e -> (Extends FrameState e => b) -> Maybe b
extends _ f :: Extends FrameState e => b
f
    | Just Refl <- (Typeable e, Typeable SecondaryViewConfigurationFrameStateMSFT) =>
Maybe (e :~: SecondaryViewConfigurationFrameStateMSFT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @SecondaryViewConfigurationFrameStateMSFT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends FrameState e => b
f
    | Bool
otherwise = Maybe b
forall a. Maybe a
Nothing

instance (Extendss FrameState es, PokeChain es) => ToCStruct (FrameState es) where
  withCStruct :: FrameState es -> (Ptr (FrameState es) -> IO b) -> IO b
withCStruct x :: FrameState es
x f :: Ptr (FrameState es) -> IO b
f = Int -> Int -> (Ptr (FrameState es) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 40 8 ((Ptr (FrameState es) -> IO b) -> IO b)
-> (Ptr (FrameState es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr (FrameState es)
p -> Ptr (FrameState es) -> FrameState es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (FrameState es)
p FrameState es
x (Ptr (FrameState es) -> IO b
f Ptr (FrameState es)
p)
  pokeCStruct :: Ptr (FrameState es) -> FrameState es -> IO b -> IO b
pokeCStruct p :: Ptr (FrameState es)
p FrameState{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (FrameState es)
p Ptr (FrameState es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_FRAME_STATE)
    Ptr ()
next'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (FrameState es)
p Ptr (FrameState es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
next''
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Time -> Time -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (FrameState es)
p Ptr (FrameState es) -> Int -> Ptr Time
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Time)) (Time
predictedDisplayTime)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Time -> Time -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (FrameState es)
p Ptr (FrameState es) -> Int -> Ptr Time
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Duration)) (Time
predictedDisplayPeriod)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (FrameState es)
p Ptr (FrameState es) -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
shouldRender))
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = 40
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr (FrameState es) -> IO b -> IO b
pokeZeroCStruct p :: Ptr (FrameState es)
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (FrameState es)
p Ptr (FrameState es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_FRAME_STATE)
    Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ forall a. PokeChain es => (Ptr (Chain es) -> IO a) -> IO a
forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (FrameState es)
p Ptr (FrameState es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext'
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Time -> Time -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (FrameState es)
p Ptr (FrameState es) -> Int -> Ptr Time
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Time)) (Time
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Time -> Time -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (FrameState es)
p Ptr (FrameState es) -> Int -> Ptr Time
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Duration)) (Time
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (FrameState es)
p Ptr (FrameState es) -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f

instance (Extendss FrameState es, PeekChain es) => FromCStruct (FrameState es) where
  peekCStruct :: Ptr (FrameState es) -> IO (FrameState es)
peekCStruct p :: Ptr (FrameState es)
p = do
    Ptr ()
next <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (FrameState es)
p Ptr (FrameState es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ())))
    Chain es
next' <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
next)
    Time
predictedDisplayTime <- Ptr Time -> IO Time
forall a. Storable a => Ptr a -> IO a
peek @Time ((Ptr (FrameState es)
p Ptr (FrameState es) -> Int -> Ptr Time
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Time))
    Time
predictedDisplayPeriod <- Ptr Time -> IO Time
forall a. Storable a => Ptr a -> IO a
peek @Duration ((Ptr (FrameState es)
p Ptr (FrameState es) -> Int -> Ptr Time
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Duration))
    Bool32
shouldRender <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr (FrameState es)
p Ptr (FrameState es) -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Bool32))
    FrameState es -> IO (FrameState es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FrameState es -> IO (FrameState es))
-> FrameState es -> IO (FrameState es)
forall a b. (a -> b) -> a -> b
$ Chain es -> Time -> Time -> Bool -> FrameState es
forall (es :: [*]).
Chain es -> Time -> Time -> Bool -> FrameState es
FrameState
             Chain es
next' Time
predictedDisplayTime Time
predictedDisplayPeriod (Bool32 -> Bool
bool32ToBool Bool32
shouldRender)

instance es ~ '[] => Zero (FrameState es) where
  zero :: FrameState es
zero = Chain es -> Time -> Time -> Bool -> FrameState es
forall (es :: [*]).
Chain es -> Time -> Time -> Bool -> FrameState es
FrameState
           ()
           Time
forall a. Zero a => a
zero
           Time
forall a. Zero a => a
zero
           Bool
forall a. Zero a => a
zero