{-# language CPP #-}
-- | = Name
--
-- XR_MSFT_secondary_view_configuration - instance extension
--
-- = Specification
--
-- See
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_MSFT_secondary_view_configuration  XR_MSFT_secondary_view_configuration>
-- in the main specification for complete information.
--
-- = Registered Extension Number
--
-- 54
--
-- = Revision
--
-- 1
--
-- = Extension and Version Dependencies
--
-- -   Requires OpenXR 1.0
--
-- = See Also
--
-- 'SecondaryViewConfigurationFrameEndInfoMSFT',
-- 'SecondaryViewConfigurationFrameStateMSFT',
-- 'SecondaryViewConfigurationLayerInfoMSFT',
-- 'SecondaryViewConfigurationSessionBeginInfoMSFT',
-- 'SecondaryViewConfigurationStateMSFT',
-- 'SecondaryViewConfigurationSwapchainCreateInfoMSFT'
--
-- = Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_MSFT_secondary_view_configuration OpenXR Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module OpenXR.Extensions.XR_MSFT_secondary_view_configuration  ( SecondaryViewConfigurationSessionBeginInfoMSFT(..)
                                                               , SecondaryViewConfigurationStateMSFT(..)
                                                               , SecondaryViewConfigurationFrameStateMSFT(..)
                                                               , SecondaryViewConfigurationFrameEndInfoMSFT(..)
                                                               , SecondaryViewConfigurationLayerInfoMSFT(..)
                                                               , SecondaryViewConfigurationSwapchainCreateInfoMSFT(..)
                                                               , MSFT_secondary_view_configuration_SPEC_VERSION
                                                               , pattern MSFT_secondary_view_configuration_SPEC_VERSION
                                                               , MSFT_SECONDARY_VIEW_CONFIGURATION_EXTENSION_NAME
                                                               , pattern MSFT_SECONDARY_VIEW_CONFIGURATION_EXTENSION_NAME
                                                               ) where

import Foreign.Marshal.Alloc (allocaBytesAligned)
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 OpenXR.CStruct (FromCStruct)
import OpenXR.CStruct (FromCStruct(..))
import OpenXR.CStruct (ToCStruct)
import OpenXR.CStruct (ToCStruct(..))
import OpenXR.Zero (Zero(..))
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
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 (withSomeChild)
import OpenXR.Core10.FundamentalTypes (Bool32)
import OpenXR.Core10.OtherTypes (CompositionLayerBaseHeader)
import OpenXR.Core10.Enums.EnvironmentBlendMode (EnvironmentBlendMode)
import OpenXR.CStruct.Extends (Inheritable(peekSomeCChild))
import OpenXR.CStruct.Extends (SomeChild)
import OpenXR.Core10.Enums.StructureType (StructureType)
import OpenXR.Core10.Enums.ViewConfigurationType (ViewConfigurationType)
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_SECONDARY_VIEW_CONFIGURATION_FRAME_END_INFO_MSFT))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_SECONDARY_VIEW_CONFIGURATION_FRAME_STATE_MSFT))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_SECONDARY_VIEW_CONFIGURATION_LAYER_INFO_MSFT))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_SECONDARY_VIEW_CONFIGURATION_SESSION_BEGIN_INFO_MSFT))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_SECONDARY_VIEW_CONFIGURATION_STATE_MSFT))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_SECONDARY_VIEW_CONFIGURATION_SWAPCHAIN_CREATE_INFO_MSFT))
-- | XrSecondaryViewConfigurationSessionBeginInfoMSFT - Describes an
-- extension structure to 'OpenXR.Core10.Session.beginSession' indicating
-- supported view configuration types.
--
-- == Member Descriptions
--
-- = Description
--
-- If there are any duplicated view configuration types in the array of
-- @enabledViewConfigurationTypes@, the runtime /must/ return error
-- 'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'.
--
-- If there are any primary view configuration types in the array of
-- @enabledViewConfigurationTypes@, the runtime /must/ return error
-- 'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'.
--
-- If there are any secondary view configuration types not returned by
-- 'OpenXR.Core10.ViewConfigurations.enumerateViewConfigurations' in the
-- array of @enabledViewConfigurationTypes@, the runtime /must/ return
-- error
-- 'OpenXR.Core10.Enums.Result.ERROR_VIEW_CONFIGURATION_TYPE_UNSUPPORTED'.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrSecondaryViewConfigurationSessionBeginInfoMSFT-extension-notenabled#
--     The @@ extension /must/ be enabled prior to using
--     'SecondaryViewConfigurationSessionBeginInfoMSFT'
--
-- -   #VUID-XrSecondaryViewConfigurationSessionBeginInfoMSFT-type-type#
--     @type@ /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_SECONDARY_VIEW_CONFIGURATION_SESSION_BEGIN_INFO_MSFT'
--
-- -   #VUID-XrSecondaryViewConfigurationSessionBeginInfoMSFT-next-next#
--     @next@ /must/ be @NULL@ or a valid pointer to the
--     <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#valid-usage-for-structure-pointer-chains next structure in a structure chain>
--
-- -   #VUID-XrSecondaryViewConfigurationSessionBeginInfoMSFT-enabledViewConfigurationTypes-parameter#
--     @enabledViewConfigurationTypes@ /must/ be a pointer to an array of
--     @viewConfigurationCount@ valid
--     'OpenXR.Core10.Enums.ViewConfigurationType.ViewConfigurationType'
--     values
--
-- -   #VUID-XrSecondaryViewConfigurationSessionBeginInfoMSFT-viewConfigurationCount-arraylength#
--     The @viewConfigurationCount@ parameter /must/ be greater than @0@
--
-- = See Also
--
-- 'OpenXR.Core10.Session.SessionBeginInfo',
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'OpenXR.Core10.Enums.ViewConfigurationType.ViewConfigurationType'
data SecondaryViewConfigurationSessionBeginInfoMSFT = SecondaryViewConfigurationSessionBeginInfoMSFT
  { -- | @enabledViewConfigurationTypes@ is an array of enabled secondary view
    -- configuration types that application supports.
    SecondaryViewConfigurationSessionBeginInfoMSFT
-> Vector ViewConfigurationType
enabledViewConfigurationTypes :: Vector ViewConfigurationType }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SecondaryViewConfigurationSessionBeginInfoMSFT)
#endif
deriving instance Show SecondaryViewConfigurationSessionBeginInfoMSFT

instance ToCStruct SecondaryViewConfigurationSessionBeginInfoMSFT where
  withCStruct :: SecondaryViewConfigurationSessionBeginInfoMSFT
-> (Ptr SecondaryViewConfigurationSessionBeginInfoMSFT -> IO b)
-> IO b
withCStruct x :: SecondaryViewConfigurationSessionBeginInfoMSFT
x f :: Ptr SecondaryViewConfigurationSessionBeginInfoMSFT -> IO b
f = Int
-> Int
-> (Ptr SecondaryViewConfigurationSessionBeginInfoMSFT -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((Ptr SecondaryViewConfigurationSessionBeginInfoMSFT -> IO b)
 -> IO b)
-> (Ptr SecondaryViewConfigurationSessionBeginInfoMSFT -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr SecondaryViewConfigurationSessionBeginInfoMSFT
p -> Ptr SecondaryViewConfigurationSessionBeginInfoMSFT
-> SecondaryViewConfigurationSessionBeginInfoMSFT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SecondaryViewConfigurationSessionBeginInfoMSFT
p SecondaryViewConfigurationSessionBeginInfoMSFT
x (Ptr SecondaryViewConfigurationSessionBeginInfoMSFT -> IO b
f Ptr SecondaryViewConfigurationSessionBeginInfoMSFT
p)
  pokeCStruct :: Ptr SecondaryViewConfigurationSessionBeginInfoMSFT
-> SecondaryViewConfigurationSessionBeginInfoMSFT -> IO b -> IO b
pokeCStruct p :: Ptr SecondaryViewConfigurationSessionBeginInfoMSFT
p SecondaryViewConfigurationSessionBeginInfoMSFT{..} 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 SecondaryViewConfigurationSessionBeginInfoMSFT
p Ptr SecondaryViewConfigurationSessionBeginInfoMSFT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SECONDARY_VIEW_CONFIGURATION_SESSION_BEGIN_INFO_MSFT)
    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 SecondaryViewConfigurationSessionBeginInfoMSFT
p Ptr SecondaryViewConfigurationSessionBeginInfoMSFT
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SecondaryViewConfigurationSessionBeginInfoMSFT
p Ptr SecondaryViewConfigurationSessionBeginInfoMSFT
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector ViewConfigurationType -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector ViewConfigurationType -> Int)
-> Vector ViewConfigurationType -> Int
forall a b. (a -> b) -> a -> b
$ (Vector ViewConfigurationType
enabledViewConfigurationTypes)) :: Word32))
    Ptr ViewConfigurationType
