{-# language CPP #-}
-- No documentation found for Chapter "ActionType"
module OpenXR.Core10.Enums.ActionType  (ActionType( ACTION_TYPE_BOOLEAN_INPUT
                                                  , ACTION_TYPE_FLOAT_INPUT
                                                  , ACTION_TYPE_VECTOR2F_INPUT
                                                  , ACTION_TYPE_POSE_INPUT
                                                  , ACTION_TYPE_VIBRATION_OUTPUT
                                                  , ..
                                                  )) 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))

-- | XrActionType - XrAction type
--
-- == Enumerant Descriptions
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Action', 'OpenXR.Core10.Input.ActionCreateInfo',
-- 'OpenXR.Core10.Input.createActionSet'
newtype ActionType = ActionType Int32
  deriving newtype (ActionType -> ActionType -> Bool
(ActionType -> ActionType -> Bool)
-> (ActionType -> ActionType -> Bool) -> Eq ActionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionType -> ActionType -> Bool
$c/= :: ActionType -> ActionType -> Bool
== :: ActionType -> ActionType -> Bool
$c== :: ActionType -> ActionType -> Bool
Eq, Eq ActionType
Eq ActionType =>
(ActionType -> ActionType -> Ordering)
-> (ActionType -> ActionType -> Bool)
-> (ActionType -> ActionType -> Bool)
-> (ActionType -> ActionType -> Bool)
-> (ActionType -> ActionType -> Bool)
-> (ActionType -> ActionType -> ActionType)
-> (ActionType -> ActionType -> ActionType)
-> Ord ActionType
ActionType -> ActionType -> Bool
ActionType -> ActionType -> Ordering
ActionType -> ActionType -> ActionType
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 :: ActionType -> ActionType -> ActionType
$cmin :: ActionType -> ActionType -> ActionType
max :: ActionType -> ActionType -> ActionType
$cmax :: ActionType -> ActionType -> ActionType
>= :: ActionType -> ActionType -> Bool
$c>= :: ActionType -> ActionType -> Bool
> :: ActionType -> ActionType -> Bool
$c> :: ActionType -> ActionType -> Bool
<= :: ActionType -> ActionType -> Bool
$c<= :: ActionType -> ActionType -> Bool
< :: ActionType -> ActionType -> Bool
$c< :: ActionType -> ActionType -> Bool
compare :: ActionType -> ActionType -> Ordering
$ccompare :: ActionType -> ActionType -> Ordering
$cp1Ord :: Eq ActionType
Ord, Ptr b -> Int -> IO ActionType
Ptr b -> Int -> ActionType -> IO ()
Ptr ActionType -> IO ActionType
Ptr ActionType -> Int -> IO ActionType
Ptr ActionType -> Int -> ActionType -> IO ()
Ptr ActionType -> ActionType -> IO ()
ActionType -> Int
(ActionType -> Int)
-> (ActionType -> Int)
-> (Ptr ActionType -> Int -> IO ActionType)
-> (Ptr ActionType -> Int -> ActionType -> IO ())
-> (forall b. Ptr b -> Int -> IO ActionType)
-> (forall b. Ptr b -> Int -> ActionType -> IO ())
-> (Ptr ActionType -> IO ActionType)
-> (Ptr ActionType -> ActionType -> IO ())
-> Storable ActionType
forall b. Ptr b -> Int -> IO ActionType
forall b. Ptr b -> Int -> ActionType -> 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 ActionType -> ActionType -> IO ()
$cpoke :: Ptr ActionType -> ActionType -> IO ()
peek :: Ptr ActionType -> IO ActionType
$cpeek :: Ptr ActionType -> IO ActionType
pokeByteOff :: Ptr b -> Int -> ActionType -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> ActionType -> IO ()
peekByteOff :: Ptr b -> Int -> IO ActionType
$cpeekByteOff :: forall b. Ptr b -> Int -> IO ActionType
pokeElemOff :: Ptr ActionType -> Int -> ActionType -> IO ()
$cpokeElemOff :: Ptr ActionType -> Int -> ActionType -> IO ()
peekElemOff :: Ptr ActionType -> Int -> IO ActionType
$cpeekElemOff :: Ptr ActionType -> Int -> IO ActionType
alignment :: ActionType -> Int
$calignment :: ActionType -> Int
sizeOf :: ActionType -> Int
$csizeOf :: ActionType -> Int
Storable, ActionType
ActionType -> Zero ActionType
forall a. a -> Zero a
zero :: ActionType
$czero :: ActionType
Zero)
-- Note that the zero instance does not produce a valid value, passing 'zero' to Vulkan will result in an error

