{-# language CPP #-}
-- No documentation found for Chapter "ObjectType"
module OpenXR.Core10.Enums.ObjectType  (ObjectType( OBJECT_TYPE_UNKNOWN
                                                  , OBJECT_TYPE_INSTANCE
                                                  , OBJECT_TYPE_SESSION
                                                  , OBJECT_TYPE_SWAPCHAIN
                                                  , OBJECT_TYPE_SPACE
                                                  , OBJECT_TYPE_ACTION_SET
                                                  , OBJECT_TYPE_ACTION
                                                  , OBJECT_TYPE_HAND_TRACKER_EXT
                                                  , OBJECT_TYPE_SPATIAL_ANCHOR_MSFT
                                                  , OBJECT_TYPE_DEBUG_UTILS_MESSENGER_EXT
                                                  , ..
                                                  )) 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))

-- | XrObjectType - Specify an enumeration to track object handle types
--
-- = Description
--
-- The 'ObjectType' enumeration defines values, each of which corresponds
-- to a specific OpenXR handle type. These values /can/ be used to
-- associate debug information with a particular type of object through one
-- or more extensions.
--
-- The following table defines 'ObjectType' and OpenXR Handle
-- relationships:
--
-- +------------------------------------------+-----------------------------------+
-- | 'ObjectType'                             | OpenXR Handle Type                |
-- +==========================================+===================================+
-- | 'OBJECT_TYPE_UNKNOWN'                    | Unknown\/Undefined Handle         |
-- +------------------------------------------+-----------------------------------+
-- | 'OBJECT_TYPE_INSTANCE'                   | 'OpenXR.Core10.Handles.Instance'  |
-- +------------------------------------------+-----------------------------------+
-- | 'OBJECT_TYPE_SESSION'                    | 'OpenXR.Core10.Handles.Session'   |
-- +------------------------------------------+-----------------------------------+
-- | 'OBJECT_TYPE_SWAPCHAIN'                  | 'OpenXR.Core10.Handles.Swapchain' |
-- +------------------------------------------+-----------------------------------+
-- | 'OBJECT_TYPE_SPACE'                      | 'OpenXR.Core10.Handles.Space'     |
-- +------------------------------------------+-----------------------------------+
-- | 'OBJECT_TYPE_ACTION_SET'                 | 'OpenXR.Core10.Handles.ActionSet' |
-- +------------------------------------------+-----------------------------------+
-- | 'OBJECT_TYPE_ACTION'                     | 'OpenXR.Core10.Handles.Action'    |
-- +------------------------------------------+-----------------------------------+
--
-- = See Also
--
-- 'OpenXR.Extensions.XR_EXT_debug_utils.DebugUtilsObjectNameInfoEXT'
newtype ObjectType = ObjectType Int32
  deriving newtype (ObjectType -> ObjectType -> Bool
(ObjectType -> ObjectType -> Bool)
-> (ObjectType -> ObjectType -> Bool) -> Eq ObjectType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ObjectType -> ObjectType -> Bool
$c/= :: ObjectType -> ObjectType -> Bool
== :: ObjectType -> ObjectType -> Bool
$c== :: ObjectType -> ObjectType -> Bool
Eq, Eq ObjectType
Eq ObjectType =>
(ObjectType -> ObjectType -> Ordering)
-> (ObjectType -> ObjectType -> Bool)
-> (ObjectType -> ObjectType -> Bool)
-> (ObjectType -> ObjectType -> Bool)
-> (ObjectType -> ObjectType -> Bool)
-> (ObjectType -> ObjectType -> ObjectType)
-> (ObjectType -> ObjectType -> ObjectType)
-> Ord ObjectType
ObjectType -> ObjectType -> Bool
ObjectType -> ObjectType -> Ordering
ObjectType -> ObjectType -> ObjectType
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 :: ObjectType -> ObjectType -> ObjectType
$cmin :: ObjectType -> ObjectType -> ObjectType
max :: ObjectType -> ObjectType -> ObjectType
$cmax :: ObjectType -> ObjectType -> ObjectType
>= :: ObjectType -> ObjectType -> Bool
$c>= :: ObjectType -> ObjectType -> Bool
> :: ObjectType -> ObjectType -> Bool
$c> :: ObjectType -> ObjectType -> Bool
<= :: ObjectType -> ObjectType -> Bool
$c<= :: ObjectType -> ObjectType -> Bool
< :: ObjectType -> ObjectType -> Bool
$c< :: ObjectType -> ObjectType -> Bool
compare :: ObjectType -> ObjectType -> Ordering
$ccompare :: ObjectType -> ObjectType -> Ordering
$cp1Ord :: Eq ObjectType
Ord, Ptr b -> Int -> IO ObjectType
Ptr b -> Int -> ObjectType -> IO ()
Ptr ObjectType -> IO ObjectType
Ptr ObjectType -> Int -> IO ObjectType
Ptr ObjectType -> Int -> ObjectType -> IO ()
Ptr ObjectType -> ObjectType -> IO ()
ObjectType -> Int
(ObjectType -> Int)
-> (ObjectType -> Int)
-> (Ptr ObjectType -> Int -> IO ObjectType)
-> (Ptr ObjectType -> Int -> ObjectType -> IO ())
-> (forall b. Ptr b -> Int -> IO ObjectType)
-> (forall b. Ptr b -> Int -> ObjectType -> IO ())
-> (Ptr ObjectType -> IO ObjectType)
-> (Ptr ObjectType -> ObjectType -> IO ())
-> Storable ObjectType
forall b. Ptr b -> Int -> IO ObjectType
forall b. Ptr b -> Int -> ObjectType -> 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 ObjectType -> ObjectType -> IO ()
$cpoke :: Ptr ObjectType -> ObjectType -> IO ()
peek :: Ptr ObjectType -> IO ObjectType
$cpeek :: Ptr ObjectType -> IO ObjectType
pokeByteOff :: Ptr b -> Int -> ObjectType -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> ObjectType -> IO ()
peekByteOff :: Ptr b -> Int -> IO ObjectType
$cpeekByteOff :: forall b. Ptr b -> Int -> IO ObjectType
pokeElemOff :: Ptr ObjectType -> Int -> ObjectType -> IO ()
$cpokeElemOff :: Ptr ObjectType -> Int -> ObjectType -> IO ()
peekElemOff :: Ptr ObjectType -> Int -> IO ObjectType
$cpeekElemOff :: Ptr ObjectType -> Int -> IO ObjectType
alignment :: ObjectType -> Int
$calignment :: ObjectType -> Int
sizeOf :: ObjectType -> Int
$csizeOf :: ObjectType -> Int
Storable, ObjectType
ObjectType -> Zero ObjectType
forall a. a -> Zero a
zero :: ObjectType
$czero :: ObjectType
Zero)