pEnabledViewConfigurationTypes' <- ((Ptr ViewConfigurationType -> IO b) -> IO b)
-> ContT b IO (Ptr ViewConfigurationType)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ViewConfigurationType -> IO b) -> IO b)
 -> ContT b IO (Ptr ViewConfigurationType))
-> ((Ptr ViewConfigurationType -> IO b) -> IO b)
-> ContT b IO (Ptr ViewConfigurationType)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr ViewConfigurationType -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @ViewConfigurationType ((Vector ViewConfigurationType -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector ViewConfigurationType
enabledViewConfigurationTypes)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 4) 4
    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
$ (Int -> ViewConfigurationType -> IO ())
-> Vector ViewConfigurationType -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: ViewConfigurationType
e -> Ptr ViewConfigurationType -> ViewConfigurationType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ViewConfigurationType
pEnabledViewConfigurationTypes' Ptr ViewConfigurationType -> Int -> Ptr ViewConfigurationType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr ViewConfigurationType) (ViewConfigurationType
e)) (Vector ViewConfigurationType
enabledViewConfigurationTypes)
    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 ViewConfigurationType)
-> Ptr ViewConfigurationType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SecondaryViewConfigurationSessionBeginInfoMSFT
p Ptr SecondaryViewConfigurationSessionBeginInfoMSFT
-> Int -> Ptr (Ptr ViewConfigurationType)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr ViewConfigurationType))) (Ptr ViewConfigurationType
pEnabledViewConfigurationTypes')
    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 = 32
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr SecondaryViewConfigurationSessionBeginInfoMSFT -> IO b -> IO b
pokeZeroCStruct p :: Ptr SecondaryViewConfigurationSessionBeginInfoMSFT
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 SecondaryViewConfigurationSessionBeginInfoMSFT
p Ptr SecondaryViewConfigurationSessionBeginInfoMSFT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SECONDARY_VIEW_CONFIGURATION_SESSION_BEGIN_INFO_MSFT)
    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 SecondaryViewConfigurationSessionBeginInfoMSFT
p Ptr SecondaryViewConfigurationSessionBeginInfoMSFT
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ViewConfigurationType
pEnabledViewConfigurationTypes' <- ((Ptr ViewConfigurationType -> IO b) -> IO b)
-> ContT b IO (Ptr ViewConfigurationType)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ViewConfigurationType -> IO b) -> IO b)
 -> ContT b IO (Ptr ViewConfigurationType))
-> ((Ptr ViewConfigurationType -> IO b) -> IO b)
-> ContT b IO (Ptr ViewConfigurationType)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr ViewConfigurationType -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @ViewConfigurationType ((Vector Any -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Any
forall a. Monoid a => a
mempty)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 4) 4
    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
$ (Int -> ViewConfigurationType -> IO ())
-> Vector ViewConfigurationType -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: ViewConfigurationType
e -> Ptr ViewConfigurationType -> ViewConfigurationType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ViewConfigurationType
pEnabledViewConfigurationTypes' Ptr ViewConfigurationType -> Int -> Ptr ViewConfigurationType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr ViewConfigurationType) (ViewConfigurationType
e)) (Vector ViewConfigurationType
forall a. Monoid a => a
mempty)
    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 ViewConfigurationType)
-> Ptr ViewConfigurationType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SecondaryViewConfigurationSessionBeginInfoMSFT
p Ptr SecondaryViewConfigurationSessionBeginInfoMSFT
-> Int -> Ptr (Ptr ViewConfigurationType)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr ViewConfigurationType))) (Ptr ViewConfigurationType
pEnabledViewConfigurationTypes')
    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 FromCStruct SecondaryViewConfigurationSessionBeginInfoMSFT where
  peekCStruct :: Ptr SecondaryViewConfigurationSessionBeginInfoMSFT
-> IO SecondaryViewConfigurationSessionBeginInfoMSFT
peekCStruct p :: Ptr SecondaryViewConfigurationSessionBeginInfoMSFT
p = do
    Word32
viewConfigurationCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr SecondaryViewConfigurationSessionBeginInfoMSFT
p Ptr SecondaryViewConfigurationSessionBeginInfoMSFT
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32))
    Ptr ViewConfigurationType
enabledViewConfigurationTypes <- Ptr (Ptr ViewConfigurationType) -> IO (Ptr ViewConfigurationType)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ViewConfigurationType) ((Ptr SecondaryViewConfigurationSessionBeginInfoMSFT
p Ptr SecondaryViewConfigurationSessionBeginInfoMSFT
-> Int -> Ptr (Ptr ViewConfigurationType)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr ViewConfigurationType)))
    Vector ViewConfigurationType
enabledViewConfigurationTypes' <- Int
-> (Int -> IO ViewConfigurationType)
-> IO (Vector ViewConfigurationType)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
viewConfigurationCount) (\i :: Int
i -> Ptr ViewConfigurationType -> IO ViewConfigurationType
forall a. Storable a => Ptr a -> IO a
peek @ViewConfigurationType ((Ptr ViewConfigurationType
enabledViewConfigurationTypes Ptr ViewConfigurationType -> Int -> Ptr ViewConfigurationType
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr ViewConfigurationType)))
    SecondaryViewConfigurationSessionBeginInfoMSFT
-> IO SecondaryViewConfigurationSessionBeginInfoMSFT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SecondaryViewConfigurationSessionBeginInfoMSFT
 -> IO SecondaryViewConfigurationSessionBeginInfoMSFT)
-> SecondaryViewConfigurationSessionBeginInfoMSFT
-> IO SecondaryViewConfigurationSessionBeginInfoMSFT
forall a b. (a -> b) -> a -> b
$ Vector ViewConfigurationType
-> SecondaryViewConfigurationSessionBeginInfoMSFT
SecondaryViewConfigurationSessionBeginInfoMSFT
             Vector ViewConfigurationType
enabledViewConfigurationTypes'

instance Zero SecondaryViewConfigurationSessionBeginInfoMSFT where
  zero :: SecondaryViewConfigurationSessionBeginInfoMSFT
zero = Vector ViewConfigurationType
-> SecondaryViewConfigurationSessionBeginInfoMSFT
SecondaryViewConfigurationSessionBeginInfoMSFT
           Vector ViewConfigurationType
forall a. Monoid a => a
mempty


-- | XrSecondaryViewConfigurationStateMSFT - Returns the state of an enabled
-- secondary view configuration.
--
-- == Member Descriptions
--
-- = Description
--
-- When a secondary view configuration becomes active, the application
-- /should/ render its secondary views as soon as possible, by getting
-- their view transforms and FOV using
-- 'OpenXR.Core10.DisplayTiming.locateViews' and then submitting
-- composition layers to 'OpenXR.Core10.DisplayTiming.endFrame' through the
-- 'SecondaryViewConfigurationFrameEndInfoMSFT' extension structure. When a
-- secondary view configuration changes from inactive to active, the
-- runtime /may/ change
-- 'OpenXR.Core10.ViewConfigurations.ViewConfigurationView' of the given
-- view configuration such as the recommended image width or height. An
-- application /should/ query for latest
-- 'OpenXR.Core10.ViewConfigurations.ViewConfigurationView' through
-- 'OpenXR.Core10.ViewConfigurations.enumerateViewConfigurationViews'
-- function for the secondary view configuration and consider recreating
-- swapchain images if necessary. The runtime /must/ not change the
-- 'OpenXR.Core10.ViewConfigurations.ViewConfigurationView', including
-- recommended image width and height of a secondary view configuration
-- when @active@ remains true until the secondary view configuration
-- deactivated or the session has ended.
--
-- If necessary, the application /can/ take longer than a frame duration to
-- prepare by calling 'OpenXR.Core10.DisplayTiming.endFrame' without
-- submitting layers for that secondary view configuration until ready. The
-- runtime /should/ delay the underlying scenario managed by the secondary
-- view configuration until the application begins submitting frames with
-- layers for that configuration. The active secondary view configuration
-- composed output is undefined if the application stops submitting frames
-- with layers for a secondary view configuration while @active@ remains
-- true.
--
-- When the runtime intends to conclude a secondary view configuration, for
-- example when user stops video capture, the runtime makes the view
-- configuration inactive by setting the corresponding @active@ in the
-- 'SecondaryViewConfigurationStateMSFT' structure to false.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrSecondaryViewConfigurationStateMSFT-extension-notenabled#
--     The @@ extension /must/ be enabled prior to using
--     'SecondaryViewConfigurationStateMSFT'
--
-- -   #VUID-XrSecondaryViewConfigurationStateMSFT-type-type# @type@ /must/
--     be
--     'OpenXR.Core10.Enums.StructureType.TYPE_SECONDARY_VIEW_CONFIGURATION_STATE_MSFT'
--
-- -   #VUID-XrSecondaryViewConfigurationStateMSFT-next-next# @next@ /must/
--     be @NULL@ or a valid pointer to the
--     <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#valid-usage-for-structure-pointer-chains next structure in a structure chain>
--
-- -   #VUID-XrSecondaryViewConfigurationStateMSFT-viewConfigurationType-parameter#
--     @viewConfigurationType@ /must/ be a valid
--     'OpenXR.Core10.Enums.ViewConfigurationType.ViewConfigurationType'
--     value
--
-- = See Also
--
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrBool32 >,
-- 'OpenXR.Core10.DisplayTiming.FrameState',
-- 'SecondaryViewConfigurationFrameStateMSFT',
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'OpenXR.Core10.Enums.ViewConfigurationType.ViewConfigurationType'
data SecondaryViewConfigurationStateMSFT = SecondaryViewConfigurationStateMSFT
  { -- | @viewConfigurationType@ is a
    -- 'OpenXR.Core10.Enums.ViewConfigurationType.ViewConfigurationType' that
    -- represents the returned state.
    SecondaryViewConfigurationStateMSFT -> ViewConfigurationType
viewConfigurationType :: ViewConfigurationType
  , -- | @active@ is an
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrBool32 >
    -- returns whether the secondary view configuration is active and
    -- displaying frames to users.
    SecondaryViewConfigurationStateMSFT -> Bool
active :: Bool
  }
  deriving (Typeable, SecondaryViewConfigurationStateMSFT
-> SecondaryViewConfigurationStateMSFT -> Bool
(SecondaryViewConfigurationStateMSFT
 -> SecondaryViewConfigurationStateMSFT -> Bool)
-> (SecondaryViewConfigurationStateMSFT
    -> SecondaryViewConfigurationStateMSFT -> Bool)
-> Eq SecondaryViewConfigurationStateMSFT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SecondaryViewConfigurationStateMSFT
-> SecondaryViewConfigurationStateMSFT -> Bool
$c/= :: SecondaryViewConfigurationStateMSFT
-> SecondaryViewConfigurationStateMSFT -> Bool
== :: SecondaryViewConfigurationStateMSFT
-> SecondaryViewConfigurationStateMSFT -> Bool
$c== :: SecondaryViewConfigurationStateMSFT
-> SecondaryViewConfigurationStateMSFT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SecondaryViewConfigurationStateMSFT)
#endif
deriving instance Show SecondaryViewConfigurationStateMSFT

