{-# language CPP #-}
-- No documentation found for Chapter "ViewConfigurationType"
module OpenXR.Core10.Enums.ViewConfigurationType  (ViewConfigurationType( VIEW_CONFIGURATION_TYPE_PRIMARY_MONO
                                                                        , VIEW_CONFIGURATION_TYPE_PRIMARY_STEREO
                                                                        , VIEW_CONFIGURATION_TYPE_SECONDARY_MONO_FIRST_PERSON_OBSERVER_MSFT
                                                                        , VIEW_CONFIGURATION_TYPE_PRIMARY_QUAD_VARJO
                                                                        , ..
                                                                        )) where

import OpenXR.Internal.Utils (enumReadPrec)
import OpenXR.Internal.Utils (enumShowsPrec)
import GHC.Show (showsPrec)
import OpenXR.Zero (Zero)
import Foreign.Storable (Storable)
import Data.Int (Int32)
import GHC.Read (Read(readPrec))
import GHC.Show (Show(showsPrec))

-- | XrViewConfigurationType - Supported view configuration type
--
-- = Description
--
-- The application selects its primary view configuration type when calling
-- 'OpenXR.Core10.Session.beginSession', and that configuration remains
-- constant for the lifetime of the session, until
-- 'OpenXR.Core10.Session.endSession' is called.
--
-- The number of views and the semantic meaning of each view index within a
-- given view configuration is well-defined, specified below for all core
-- view configurations. The predefined primary view configuration types
-- are:
--
-- == Enumerant Descriptions
--
-- = See Also
--
-- 'OpenXR.Extensions.XR_KHR_visibility_mask.EventDataVisibilityMaskChangedKHR',
-- 'OpenXR.Extensions.XR_MSFT_secondary_view_configuration.SecondaryViewConfigurationLayerInfoMSFT',
-- 'OpenXR.Extensions.XR_MSFT_secondary_view_configuration.SecondaryViewConfigurationSessionBeginInfoMSFT',
-- 'OpenXR.Extensions.XR_MSFT_secondary_view_configuration.SecondaryViewConfigurationStateMSFT',
-- 'OpenXR.Extensions.XR_MSFT_secondary_view_configuration.SecondaryViewConfigurationSwapchainCreateInfoMSFT',
-- 'OpenXR.Core10.Session.SessionBeginInfo',
-- 'OpenXR.Core10.ViewConfigurations.ViewConfigurationProperties',
-- 'OpenXR.Core10.DisplayTiming.ViewLocateInfo',
-- 'OpenXR.Core10.Device.enumerateEnvironmentBlendModes',
-- 'OpenXR.Core10.ViewConfigurations.enumerateViewConfigurationViews',
-- 'OpenXR.Core10.ViewConfigurations.enumerateViewConfigurations',
-- 'OpenXR.Core10.ViewConfigurations.getViewConfigurationProperties',
-- 'OpenXR.Extensions.XR_KHR_visibility_mask.getVisibilityMaskKHR'
newtype ViewConfigurationType = ViewConfigurationType Int32
  deriving newtype (ViewConfigurationType -> ViewConfigurationType -> Bool
(ViewConfigurationType -> ViewConfigurationType -> Bool)
-> (ViewConfigurationType -> ViewConfigurationType -> Bool)
-> Eq ViewConfigurationType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ViewConfigurationType -> ViewConfigurationType -> Bool
$c/= :: ViewConfigurationType -> ViewConfigurationType -> Bool
== :: ViewConfigurationType -> ViewConfigurationType -> Bool
$c== :: ViewConfigurationType -> ViewConfigurationType -> Bool
Eq, Eq ViewConfigurationType
Eq ViewConfigurationType =>
(ViewConfigurationType -> ViewConfigurationType -> Ordering)
-> (ViewConfigurationType -> ViewConfigurationType -> Bool)
-> (ViewConfigurationType -> ViewConfigurationType -> Bool)
-> (ViewConfigurationType -> ViewConfigurationType -> Bool)
-> (ViewConfigurationType -> ViewConfigurationType -> Bool)
-> (ViewConfigurationType
    -> ViewConfigurationType -> ViewConfigurationType)
-> (ViewConfigurationType
    -> ViewConfigurationType -> ViewConfigurationType)
-> Ord ViewConfigurationType
ViewConfigurationType -> ViewConfigurationType -> Bool
ViewConfigurationType -> ViewConfigurationType -> Ordering
ViewConfigurationType
-> ViewConfigurationType -> ViewConfigurationType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ViewConfigurationType
-> ViewConfigurationType -> ViewConfigurationType
$cmin :: ViewConfigurationType
-> ViewConfigurationType -> ViewConfigurationType
max :: ViewConfigurationType
-> ViewConfigurationType -> ViewConfigurationType
$cmax :: ViewConfigurationType
-> ViewConfigurationType -> ViewConfigurationType
>= :: ViewConfigurationType -> ViewConfigurationType -> Bool
$c>= :: ViewConfigurationType -> ViewConfigurationType -> Bool
> :: ViewConfigurationType -> ViewConfigurationType -> Bool
$c> :: ViewConfigurationType -> ViewConfigurationType -> Bool
<= :: ViewConfigurationType -> ViewConfigurationType -> Bool
$c<= :: ViewConfigurationType -> ViewConfigurationType -> Bool
< :: ViewConfigurationType -> ViewConfigurationType -> Bool
$c< :: ViewConfigurationType -> ViewConfigurationType -> Bool
compare :: ViewConfigurationType -> ViewConfigurationType -> Ordering
$ccompare :: ViewConfigurationType -> ViewConfigurationType -> Ordering
$cp1Ord :: Eq ViewConfigurationType
Ord, Ptr b -> Int -> IO ViewConfigurationType
Ptr b -> Int -> ViewConfigurationType -> IO ()
Ptr ViewConfigurationType -> IO ViewConfigurationType
Ptr ViewConfigurationType -> Int -> IO ViewConfigurationType
Ptr ViewConfigurationType -> Int -> ViewConfigurationType -> IO ()
Ptr ViewConfigurationType -> ViewConfigurationType -> IO ()
ViewConfigurationType -> Int
(ViewConfigurationType -> Int)
-> (ViewConfigurationType -> Int)
-> (Ptr ViewConfigurationType -> Int -> IO ViewConfigurationType)
-> (Ptr ViewConfigurationType
    -> Int -> ViewConfigurationType -> IO ())
-> (forall b. Ptr b -> Int -> IO ViewConfigurationType)
-> (forall b. Ptr b -> Int -> ViewConfigurationType -> IO ())
-> (Ptr ViewConfigurationType -> IO ViewConfigurationType)
-> (Ptr ViewConfigurationType -> ViewConfigurationType -> IO ())
-> Storable ViewConfigurationType
forall b. Ptr b -> Int -> IO ViewConfigurationType
forall b. Ptr b -> Int -> ViewConfigurationType -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr ViewConfigurationType -> ViewConfigurationType -> IO ()
$cpoke :: Ptr ViewConfigurationType -> ViewConfigurationType -> IO ()
peek :: Ptr ViewConfigurationType -> IO ViewConfigurationType
$cpeek :: Ptr ViewConfigurationType -> IO ViewConfigurationType
pokeByteOff :: Ptr b -> Int -> ViewConfigurationType -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> ViewConfigurationType -> IO ()
peekByteOff :: Ptr b -> Int -> IO ViewConfigurationType
$cpeekByteOff :: forall b. Ptr b -> Int -> IO ViewConfigurationType
pokeElemOff :: Ptr ViewConfigurationType -> Int -> ViewConfigurationType -> IO ()
$cpokeElemOff :: Ptr ViewConfigurationType -> Int -> ViewConfigurationType -> IO ()
peekElemOff :: Ptr ViewConfigurationType -> Int -> IO ViewConfigurationType
$cpeekElemOff :: Ptr ViewConfigurationType -> Int -> IO ViewConfigurationType
alignment :: ViewConfigurationType -> Int
$calignment :: ViewConfigurationType -> Int
sizeOf :: ViewConfigurationType -> Int
$csizeOf :: ViewConfigurationType -> Int
Storable, ViewConfigurationType
ViewConfigurationType -> Zero ViewConfigurationType
forall a. a -> Zero a
zero :: ViewConfigurationType
$czero :: ViewConfigurationType
Zero)
-- Note that the zero instance does not produce a valid value, passing 'zero' to Vulkan will result in an error

-- | 'VIEW_CONFIGURATION_TYPE_PRIMARY_MONO'. One view representing the form
-- factor’s one primary display. For example, an AR phone’s screen. This
-- configuration requires one element in
-- 'OpenXR.Core10.ViewConfigurations.ViewConfigurationProperties' and one
-- projection in each 'OpenXR.Core10.OtherTypes.CompositionLayerProjection'
-- layer.
pattern $bVIEW_CONFIGURATION_TYPE_PRIMARY_MONO :: ViewConfigurationType
$mVIEW_CONFIGURATION_TYPE_PRIMARY_MONO :: forall r.
ViewConfigurationType -> (Void# -> r) -> (Void# -> r) -> r
VIEW_CONFIGURATION_TYPE_PRIMARY_MONO                              = ViewConfigurationType 1
-- | 'VIEW_CONFIGURATION_TYPE_PRIMARY_STEREO'. Two views representing the
-- form factor’s two primary displays, which map to a left-eye and
-- right-eye view. This configuration requires two views in
-- 'OpenXR.Core10.ViewConfigurations.ViewConfigurationProperties' and two
-- views in each 'OpenXR.Core10.OtherTypes.CompositionLayerProjection'
-- layer. View index 0 /must/ represent the left eye and view index 1
-- /must/ represent the right eye.
pattern $bVIEW_CONFIGURATION_TYPE_PRIMARY_STEREO :: ViewConfigurationType
$mVIEW_CONFIGURATION_TYPE_PRIMARY_STEREO :: forall r.
ViewConfigurationType -> (Void# -> r) -> (Void# -> r) -> r
VIEW_CONFIGURATION_TYPE_PRIMARY_STEREO                            = ViewConfigurationType 2
-- No documentation found for Nested "XrViewConfigurationType" "XR_VIEW_CONFIGURATION_TYPE_SECONDARY_MONO_FIRST_PERSON_OBSERVER_MSFT"
pattern $bVIEW_CONFIGURATION_TYPE_SECONDARY_MONO_FIRST_PERSON_OBSERVER_MSFT :: ViewConfigurationType
$mVIEW_CONFIGURATION_TYPE_SECONDARY_MONO_FIRST_PERSON_OBSERVER_MSFT :: forall r.
ViewConfigurationType -> (Void# -> r) -> (Void# -> r) -> r
VIEW_CONFIGURATION_TYPE_SECONDARY_MONO_FIRST_PERSON_OBSERVER_MSFT = ViewConfigurationType 1000054000
-- No documentation found for Nested "XrViewConfigurationType" "XR_VIEW_CONFIGURATION_TYPE_PRIMARY_QUAD_VARJO"
pattern $bVIEW_CONFIGURATION_TYPE_PRIMARY_QUAD_VARJO :: ViewConfigurationType
$mVIEW_CONFIGURATION_TYPE_PRIMARY_QUAD_VARJO :: forall r.
ViewConfigurationType -> (Void# -> r) -> (Void# -> r) -> r
VIEW_CONFIGURATION_TYPE_PRIMARY_QUAD_VARJO                        = ViewConfigurationType 1000037000
{-# complete VIEW_CONFIGURATION_TYPE_PRIMARY_MONO,
             VIEW_CONFIGURATION_TYPE_PRIMARY_STEREO,
             VIEW_CONFIGURATION_TYPE_SECONDARY_MONO_FIRST_PERSON_OBSERVER_MSFT,
             VIEW_CONFIGURATION_TYPE_PRIMARY_QUAD_VARJO :: ViewConfigurationType #-}

conNameViewConfigurationType :: String
conNameViewConfigurationType :: String
conNameViewConfigurationType = "ViewConfigurationType"

enumPrefixViewConfigurationType :: String
enumPrefixViewConfigurationType :: String
enumPrefixViewConfigurationType = "VIEW_CONFIGURATION_TYPE_"

showTableViewConfigurationType :: [(ViewConfigurationType, String)]
showTableViewConfigurationType :: [(ViewConfigurationType, String)]
showTableViewConfigurationType =
  [ (ViewConfigurationType
VIEW_CONFIGURATION_TYPE_PRIMARY_MONO                             , "PRIMARY_MONO")
  , (ViewConfigurationType
VIEW_CONFIGURATION_TYPE_PRIMARY_STEREO                           , "PRIMARY_STEREO")
  , (ViewConfigurationType
VIEW_CONFIGURATION_TYPE_SECONDARY_MONO_FIRST_PERSON_OBSERVER_MSFT, "SECONDARY_MONO_FIRST_PERSON_OBSERVER_MSFT")
  , (ViewConfigurationType
VIEW_CONFIGURATION_TYPE_PRIMARY_QUAD_VARJO                       , "PRIMARY_QUAD_VARJO")
  ]

instance Show ViewConfigurationType where
  showsPrec :: Int -> ViewConfigurationType -> ShowS
showsPrec = String
-> [(ViewConfigurationType, String)]
-> String
-> (ViewConfigurationType -> Int32)
-> (Int32 -> ShowS)
-> Int
-> ViewConfigurationType
-> ShowS
forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec String
enumPrefixViewConfigurationType
                            [(ViewConfigurationType, String)]
showTableViewConfigurationType
                            String
conNameViewConfigurationType
                            (\(ViewConfigurationType x :: Int32
x) -> Int32
x)
                            (Int -> Int32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 11)

instance Read ViewConfigurationType where
  readPrec :: ReadPrec ViewConfigurationType
readPrec = String
-> [(ViewConfigurationType, String)]
-> String
-> (Int32 -> ViewConfigurationType)
-> ReadPrec ViewConfigurationType
forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec String
enumPrefixViewConfigurationType
                          [(ViewConfigurationType, String)]
showTableViewConfigurationType
                          String
conNameViewConfigurationType
                          Int32 -> ViewConfigurationType
ViewConfigurationType