-- No documentation found for Nested "XrObjectType" "XR_OBJECT_TYPE_UNKNOWN"
pattern $bOBJECT_TYPE_UNKNOWN :: ObjectType
$mOBJECT_TYPE_UNKNOWN :: forall r. ObjectType -> (Void# -> r) -> (Void# -> r) -> r
OBJECT_TYPE_UNKNOWN                   = ObjectType 0
-- No documentation found for Nested "XrObjectType" "XR_OBJECT_TYPE_INSTANCE"
pattern $bOBJECT_TYPE_INSTANCE :: ObjectType
$mOBJECT_TYPE_INSTANCE :: forall r. ObjectType -> (Void# -> r) -> (Void# -> r) -> r
OBJECT_TYPE_INSTANCE                  = ObjectType 1
-- No documentation found for Nested "XrObjectType" "XR_OBJECT_TYPE_SESSION"
pattern $bOBJECT_TYPE_SESSION :: ObjectType
$mOBJECT_TYPE_SESSION :: forall r. ObjectType -> (Void# -> r) -> (Void# -> r) -> r
OBJECT_TYPE_SESSION                   = ObjectType 2
-- No documentation found for Nested "XrObjectType" "XR_OBJECT_TYPE_SWAPCHAIN"
pattern $bOBJECT_TYPE_SWAPCHAIN :: ObjectType
$mOBJECT_TYPE_SWAPCHAIN :: forall r. ObjectType -> (Void# -> r) -> (Void# -> r) -> r
OBJECT_TYPE_SWAPCHAIN                 = ObjectType 3
-- No documentation found for Nested "XrObjectType" "XR_OBJECT_TYPE_SPACE"
pattern $bOBJECT_TYPE_SPACE :: ObjectType
$mOBJECT_TYPE_SPACE :: forall r. ObjectType -> (Void# -> r) -> (Void# -> r) -> r
OBJECT_TYPE_SPACE                     = ObjectType 4
-- No documentation found for Nested "XrObjectType" "XR_OBJECT_TYPE_ACTION_SET"
pattern $bOBJECT_TYPE_ACTION_SET :: ObjectType
$mOBJECT_TYPE_ACTION_SET :: forall r. ObjectType -> (Void# -> r) -> (Void# -> r) -> r
OBJECT_TYPE_ACTION_SET                = ObjectType 5
-- No documentation found for Nested "XrObjectType" "XR_OBJECT_TYPE_ACTION"
pattern $bOBJECT_TYPE_ACTION :: ObjectType
$mOBJECT_TYPE_ACTION :: forall r. ObjectType -> (Void# -> r) -> (Void# -> r) -> r
OBJECT_TYPE_ACTION                    = ObjectType 6
-- No documentation found for Nested "XrObjectType" "XR_OBJECT_TYPE_HAND_TRACKER_EXT"
pattern $bOBJECT_TYPE_HAND_TRACKER_EXT :: ObjectType
$mOBJECT_TYPE_HAND_TRACKER_EXT :: forall r. ObjectType -> (Void# -> r) -> (Void# -> r) -> r
OBJECT_TYPE_HAND_TRACKER_EXT          = ObjectType 1000051000
-- No documentation found for Nested "XrObjectType" "XR_OBJECT_TYPE_SPATIAL_ANCHOR_MSFT"
pattern $bOBJECT_TYPE_SPATIAL_ANCHOR_MSFT :: ObjectType
$mOBJECT_TYPE_SPATIAL_ANCHOR_MSFT :: forall r. ObjectType -> (Void# -> r) -> (Void# -> r) -> r
OBJECT_TYPE_SPATIAL_ANCHOR_MSFT       = ObjectType 1000039000
-- No documentation found for Nested "XrObjectType" "XR_OBJECT_TYPE_DEBUG_UTILS_MESSENGER_EXT"
pattern $bOBJECT_TYPE_DEBUG_UTILS_MESSENGER_EXT :: ObjectType
$mOBJECT_TYPE_DEBUG_UTILS_MESSENGER_EXT :: forall r. ObjectType -> (Void# -> r) -> (Void# -> r) -> r
OBJECT_TYPE_DEBUG_UTILS_MESSENGER_EXT = ObjectType 1000019000
{-# complete OBJECT_TYPE_UNKNOWN,
             OBJECT_TYPE_INSTANCE,
             OBJECT_TYPE_SESSION,
             OBJECT_TYPE_SWAPCHAIN,
             OBJECT_TYPE_SPACE,
             OBJECT_TYPE_ACTION_SET,
             OBJECT_TYPE_ACTION,
             OBJECT_TYPE_HAND_TRACKER_EXT,
             OBJECT_TYPE_SPATIAL_ANCHOR_MSFT,
             OBJECT_TYPE_DEBUG_UTILS_MESSENGER_EXT :: ObjectType #-}

conNameObjectType :: String
conNameObjectType :: String
conNameObjectType = "ObjectType"

enumPrefixObjectType :: String
enumPrefixObjectType :: String
enumPrefixObjectType = "OBJECT_TYPE_"

showTableObjectType :: [(ObjectType, String)]
showTableObjectType :: [(ObjectType, String)]
showTableObjectType =
  [ (ObjectType
OBJECT_TYPE_UNKNOWN                  , "UNKNOWN")
  , (ObjectType
OBJECT_TYPE_INSTANCE                 , "INSTANCE")
  , (ObjectType
OBJECT_TYPE_SESSION                  , "SESSION")
  , (ObjectType
OBJECT_TYPE_SWAPCHAIN                , "SWAPCHAIN")
  , (ObjectType
OBJECT_TYPE_SPACE                    , "SPACE")
  , (ObjectType
OBJECT_TYPE_ACTION_SET               , "ACTION_SET")
  , (ObjectType
OBJECT_TYPE_ACTION                   , "ACTION")
  , (ObjectType
OBJECT_TYPE_HAND_TRACKER_EXT         , "HAND_TRACKER_EXT")
  , (ObjectType
OBJECT_TYPE_SPATIAL_ANCHOR_MSFT      , "SPATIAL_ANCHOR_MSFT")
  , (ObjectType
OBJECT_TYPE_DEBUG_UTILS_MESSENGER_EXT, "DEBUG_UTILS_MESSENGER_EXT")
  ]

instance Show ObjectType where
  showsPrec :: Int -> ObjectType -> ShowS
showsPrec =
    String
-> [(ObjectType, String)]
-> String
-> (ObjectType -> Int32)
-> (Int32 -> ShowS)
-> Int
-> ObjectType
-> ShowS
forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec String
enumPrefixObjectType [(ObjectType, String)]
showTableObjectType String
conNameObjectType (\(ObjectType x :: Int32
x) -> Int32
x) (Int -> Int32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 11)

instance Read ObjectType where
  readPrec :: ReadPrec ObjectType
readPrec = String
-> [(ObjectType, String)]
-> String
-> (Int32 -> ObjectType)
-> ReadPrec ObjectType
forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec String
enumPrefixObjectType [(ObjectType, String)]
showTableObjectType String
conNameObjectType Int32 -> ObjectType
ObjectType