instance ToCStruct SecondaryViewConfigurationStateMSFT where
  withCStruct :: SecondaryViewConfigurationStateMSFT
-> (Ptr SecondaryViewConfigurationStateMSFT -> IO b) -> IO b
withCStruct x :: SecondaryViewConfigurationStateMSFT
x f :: Ptr SecondaryViewConfigurationStateMSFT -> IO b
f = Int
-> Int -> (Ptr SecondaryViewConfigurationStateMSFT -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 24 8 ((Ptr SecondaryViewConfigurationStateMSFT -> IO b) -> IO b)
-> (Ptr SecondaryViewConfigurationStateMSFT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr SecondaryViewConfigurationStateMSFT
p -> Ptr SecondaryViewConfigurationStateMSFT
-> SecondaryViewConfigurationStateMSFT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SecondaryViewConfigurationStateMSFT
p SecondaryViewConfigurationStateMSFT
x (Ptr SecondaryViewConfigurationStateMSFT -> IO b
f Ptr SecondaryViewConfigurationStateMSFT
p)
  pokeCStruct :: Ptr SecondaryViewConfigurationStateMSFT
-> SecondaryViewConfigurationStateMSFT -> IO b -> IO b
pokeCStruct p :: Ptr SecondaryViewConfigurationStateMSFT
p SecondaryViewConfigurationStateMSFT{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SecondaryViewConfigurationStateMSFT
p Ptr SecondaryViewConfigurationStateMSFT -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SECONDARY_VIEW_CONFIGURATION_STATE_MSFT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SecondaryViewConfigurationStateMSFT
p Ptr SecondaryViewConfigurationStateMSFT -> 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 SecondaryViewConfigurationStateMSFT
p Ptr SecondaryViewConfigurationStateMSFT
-> Int -> Ptr ViewConfigurationType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr ViewConfigurationType)) (ViewConfigurationType
viewConfigurationType)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SecondaryViewConfigurationStateMSFT
p Ptr SecondaryViewConfigurationStateMSFT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
active))
    IO b
f
  cStructSize :: Int
cStructSize = 24
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr SecondaryViewConfigurationStateMSFT -> IO b -> IO b
pokeZeroCStruct p :: Ptr SecondaryViewConfigurationStateMSFT
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SecondaryViewConfigurationStateMSFT
p Ptr SecondaryViewConfigurationStateMSFT -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SECONDARY_VIEW_CONFIGURATION_STATE_MSFT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SecondaryViewConfigurationStateMSFT
p Ptr SecondaryViewConfigurationStateMSFT -> 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 SecondaryViewConfigurationStateMSFT
p Ptr SecondaryViewConfigurationStateMSFT
-> Int -> Ptr ViewConfigurationType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr ViewConfigurationType)) (ViewConfigurationType
forall a. Zero a => a
zero)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SecondaryViewConfigurationStateMSFT
p Ptr SecondaryViewConfigurationStateMSFT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct SecondaryViewConfigurationStateMSFT where
  peekCStruct :: Ptr SecondaryViewConfigurationStateMSFT
-> IO SecondaryViewConfigurationStateMSFT
peekCStruct p :: Ptr SecondaryViewConfigurationStateMSFT
p = do
    ViewConfigurationType
viewConfigurationType <- Ptr ViewConfigurationType -> IO ViewConfigurationType
forall a. Storable a => Ptr a -> IO a
peek @ViewConfigurationType ((Ptr SecondaryViewConfigurationStateMSFT
p Ptr SecondaryViewConfigurationStateMSFT
-> Int -> Ptr ViewConfigurationType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr ViewConfigurationType))
    Bool32
active <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr SecondaryViewConfigurationStateMSFT
p Ptr SecondaryViewConfigurationStateMSFT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Bool32))
    SecondaryViewConfigurationStateMSFT
-> IO SecondaryViewConfigurationStateMSFT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SecondaryViewConfigurationStateMSFT
 -> IO SecondaryViewConfigurationStateMSFT)
-> SecondaryViewConfigurationStateMSFT
-> IO SecondaryViewConfigurationStateMSFT
forall a b. (a -> b) -> a -> b
$ ViewConfigurationType
-> Bool -> SecondaryViewConfigurationStateMSFT
SecondaryViewConfigurationStateMSFT
             ViewConfigurationType
viewConfigurationType (Bool32 -> Bool
bool32ToBool Bool32
active)

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

instance Zero SecondaryViewConfigurationStateMSFT where
  zero :: SecondaryViewConfigurationStateMSFT
zero = ViewConfigurationType
-> Bool -> SecondaryViewConfigurationStateMSFT
SecondaryViewConfigurationStateMSFT
           ViewConfigurationType
forall a. Zero a => a
zero
           Bool
forall a. Zero a => a
zero


-- | XrSecondaryViewConfigurationFrameStateMSFT - Extension structure to
-- xrWaitFrame to return a list of secondary view configuration states.
--
-- == Member Descriptions
--
-- = Description
--
-- The array size @viewConfigurationCount@ in the
-- 'SecondaryViewConfigurationFrameStateMSFT' structure /must/ be the same
-- as the array size enabled through
-- 'SecondaryViewConfigurationSessionBeginInfoMSFT' when calling
-- 'OpenXR.Core10.Session.beginSession' earlier, otherwise the runtime
-- /must/ return error
-- 'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrSecondaryViewConfigurationFrameStateMSFT-extension-notenabled#
--     The @@ extension /must/ be enabled prior to using
--     'SecondaryViewConfigurationFrameStateMSFT'
--
-- -   #VUID-XrSecondaryViewConfigurationFrameStateMSFT-type-type# @type@
--     /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_SECONDARY_VIEW_CONFIGURATION_FRAME_STATE_MSFT'
--
-- -   #VUID-XrSecondaryViewConfigurationFrameStateMSFT-next-next# @next@
--     /must/ be @NULL@ or a valid pointer to the
--     <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#valid-usage-for-structure-pointer-chains next structure in a structure chain>
--
-- -   #VUID-XrSecondaryViewConfigurationFrameStateMSFT-viewConfigurationStates-parameter#
--     @viewConfigurationStates@ /must/ be a pointer to an array of
--     @viewConfigurationCount@ 'SecondaryViewConfigurationStateMSFT'
--     structures
--
-- -   #VUID-XrSecondaryViewConfigurationFrameStateMSFT-viewConfigurationCount-arraylength#
--     The @viewConfigurationCount@ parameter /must/ be greater than @0@
--
-- = See Also
--
-- 'OpenXR.Core10.DisplayTiming.FrameState',
-- 'SecondaryViewConfigurationStateMSFT',
-- 'OpenXR.Core10.Enums.StructureType.StructureType'
data SecondaryViewConfigurationFrameStateMSFT = SecondaryViewConfigurationFrameStateMSFT
  { -- | @viewConfigurationCount@ is the number of elements in
    -- @viewConfigurationStates@.
    SecondaryViewConfigurationFrameStateMSFT -> Word32
viewConfigurationCount :: Word32
  , -- | @viewConfigurationStates@ is an array of
    -- 'SecondaryViewConfigurationStateMSFT' structures.
    SecondaryViewConfigurationFrameStateMSFT
-> Ptr SecondaryViewConfigurationStateMSFT
viewConfigurationStates :: Ptr SecondaryViewConfigurationStateMSFT
  }
  deriving (Typeable, SecondaryViewConfigurationFrameStateMSFT
-> SecondaryViewConfigurationFrameStateMSFT -> Bool
(SecondaryViewConfigurationFrameStateMSFT
 -> SecondaryViewConfigurationFrameStateMSFT -> Bool)
-> (SecondaryViewConfigurationFrameStateMSFT
    -> SecondaryViewConfigurationFrameStateMSFT -> Bool)
-> Eq SecondaryViewConfigurationFrameStateMSFT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SecondaryViewConfigurationFrameStateMSFT
-> SecondaryViewConfigurationFrameStateMSFT -> Bool
$c/= :: SecondaryViewConfigurationFrameStateMSFT
-> SecondaryViewConfigurationFrameStateMSFT -> Bool
== :: SecondaryViewConfigurationFrameStateMSFT
-> SecondaryViewConfigurationFrameStateMSFT -> Bool
$c== :: SecondaryViewConfigurationFrameStateMSFT
-> SecondaryViewConfigurationFrameStateMSFT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SecondaryViewConfigurationFrameStateMSFT)
#endif
deriving instance Show SecondaryViewConfigurationFrameStateMSFT