-- | 'ACTION_TYPE_BOOLEAN_INPUT'. The action can be passed to
-- 'OpenXR.Core10.Input.getActionStateBoolean' to retrieve a boolean value.
pattern $bACTION_TYPE_BOOLEAN_INPUT :: ActionType
$mACTION_TYPE_BOOLEAN_INPUT :: forall r. ActionType -> (Void# -> r) -> (Void# -> r) -> r
ACTION_TYPE_BOOLEAN_INPUT    = ActionType 1
-- | 'ACTION_TYPE_FLOAT_INPUT'. The action can be passed to
-- 'OpenXR.Core10.Input.getActionStateFloat' to retrieve a float value.
pattern $bACTION_TYPE_FLOAT_INPUT :: ActionType
$mACTION_TYPE_FLOAT_INPUT :: forall r. ActionType -> (Void# -> r) -> (Void# -> r) -> r
ACTION_TYPE_FLOAT_INPUT      = ActionType 2
-- | 'ACTION_TYPE_VECTOR2F_INPUT'. The action can be passed to
-- 'OpenXR.Core10.Input.getActionStateVector2f' to retrieve a 2D float
-- vector.
pattern $bACTION_TYPE_VECTOR2F_INPUT :: ActionType
$mACTION_TYPE_VECTOR2F_INPUT :: forall r. ActionType -> (Void# -> r) -> (Void# -> r) -> r
ACTION_TYPE_VECTOR2F_INPUT   = ActionType 3
-- | 'ACTION_TYPE_POSE_INPUT'. The action can can be passed to
-- 'OpenXR.Core10.Space.createActionSpace' to create a space.
pattern $bACTION_TYPE_POSE_INPUT :: ActionType
$mACTION_TYPE_POSE_INPUT :: forall r. ActionType -> (Void# -> r) -> (Void# -> r) -> r
ACTION_TYPE_POSE_INPUT       = ActionType 4
-- | 'ACTION_TYPE_VIBRATION_OUTPUT'. The action can be passed to
-- 'OpenXR.Core10.Haptics.applyHapticFeedback' to send a haptic event to
-- the runtime.
pattern $bACTION_TYPE_VIBRATION_OUTPUT :: ActionType
$mACTION_TYPE_VIBRATION_OUTPUT :: forall r. ActionType -> (Void# -> r) -> (Void# -> r) -> r
ACTION_TYPE_VIBRATION_OUTPUT = ActionType 100
{-# complete ACTION_TYPE_BOOLEAN_INPUT,
             ACTION_TYPE_FLOAT_INPUT,
             ACTION_TYPE_VECTOR2F_INPUT,
             ACTION_TYPE_POSE_INPUT,
             ACTION_TYPE_VIBRATION_OUTPUT :: ActionType #-}

conNameActionType :: String
conNameActionType :: String
conNameActionType = "ActionType"

enumPrefixActionType :: String
enumPrefixActionType :: String
enumPrefixActionType = "ACTION_TYPE_"

showTableActionType :: [(ActionType, String)]
showTableActionType :: [(ActionType, String)]
showTableActionType =
  [ (ActionType
ACTION_TYPE_BOOLEAN_INPUT   , "BOOLEAN_INPUT")
  , (ActionType
ACTION_TYPE_FLOAT_INPUT     , "FLOAT_INPUT")
  , (ActionType
ACTION_TYPE_VECTOR2F_INPUT  , "VECTOR2F_INPUT")
  , (ActionType
ACTION_TYPE_POSE_INPUT      , "POSE_INPUT")
  , (ActionType
ACTION_TYPE_VIBRATION_OUTPUT, "VIBRATION_OUTPUT")
  ]

instance Show ActionType where
  showsPrec :: Int -> ActionType -> ShowS
showsPrec =
    String
-> [(ActionType, String)]
-> String
-> (ActionType -> Int32)
-> (Int32 -> ShowS)
-> Int
-> ActionType
-> ShowS
forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec String
enumPrefixActionType [(ActionType, String)]
showTableActionType String
conNameActionType (\(ActionType x :: Int32
x) -> Int32
x) (Int -> Int32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 11)

instance Read ActionType where
  readPrec :: ReadPrec ActionType
readPrec = String
-> [(ActionType, String)]
-> String
-> (Int32 -> ActionType)
-> ReadPrec ActionType
forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec String
enumPrefixActionType [(ActionType, String)]
showTableActionType String
conNameActionType Int32 -> ActionType
ActionType