instance ToCStruct SecondaryViewConfigurationFrameStateMSFT where
  withCStruct :: SecondaryViewConfigurationFrameStateMSFT
-> (Ptr SecondaryViewConfigurationFrameStateMSFT -> IO b) -> IO b
withCStruct x :: SecondaryViewConfigurationFrameStateMSFT
x f :: Ptr SecondaryViewConfigurationFrameStateMSFT -> IO b
f = Int
-> Int
-> (Ptr SecondaryViewConfigurationFrameStateMSFT -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((Ptr SecondaryViewConfigurationFrameStateMSFT -> IO b) -> IO b)
-> (Ptr SecondaryViewConfigurationFrameStateMSFT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr SecondaryViewConfigurationFrameStateMSFT
p -> Ptr SecondaryViewConfigurationFrameStateMSFT
-> SecondaryViewConfigurationFrameStateMSFT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SecondaryViewConfigurationFrameStateMSFT
p SecondaryViewConfigurationFrameStateMSFT
x (Ptr SecondaryViewConfigurationFrameStateMSFT -> IO b
f Ptr SecondaryViewConfigurationFrameStateMSFT
p)
  pokeCStruct :: Ptr SecondaryViewConfigurationFrameStateMSFT
-> SecondaryViewConfigurationFrameStateMSFT -> IO b -> IO b
pokeCStruct p :: Ptr SecondaryViewConfigurationFrameStateMSFT
p SecondaryViewConfigurationFrameStateMSFT{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SecondaryViewConfigurationFrameStateMSFT
p Ptr SecondaryViewConfigurationFrameStateMSFT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SECONDARY_VIEW_CONFIGURATION_FRAME_STATE_MSFT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SecondaryViewConfigurationFrameStateMSFT
p Ptr SecondaryViewConfigurationFrameStateMSFT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SecondaryViewConfigurationFrameStateMSFT
p Ptr SecondaryViewConfigurationFrameStateMSFT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32)) (Word32
viewConfigurationCount)
    Ptr (Ptr SecondaryViewConfigurationStateMSFT)
-> Ptr SecondaryViewConfigurationStateMSFT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SecondaryViewConfigurationFrameStateMSFT
p Ptr SecondaryViewConfigurationFrameStateMSFT
-> Int -> Ptr (Ptr SecondaryViewConfigurationStateMSFT)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr SecondaryViewConfigurationStateMSFT))) (Ptr SecondaryViewConfigurationStateMSFT
viewConfigurationStates)
    IO b
f
  cStructSize :: Int
cStructSize = 32
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr SecondaryViewConfigurationFrameStateMSFT -> IO b -> IO b
pokeZeroCStruct p :: Ptr SecondaryViewConfigurationFrameStateMSFT
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SecondaryViewConfigurationFrameStateMSFT
p Ptr SecondaryViewConfigurationFrameStateMSFT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SECONDARY_VIEW_CONFIGURATION_FRAME_STATE_MSFT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SecondaryViewConfigurationFrameStateMSFT
p Ptr SecondaryViewConfigurationFrameStateMSFT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SecondaryViewConfigurationFrameStateMSFT
p Ptr SecondaryViewConfigurationFrameStateMSFT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr (Ptr SecondaryViewConfigurationStateMSFT)
-> Ptr SecondaryViewConfigurationStateMSFT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SecondaryViewConfigurationFrameStateMSFT
p Ptr SecondaryViewConfigurationFrameStateMSFT
-> Int -> Ptr (Ptr SecondaryViewConfigurationStateMSFT)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr SecondaryViewConfigurationStateMSFT))) (Ptr SecondaryViewConfigurationStateMSFT
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct SecondaryViewConfigurationFrameStateMSFT where
  peekCStruct :: Ptr SecondaryViewConfigurationFrameStateMSFT
-> IO SecondaryViewConfigurationFrameStateMSFT
peekCStruct p :: Ptr SecondaryViewConfigurationFrameStateMSFT
p = do
    Word32
viewConfigurationCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr SecondaryViewConfigurationFrameStateMSFT
p Ptr SecondaryViewConfigurationFrameStateMSFT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32))
    Ptr SecondaryViewConfigurationStateMSFT
viewConfigurationStates <- Ptr (Ptr SecondaryViewConfigurationStateMSFT)
-> IO (Ptr SecondaryViewConfigurationStateMSFT)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr SecondaryViewConfigurationStateMSFT) ((Ptr SecondaryViewConfigurationFrameStateMSFT
p Ptr SecondaryViewConfigurationFrameStateMSFT
-> Int -> Ptr (Ptr SecondaryViewConfigurationStateMSFT)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr SecondaryViewConfigurationStateMSFT)))
    SecondaryViewConfigurationFrameStateMSFT
-> IO SecondaryViewConfigurationFrameStateMSFT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SecondaryViewConfigurationFrameStateMSFT
 -> IO SecondaryViewConfigurationFrameStateMSFT)
-> SecondaryViewConfigurationFrameStateMSFT
-> IO SecondaryViewConfigurationFrameStateMSFT
forall a b. (a -> b) -> a -> b
$ Word32
-> Ptr SecondaryViewConfigurationStateMSFT
-> SecondaryViewConfigurationFrameStateMSFT
SecondaryViewConfigurationFrameStateMSFT
             Word32
viewConfigurationCount Ptr SecondaryViewConfigurationStateMSFT
viewConfigurationStates

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

instance Zero SecondaryViewConfigurationFrameStateMSFT where
  zero :: SecondaryViewConfigurationFrameStateMSFT
zero = Word32
-> Ptr SecondaryViewConfigurationStateMSFT
-> SecondaryViewConfigurationFrameStateMSFT
SecondaryViewConfigurationFrameStateMSFT
           Word32
forall a. Zero a => a
zero
           Ptr SecondaryViewConfigurationStateMSFT
forall a. Zero a => a
zero


-- | XrSecondaryViewConfigurationFrameEndInfoMSFT - Submit an array of
-- 'SecondaryViewConfigurationLayerInfoMSFT', one for each secondary view
-- configuration.
--
-- == Member Descriptions
--
-- = Description
--
-- The view configuration type in each
-- 'SecondaryViewConfigurationLayerInfoMSFT' must be one of the view
-- configurations enabled when calling 'OpenXR.Core10.Session.beginSession'
-- in 'SecondaryViewConfigurationSessionBeginInfoMSFT', or else the runtime
-- /must/ return error
-- 'OpenXR.Core10.Enums.Result.ERROR_SECONDARY_VIEW_CONFIGURATION_TYPE_NOT_ENABLED_MSFT'.
--
-- The view configuration type in each
-- 'SecondaryViewConfigurationLayerInfoMSFT' must not be the primary view
-- configuration in this session, or else the runtime /must/ return error
-- 'OpenXR.Core10.Enums.Result.ERROR_LAYER_INVALID'. The primary view
-- configuration layers continue to be submitted through
-- 'OpenXR.Core10.DisplayTiming.FrameEndInfo' directly.
--
-- If the view configuration is not active, as indicated in
-- 'SecondaryViewConfigurationFrameStateMSFT', the composition layers
-- submitted to this view configuration /may/ be ignored by the runtime.
-- Applications /should/ avoid rendering into secondary views when the view
-- configuration is inactive.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrSecondaryViewConfigurationFrameEndInfoMSFT-extension-notenabled#
--     The @@ extension /must/ be enabled prior to using
--     'SecondaryViewConfigurationFrameEndInfoMSFT'
--
-- -   #VUID-XrSecondaryViewConfigurationFrameEndInfoMSFT-type-type# @type@
--     /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_SECONDARY_VIEW_CONFIGURATION_FRAME_END_INFO_MSFT'
--
-- -   #VUID-XrSecondaryViewConfigurationFrameEndInfoMSFT-next-next# @next@
--     /must/ be @NULL@ or a valid pointer to the
--     <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#valid-usage-for-structure-pointer-chains next structure in a structure chain>
--
-- -   #VUID-XrSecondaryViewConfigurationFrameEndInfoMSFT-viewConfigurationLayersInfo-parameter#
--     @viewConfigurationLayersInfo@ /must/ be a pointer to an array of
--     @viewConfigurationCount@ valid
--     'SecondaryViewConfigurationLayerInfoMSFT' structures
--
-- -   #VUID-XrSecondaryViewConfigurationFrameEndInfoMSFT-viewConfigurationCount-arraylength#
--     The @viewConfigurationCount@ parameter /must/ be greater than @0@
--
-- = See Also
--
-- 'SecondaryViewConfigurationLayerInfoMSFT',
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'OpenXR.Core10.DisplayTiming.endFrame'
data SecondaryViewConfigurationFrameEndInfoMSFT = SecondaryViewConfigurationFrameEndInfoMSFT
  { -- | @viewConfigurationLayersInfo@ is an array of
    -- 'SecondaryViewConfigurationLayerInfoMSFT', containing composition layers
    -- to be submitted for the specified active view configuration.
    SecondaryViewConfigurationFrameEndInfoMSFT
-> Vector SecondaryViewConfigurationLayerInfoMSFT
viewConfigurationLayersInfo :: Vector SecondaryViewConfigurationLayerInfoMSFT }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SecondaryViewConfigurationFrameEndInfoMSFT)
#endif
deriving instance Show SecondaryViewConfigurationFrameEndInfoMSFT

instance ToCStruct SecondaryViewConfigurationFrameEndInfoMSFT where
  withCStruct :: SecondaryViewConfigurationFrameEndInfoMSFT
-> (Ptr SecondaryViewConfigurationFrameEndInfoMSFT -> IO b) -> IO b
withCStruct x :: SecondaryViewConfigurationFrameEndInfoMSFT
x f :: Ptr SecondaryViewConfigurationFrameEndInfoMSFT -> IO b
f = Int
-> Int
-> (Ptr SecondaryViewConfigurationFrameEndInfoMSFT -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((Ptr SecondaryViewConfigurationFrameEndInfoMSFT -> IO b) -> IO b)
-> (Ptr SecondaryViewConfigurationFrameEndInfoMSFT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr SecondaryViewConfigurationFrameEndInfoMSFT
p -> Ptr SecondaryViewConfigurationFrameEndInfoMSFT
-> SecondaryViewConfigurationFrameEndInfoMSFT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SecondaryViewConfigurationFrameEndInfoMSFT
p SecondaryViewConfigurationFrameEndInfoMSFT
x (Ptr SecondaryViewConfigurationFrameEndInfoMSFT -> IO b
f Ptr SecondaryViewConfigurationFrameEndInfoMSFT
p)
  pokeCStruct :: Ptr SecondaryViewConfigurationFrameEndInfoMSFT
-> SecondaryViewConfigurationFrameEndInfoMSFT -> IO b -> IO b
pokeCStruct p :: Ptr SecondaryViewConfigurationFrameEndInfoMSFT
p SecondaryViewConfigurationFrameEndInfoMSFT{..} 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 SecondaryViewConfigurationFrameEndInfoMSFT
p Ptr SecondaryViewConfigurationFrameEndInfoMSFT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SECONDARY_VIEW_CONFIGURATION_FRAME_END_INFO_MSFT)
    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 SecondaryViewConfigurationFrameEndInfoMSFT
p Ptr SecondaryViewConfigurationFrameEndInfoMSFT
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SecondaryViewConfigurationFrameEndInfoMSFT
p Ptr SecondaryViewConfigurationFrameEndInfoMSFT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector SecondaryViewConfigurationLayerInfoMSFT -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector SecondaryViewConfigurationLayerInfoMSFT -> Int)
-> Vector SecondaryViewConfigurationLayerInfoMSFT -> Int
forall a b. (a -> b) -> a -> b
$ (Vector SecondaryViewConfigurationLayerInfoMSFT
viewConfigurationLayersInfo)) :: Word32))
    Ptr SecondaryViewConfigurationLayerInfoMSFT
pViewConfigurationLayersInfo' <- ((Ptr SecondaryViewConfigurationLayerInfoMSFT -> IO b) -> IO b)
-> ContT b IO (Ptr SecondaryViewConfigurationLayerInfoMSFT)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr SecondaryViewConfigurationLayerInfoMSFT -> IO b) -> IO b)
 -> ContT b IO (Ptr SecondaryViewConfigurationLayerInfoMSFT))
-> ((Ptr SecondaryViewConfigurationLayerInfoMSFT -> IO b) -> IO b)
-> ContT b IO (Ptr SecondaryViewConfigurationLayerInfoMSFT)
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> (Ptr SecondaryViewConfigurationLayerInfoMSFT -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @SecondaryViewConfigurationLayerInfoMSFT ((Vector SecondaryViewConfigurationLayerInfoMSFT -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector SecondaryViewConfigurationLayerInfoMSFT
viewConfigurationLayersInfo)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 40) 8
    (Int -> SecondaryViewConfigurationLayerInfoMSFT -> ContT b IO ())
-> Vector SecondaryViewConfigurationLayerInfoMSFT -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: SecondaryViewConfigurationLayerInfoMSFT
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SecondaryViewConfigurationLayerInfoMSFT
-> SecondaryViewConfigurationLayerInfoMSFT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (Ptr SecondaryViewConfigurationLayerInfoMSFT
pViewConfigurationLayersInfo' Ptr SecondaryViewConfigurationLayerInfoMSFT
-> Int -> Ptr SecondaryViewConfigurationLayerInfoMSFT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (40 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SecondaryViewConfigurationLayerInfoMSFT) (SecondaryViewConfigurationLayerInfoMSFT
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector SecondaryViewConfigurationLayerInfoMSFT
viewConfigurationLayersInfo)
    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 SecondaryViewConfigurationLayerInfoMSFT)
-> Ptr SecondaryViewConfigurationLayerInfoMSFT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SecondaryViewConfigurationFrameEndInfoMSFT
p Ptr SecondaryViewConfigurationFrameEndInfoMSFT
-> Int -> Ptr (Ptr SecondaryViewConfigurationLayerInfoMSFT)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr SecondaryViewConfigurationLayerInfoMSFT))) (Ptr SecondaryViewConfigurationLayerInfoMSFT
pViewConfigurationLayersInfo')
    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 = 32
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr SecondaryViewConfigurationFrameEndInfoMSFT -> IO b -> IO b
pokeZeroCStruct p :: Ptr SecondaryViewConfigurationFrameEndInfoMSFT
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 SecondaryViewConfigurationFrameEndInfoMSFT
p Ptr SecondaryViewConfigurationFrameEndInfoMSFT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SECONDARY_VIEW_CONFIGURATION_FRAME_END_INFO_MSFT)
    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 SecondaryViewConfigurationFrameEndInfoMSFT
p Ptr SecondaryViewConfigurationFrameEndInfoMSFT
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr SecondaryViewConfigurationLayerInfoMSFT
pViewConfigurationLayersInfo' <- ((Ptr SecondaryViewConfigurationLayerInfoMSFT -> IO b) -> IO b)
-> ContT b IO (Ptr SecondaryViewConfigurationLayerInfoMSFT)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr SecondaryViewConfigurationLayerInfoMSFT -> IO b) -> IO b)
 -> ContT b IO (Ptr SecondaryViewConfigurationLayerInfoMSFT))
-> ((Ptr SecondaryViewConfigurationLayerInfoMSFT -> IO b) -> IO b)
-> ContT b IO (Ptr SecondaryViewConfigurationLayerInfoMSFT)
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> (Ptr SecondaryViewConfigurationLayerInfoMSFT -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @SecondaryViewConfigurationLayerInfoMSFT ((Vector Any -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Any
forall a. Monoid a => a
mempty)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 40) 8
    (Int -> SecondaryViewConfigurationLayerInfoMSFT -> ContT b IO ())
-> Vector SecondaryViewConfigurationLayerInfoMSFT -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: SecondaryViewConfigurationLayerInfoMSFT
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SecondaryViewConfigurationLayerInfoMSFT
-> SecondaryViewConfigurationLayerInfoMSFT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (Ptr SecondaryViewConfigurationLayerInfoMSFT
pViewConfigurationLayersInfo' Ptr SecondaryViewConfigurationLayerInfoMSFT
-> Int -> Ptr SecondaryViewConfigurationLayerInfoMSFT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (40 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SecondaryViewConfigurationLayerInfoMSFT) (SecondaryViewConfigurationLayerInfoMSFT
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector SecondaryViewConfigurationLayerInfoMSFT
forall a. Monoid a => a
mempty)
    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 SecondaryViewConfigurationLayerInfoMSFT)
-> Ptr SecondaryViewConfigurationLayerInfoMSFT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SecondaryViewConfigurationFrameEndInfoMSFT
p Ptr SecondaryViewConfigurationFrameEndInfoMSFT
-> Int -> Ptr (Ptr SecondaryViewConfigurationLayerInfoMSFT)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr SecondaryViewConfigurationLayerInfoMSFT))) (Ptr SecondaryViewConfigurationLayerInfoMSFT
pViewConfigurationLayersInfo')
    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 FromCStruct SecondaryViewConfigurationFrameEndInfoMSFT where
  peekCStruct :: Ptr SecondaryViewConfigurationFrameEndInfoMSFT
-> IO SecondaryViewConfigurationFrameEndInfoMSFT
peekCStruct p :: Ptr SecondaryViewConfigurationFrameEndInfoMSFT
p = do
    Word32
viewConfigurationCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr SecondaryViewConfigurationFrameEndInfoMSFT
p Ptr SecondaryViewConfigurationFrameEndInfoMSFT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32))
    Ptr SecondaryViewConfigurationLayerInfoMSFT
viewConfigurationLayersInfo <- Ptr (Ptr SecondaryViewConfigurationLayerInfoMSFT)
-> IO (Ptr SecondaryViewConfigurationLayerInfoMSFT)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr SecondaryViewConfigurationLayerInfoMSFT) ((Ptr SecondaryViewConfigurationFrameEndInfoMSFT
p Ptr SecondaryViewConfigurationFrameEndInfoMSFT
-> Int -> Ptr (Ptr SecondaryViewConfigurationLayerInfoMSFT)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr SecondaryViewConfigurationLayerInfoMSFT)))
    Vector SecondaryViewConfigurationLayerInfoMSFT
viewConfigurationLayersInfo' <- Int
-> (Int -> IO SecondaryViewConfigurationLayerInfoMSFT)
-> IO (Vector SecondaryViewConfigurationLayerInfoMSFT)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
viewConfigurationCount) (\i :: Int
i -> Ptr SecondaryViewConfigurationLayerInfoMSFT
-> IO SecondaryViewConfigurationLayerInfoMSFT
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @SecondaryViewConfigurationLayerInfoMSFT ((Ptr SecondaryViewConfigurationLayerInfoMSFT
viewConfigurationLayersInfo Ptr SecondaryViewConfigurationLayerInfoMSFT
-> Int -> Ptr SecondaryViewConfigurationLayerInfoMSFT
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (40 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SecondaryViewConfigurationLayerInfoMSFT)))
    SecondaryViewConfigurationFrameEndInfoMSFT
-> IO SecondaryViewConfigurationFrameEndInfoMSFT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SecondaryViewConfigurationFrameEndInfoMSFT
 -> IO SecondaryViewConfigurationFrameEndInfoMSFT)
-> SecondaryViewConfigurationFrameEndInfoMSFT
-> IO SecondaryViewConfigurationFrameEndInfoMSFT
forall a b. (a -> b) -> a -> b
$ Vector SecondaryViewConfigurationLayerInfoMSFT
-> SecondaryViewConfigurationFrameEndInfoMSFT
SecondaryViewConfigurationFrameEndInfoMSFT
             Vector SecondaryViewConfigurationLayerInfoMSFT
viewConfigurationLayersInfo'

instance Zero SecondaryViewConfigurationFrameEndInfoMSFT where
  zero :: SecondaryViewConfigurationFrameEndInfoMSFT
zero = Vector SecondaryViewConfigurationLayerInfoMSFT
-> SecondaryViewConfigurationFrameEndInfoMSFT
SecondaryViewConfigurationFrameEndInfoMSFT
           Vector SecondaryViewConfigurationLayerInfoMSFT
forall a. Monoid a => a
mempty


-- | XrSecondaryViewConfigurationLayerInfoMSFT - Describe an array of
-- composition layers to be submitted to given
-- 'OpenXR.Core10.Enums.ViewConfigurationType.ViewConfigurationType'.
--
-- == Member Descriptions
--
-- = Description
--
-- This structure is similar to the
-- 'OpenXR.Core10.DisplayTiming.FrameEndInfo' structure, with an extra
-- 'OpenXR.Core10.Enums.ViewConfigurationType.ViewConfigurationType' field
-- to specify the view configuration for which the submitted layers will be
-- rendered.
--
-- The application /should/ render its content for both the primary and
-- secondary view configurations using the same @predictedDisplayTime@
-- reported by 'OpenXR.Core10.DisplayTiming.waitFrame'. The runtime /must/
-- treat both the primary views and secondary views as being submitted for
-- the same @displayTime@ specified in the call to
-- 'OpenXR.Core10.DisplayTiming.endFrame'.
--
-- For layers such as quad layers whose content is identical across view
-- configurations, the application /can/ submit the same
-- 'OpenXR.Core10.OtherTypes.CompositionLayerBaseHeader' structures to
-- multiple view configurations in the same
-- 'OpenXR.Core10.DisplayTiming.endFrame' function call.
--
-- For each frame, the application /should/ only render and submit layers
-- for the secondary view configurations that were active that frame, as
-- indicated in the 'SecondaryViewConfigurationFrameStateMSFT' filled in
-- for that frame’s 'OpenXR.Core10.DisplayTiming.waitFrame' call. The
-- runtime /must/ ignore composition layers submitted for an inactive view
-- configuration.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrSecondaryViewConfigurationLayerInfoMSFT-extension-notenabled#
--     The @@ extension /must/ be enabled prior to using
--     'SecondaryViewConfigurationLayerInfoMSFT'
--
-- -   #VUID-XrSecondaryViewConfigurationLayerInfoMSFT-type-type# @type@
--     /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_SECONDARY_VIEW_CONFIGURATION_LAYER_INFO_MSFT'
--
-- -   #VUID-XrSecondaryViewConfigurationLayerInfoMSFT-next-next# @next@
--     /must/ be @NULL@ or a valid pointer to the
--     <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#valid-usage-for-structure-pointer-chains next structure in a structure chain>
--
-- -   #VUID-XrSecondaryViewConfigurationLayerInfoMSFT-viewConfigurationType-parameter#
--     @viewConfigurationType@ /must/ be a valid
--     'OpenXR.Core10.Enums.ViewConfigurationType.ViewConfigurationType'
--     value
--
-- -   #VUID-XrSecondaryViewConfigurationLayerInfoMSFT-environmentBlendMode-parameter#
--     @environmentBlendMode@ /must/ be a valid
--     'OpenXR.Core10.Enums.EnvironmentBlendMode.EnvironmentBlendMode'
--     value
--
-- -   #VUID-XrSecondaryViewConfigurationLayerInfoMSFT-layers-parameter#
--     @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'
--
-- -   #VUID-XrSecondaryViewConfigurationLayerInfoMSFT-layerCount-arraylength#
--     The @layerCount@ parameter /must/ be greater than @0@
--
-- = See Also
--
-- 'OpenXR.Core10.OtherTypes.CompositionLayerBaseHeader',
-- 'OpenXR.Core10.Enums.EnvironmentBlendMode.EnvironmentBlendMode',
-- 'SecondaryViewConfigurationFrameEndInfoMSFT',
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'OpenXR.Core10.Enums.ViewConfigurationType.ViewConfigurationType',
-- 'OpenXR.Core10.DisplayTiming.endFrame'
data SecondaryViewConfigurationLayerInfoMSFT = SecondaryViewConfigurationLayerInfoMSFT
  { -- | @viewConfigurationType@ is
    -- 'OpenXR.Core10.Enums.ViewConfigurationType.ViewConfigurationType' to
    -- which the composition layers will be displayed.
    SecondaryViewConfigurationLayerInfoMSFT -> ViewConfigurationType
viewConfigurationType :: ViewConfigurationType
  , -- | @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 view configuration.
    SecondaryViewConfigurationLayerInfoMSFT -> EnvironmentBlendMode
environmentBlendMode :: EnvironmentBlendMode
  , -- | @layers@ is a pointer to an array of
    -- 'OpenXR.Core10.OtherTypes.CompositionLayerBaseHeader' pointers.
    SecondaryViewConfigurationLayerInfoMSFT
-> Vector (SomeChild (CompositionLayerBaseHeader '[]))
layers :: Vector (SomeChild (CompositionLayerBaseHeader '[]))
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SecondaryViewConfigurationLayerInfoMSFT)
#endif
deriving instance Show SecondaryViewConfigurationLayerInfoMSFT

instance ToCStruct SecondaryViewConfigurationLayerInfoMSFT where
  withCStruct :: SecondaryViewConfigurationLayerInfoMSFT
-> (Ptr SecondaryViewConfigurationLayerInfoMSFT -> IO b) -> IO b
withCStruct x :: SecondaryViewConfigurationLayerInfoMSFT
x f :: Ptr SecondaryViewConfigurationLayerInfoMSFT -> IO b
f = Int
-> Int
-> (Ptr SecondaryViewConfigurationLayerInfoMSFT -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 40 8 ((Ptr SecondaryViewConfigurationLayerInfoMSFT -> IO b) -> IO b)
-> (Ptr SecondaryViewConfigurationLayerInfoMSFT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr SecondaryViewConfigurationLayerInfoMSFT
p -> Ptr SecondaryViewConfigurationLayerInfoMSFT
-> SecondaryViewConfigurationLayerInfoMSFT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SecondaryViewConfigurationLayerInfoMSFT
p SecondaryViewConfigurationLayerInfoMSFT
x (Ptr SecondaryViewConfigurationLayerInfoMSFT -> IO b
f Ptr SecondaryViewConfigurationLayerInfoMSFT
p)
  pokeCStruct :: Ptr SecondaryViewConfigurationLayerInfoMSFT
-> SecondaryViewConfigurationLayerInfoMSFT -> IO b -> IO b
pokeCStruct p :: Ptr SecondaryViewConfigurationLayerInfoMSFT
p SecondaryViewConfigurationLayerInfoMSFT{..} 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 SecondaryViewConfigurationLayerInfoMSFT
p Ptr SecondaryViewConfigurationLayerInfoMSFT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SECONDARY_VIEW_CONFIGURATION_LAYER_INFO_MSFT)
    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 SecondaryViewConfigurationLayerInfoMSFT
p Ptr SecondaryViewConfigurationLayerInfoMSFT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    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 ViewConfigurationType -> ViewConfigurationType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SecondaryViewConfigurationLayerInfoMSFT
p Ptr SecondaryViewConfigurationLayerInfoMSFT
-> Int -> Ptr ViewConfigurationType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr ViewConfigurationType)) (ViewConfigurationType
viewConfigurationType)
    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 SecondaryViewConfigurationLayerInfoMSFT
p Ptr SecondaryViewConfigurationLayerInfoMSFT
-> Int -> Ptr EnvironmentBlendMode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr EnvironmentBlendMode)) (EnvironmentBlendMode
environmentBlendMode)
    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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SecondaryViewConfigurationLayerInfoMSFT
p Ptr SecondaryViewConfigurationLayerInfoMSFT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (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)) :: Word32))
    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)
    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 SecondaryViewConfigurationLayerInfoMSFT
p Ptr SecondaryViewConfigurationLayerInfoMSFT
-> Int -> Ptr (Ptr (Ptr _))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr (Ptr _)))) (Ptr (Ptr Any)
pLayers')
    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 SecondaryViewConfigurationLayerInfoMSFT -> IO b -> IO b
pokeZeroCStruct p :: Ptr SecondaryViewConfigurationLayerInfoMSFT
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 SecondaryViewConfigurationLayerInfoMSFT
p Ptr SecondaryViewConfigurationLayerInfoMSFT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SECONDARY_VIEW_CONFIGURATION_LAYER_INFO_MSFT)
    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 SecondaryViewConfigurationLayerInfoMSFT
p Ptr SecondaryViewConfigurationLayerInfoMSFT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    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 ViewConfigurationType -> ViewConfigurationType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SecondaryViewConfigurationLayerInfoMSFT
p Ptr SecondaryViewConfigurationLayerInfoMSFT
-> Int -> Ptr ViewConfigurationType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr ViewConfigurationType)) (ViewConfigurationType
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 SecondaryViewConfigurationLayerInfoMSFT
p Ptr SecondaryViewConfigurationLayerInfoMSFT
-> Int -> Ptr EnvironmentBlendMode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr EnvironmentBlendMode)) (EnvironmentBlendMode
forall a. Zero a => a
zero)
    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 Any -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Any
forall a. Monoid a => a
mempty)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) 8
    (Int -> SomeChild Any -> ContT b IO ())
-> Vector (SomeChild Any) -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: SomeChild Any
e -> do
      Ptr (SomeChild Any)
layers'' <- ((Ptr (SomeChild Any) -> IO b) -> IO b)
-> ContT b IO (Ptr (SomeChild Any))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (SomeChild Any) -> IO b) -> IO b)
 -> ContT b IO (Ptr (SomeChild Any)))
-> ((Ptr (SomeChild Any) -> IO b) -> IO b)
-> ContT b IO (Ptr (SomeChild Any))
forall a b. (a -> b) -> a -> b
$ SomeChild Any -> (Ptr (SomeChild Any) -> IO b) -> IO b
forall a b. SomeChild a -> (Ptr (SomeChild a) -> IO b) -> IO b
withSomeChild (SomeChild Any
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 Any)) -> Ptr (SomeChild Any) -> 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 Any)
layers'') (Vector (SomeChild Any)
forall a. Monoid a => a
mempty)
    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 SecondaryViewConfigurationLayerInfoMSFT
p Ptr SecondaryViewConfigurationLayerInfoMSFT
-> Int -> Ptr (Ptr (Ptr _))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr (Ptr _)))) (Ptr (Ptr Any)
pLayers')
    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 FromCStruct SecondaryViewConfigurationLayerInfoMSFT where
  peekCStruct :: Ptr SecondaryViewConfigurationLayerInfoMSFT
-> IO SecondaryViewConfigurationLayerInfoMSFT
peekCStruct p :: Ptr SecondaryViewConfigurationLayerInfoMSFT
p = do
    ViewConfigurationType
viewConfigurationType <- Ptr ViewConfigurationType -> IO ViewConfigurationType
forall a. Storable a => Ptr a -> IO a
peek @ViewConfigurationType ((Ptr SecondaryViewConfigurationLayerInfoMSFT
p Ptr SecondaryViewConfigurationLayerInfoMSFT
-> Int -> Ptr ViewConfigurationType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr ViewConfigurationType))
    EnvironmentBlendMode
environmentBlendMode <- Ptr EnvironmentBlendMode -> IO EnvironmentBlendMode
forall a. Storable a => Ptr a -> IO a
peek @EnvironmentBlendMode ((Ptr SecondaryViewConfigurationLayerInfoMSFT
p Ptr SecondaryViewConfigurationLayerInfoMSFT
-> Int -> Ptr EnvironmentBlendMode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr EnvironmentBlendMode))
    Word32
layerCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr SecondaryViewConfigurationLayerInfoMSFT
p Ptr SecondaryViewConfigurationLayerInfoMSFT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: 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 SecondaryViewConfigurationLayerInfoMSFT
p Ptr SecondaryViewConfigurationLayerInfoMSFT
-> Int -> Ptr (Ptr (Ptr _))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr (Ptr _))))
    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 (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
layerCount) (\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 _))))
    SecondaryViewConfigurationLayerInfoMSFT
-> IO SecondaryViewConfigurationLayerInfoMSFT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SecondaryViewConfigurationLayerInfoMSFT
 -> IO SecondaryViewConfigurationLayerInfoMSFT)
-> SecondaryViewConfigurationLayerInfoMSFT
-> IO SecondaryViewConfigurationLayerInfoMSFT
forall a b. (a -> b) -> a -> b
$ ViewConfigurationType
-> EnvironmentBlendMode
-> Vector (SomeChild (CompositionLayerBaseHeader '[]))
-> SecondaryViewConfigurationLayerInfoMSFT
SecondaryViewConfigurationLayerInfoMSFT
             ViewConfigurationType
viewConfigurationType EnvironmentBlendMode
environmentBlendMode Vector (SomeChild (CompositionLayerBaseHeader '[]))
layers'

instance Zero SecondaryViewConfigurationLayerInfoMSFT where
  zero :: SecondaryViewConfigurationLayerInfoMSFT
zero = ViewConfigurationType
-> EnvironmentBlendMode
-> Vector (SomeChild (CompositionLayerBaseHeader '[]))
-> SecondaryViewConfigurationLayerInfoMSFT
SecondaryViewConfigurationLayerInfoMSFT
           ViewConfigurationType
forall a. Zero a => a
zero
           EnvironmentBlendMode
forall a. Zero a => a
zero
           Vector (SomeChild (CompositionLayerBaseHeader '[]))
forall a. Monoid a => a
mempty


-- | XrSecondaryViewConfigurationSwapchainCreateInfoMSFT - Hint to runtime
-- that the created swapchain image will be used for given secondary view
-- configuration.
--
-- == Member Descriptions
--
-- = Description
--
-- If this structure is not present in the
-- 'OpenXR.Core10.Image.SwapchainCreateInfo' next chain when calling
-- 'OpenXR.Core10.Image.createSwapchain', the runtime /should/ optimize the
-- created swapchain for the primary view configuration of the session.
--
-- If the application submits a swapchain image created with one view
-- configuration type to a composition layer for another view
-- configuration, the runtime /may/ need to copy the resource across view
-- configurations. However, the runtime /must/ correctly compose the image
-- regardless which view configuration type was hinted when swapchain image
-- was created.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrSecondaryViewConfigurationSwapchainCreateInfoMSFT-extension-notenabled#
--     The @@ extension /must/ be enabled prior to using
--     'SecondaryViewConfigurationSwapchainCreateInfoMSFT'
--
-- -   #VUID-XrSecondaryViewConfigurationSwapchainCreateInfoMSFT-type-type#
--     @type@ /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_SECONDARY_VIEW_CONFIGURATION_SWAPCHAIN_CREATE_INFO_MSFT'
--
-- -   #VUID-XrSecondaryViewConfigurationSwapchainCreateInfoMSFT-next-next#
--     @next@ /must/ be @NULL@ or a valid pointer to the
--     <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#valid-usage-for-structure-pointer-chains next structure in a structure chain>
--
-- -   #VUID-XrSecondaryViewConfigurationSwapchainCreateInfoMSFT-viewConfigurationType-parameter#
--     @viewConfigurationType@ /must/ be a valid
--     'OpenXR.Core10.Enums.ViewConfigurationType.ViewConfigurationType'
--     value
--
-- = See Also
--
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'OpenXR.Core10.Image.SwapchainCreateInfo',
-- 'OpenXR.Core10.Enums.ViewConfigurationType.ViewConfigurationType'
data SecondaryViewConfigurationSwapchainCreateInfoMSFT = SecondaryViewConfigurationSwapchainCreateInfoMSFT
  { -- | @viewConfigurationType@ is the secondary view configuration type the
    -- application is intending to use this swapchain for.
    SecondaryViewConfigurationSwapchainCreateInfoMSFT
-> ViewConfigurationType
viewConfigurationType :: ViewConfigurationType }
  deriving (Typeable, SecondaryViewConfigurationSwapchainCreateInfoMSFT
-> SecondaryViewConfigurationSwapchainCreateInfoMSFT -> Bool
(SecondaryViewConfigurationSwapchainCreateInfoMSFT
 -> SecondaryViewConfigurationSwapchainCreateInfoMSFT -> Bool)
-> (SecondaryViewConfigurationSwapchainCreateInfoMSFT
    -> SecondaryViewConfigurationSwapchainCreateInfoMSFT -> Bool)
-> Eq SecondaryViewConfigurationSwapchainCreateInfoMSFT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SecondaryViewConfigurationSwapchainCreateInfoMSFT
-> SecondaryViewConfigurationSwapchainCreateInfoMSFT -> Bool
$c/= :: SecondaryViewConfigurationSwapchainCreateInfoMSFT
-> SecondaryViewConfigurationSwapchainCreateInfoMSFT -> Bool
== :: SecondaryViewConfigurationSwapchainCreateInfoMSFT
-> SecondaryViewConfigurationSwapchainCreateInfoMSFT -> Bool
$c== :: SecondaryViewConfigurationSwapchainCreateInfoMSFT
-> SecondaryViewConfigurationSwapchainCreateInfoMSFT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SecondaryViewConfigurationSwapchainCreateInfoMSFT)
#endif
deriving instance Show SecondaryViewConfigurationSwapchainCreateInfoMSFT

instance ToCStruct SecondaryViewConfigurationSwapchainCreateInfoMSFT where
  withCStruct :: SecondaryViewConfigurationSwapchainCreateInfoMSFT
-> (Ptr SecondaryViewConfigurationSwapchainCreateInfoMSFT -> IO b)
-> IO b
withCStruct x :: SecondaryViewConfigurationSwapchainCreateInfoMSFT
x f :: Ptr SecondaryViewConfigurationSwapchainCreateInfoMSFT -> IO b
f = Int
-> Int
-> (Ptr SecondaryViewConfigurationSwapchainCreateInfoMSFT -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 24 8 ((Ptr SecondaryViewConfigurationSwapchainCreateInfoMSFT -> IO b)
 -> IO b)
-> (Ptr SecondaryViewConfigurationSwapchainCreateInfoMSFT -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr SecondaryViewConfigurationSwapchainCreateInfoMSFT
p -> Ptr SecondaryViewConfigurationSwapchainCreateInfoMSFT
-> SecondaryViewConfigurationSwapchainCreateInfoMSFT
-> IO b
-> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SecondaryViewConfigurationSwapchainCreateInfoMSFT
p SecondaryViewConfigurationSwapchainCreateInfoMSFT
x (Ptr SecondaryViewConfigurationSwapchainCreateInfoMSFT -> IO b
f Ptr SecondaryViewConfigurationSwapchainCreateInfoMSFT
p)
  pokeCStruct :: Ptr SecondaryViewConfigurationSwapchainCreateInfoMSFT
-> SecondaryViewConfigurationSwapchainCreateInfoMSFT
-> IO b
-> IO b
pokeCStruct p :: Ptr SecondaryViewConfigurationSwapchainCreateInfoMSFT
p SecondaryViewConfigurationSwapchainCreateInfoMSFT{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SecondaryViewConfigurationSwapchainCreateInfoMSFT
p Ptr SecondaryViewConfigurationSwapchainCreateInfoMSFT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SECONDARY_VIEW_CONFIGURATION_SWAPCHAIN_CREATE_INFO_MSFT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SecondaryViewConfigurationSwapchainCreateInfoMSFT
p Ptr SecondaryViewConfigurationSwapchainCreateInfoMSFT
-> 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 SecondaryViewConfigurationSwapchainCreateInfoMSFT
p Ptr SecondaryViewConfigurationSwapchainCreateInfoMSFT
-> Int -> Ptr ViewConfigurationType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr ViewConfigurationType)) (ViewConfigurationType
viewConfigurationType)
    IO b
f
  cStructSize :: Int
cStructSize = 24
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr SecondaryViewConfigurationSwapchainCreateInfoMSFT
-> IO b -> IO b
pokeZeroCStruct p :: Ptr SecondaryViewConfigurationSwapchainCreateInfoMSFT
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SecondaryViewConfigurationSwapchainCreateInfoMSFT
p Ptr SecondaryViewConfigurationSwapchainCreateInfoMSFT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SECONDARY_VIEW_CONFIGURATION_SWAPCHAIN_CREATE_INFO_MSFT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SecondaryViewConfigurationSwapchainCreateInfoMSFT
p Ptr SecondaryViewConfigurationSwapchainCreateInfoMSFT
-> 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 SecondaryViewConfigurationSwapchainCreateInfoMSFT
p Ptr SecondaryViewConfigurationSwapchainCreateInfoMSFT
-> Int -> Ptr ViewConfigurationType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr ViewConfigurationType)) (ViewConfigurationType
forall a. Zero a => a
zero)
    IO b
f

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

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

instance Zero SecondaryViewConfigurationSwapchainCreateInfoMSFT where
  zero :: SecondaryViewConfigurationSwapchainCreateInfoMSFT
zero = ViewConfigurationType
-> SecondaryViewConfigurationSwapchainCreateInfoMSFT
SecondaryViewConfigurationSwapchainCreateInfoMSFT
           ViewConfigurationType
forall a. Zero a => a
zero


type MSFT_secondary_view_configuration_SPEC_VERSION = 1

-- No documentation found for TopLevel "XR_MSFT_secondary_view_configuration_SPEC_VERSION"
pattern MSFT_secondary_view_configuration_SPEC_VERSION :: forall a . Integral a => a
pattern $bMSFT_secondary_view_configuration_SPEC_VERSION :: a
$mMSFT_secondary_view_configuration_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
MSFT_secondary_view_configuration_SPEC_VERSION = 1


type MSFT_SECONDARY_VIEW_CONFIGURATION_EXTENSION_NAME = "XR_MSFT_secondary_view_configuration"

-- No documentation found for TopLevel "XR_MSFT_SECONDARY_VIEW_CONFIGURATION_EXTENSION_NAME"
pattern MSFT_SECONDARY_VIEW_CONFIGURATION_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bMSFT_SECONDARY_VIEW_CONFIGURATION_EXTENSION_NAME :: a
$mMSFT_SECONDARY_VIEW_CONFIGURATION_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
MSFT_SECONDARY_VIEW_CONFIGURATION_EXTENSION_NAME = "XR_MSFT_secondary_view_configuration"