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

import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Marshal.Utils (maybePeek)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Data.Coerce (coerce)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
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.C.Types (CFloat)
import Foreign.C.Types (CFloat(..))
import Foreign.C.Types (CFloat(CFloat))
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import GHC.Generics (Generic)
import Foreign.Ptr (Ptr)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import OpenXR.CStruct.Extends (withSomeChild)
import OpenXR.Core10.Handles (Action_T)
import OpenXR.Core10.Haptics (HapticBaseHeader)
import OpenXR.CStruct.Extends (Inheritable(peekSomeCChild))
import OpenXR.Core10.SemanticPaths (Path)
import OpenXR.CStruct.Extends (SomeChild)
import OpenXR.Core10.Enums.StructureType (StructureType)
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_INTERACTION_PROFILE_ANALOG_THRESHOLD_VALVE))
-- | XrInteractionProfileAnalogThresholdVALVE - Interaction profile dpad
-- binding
--
-- == Member Descriptions
--
-- = Description
--
-- Applications can chain an 'InteractionProfileAnalogThresholdVALVE'
-- struct on the next chain of any
-- 'OpenXR.Core10.Input.suggestInteractionProfileBindings' call for each
-- analog to boolean conversion for which it wants to set the threshold. If
-- a threshold struct is present for a given conversion, the runtime /must/
-- use those thresholds instead of applying its own whenever it is using
-- the binding suggested by the application.
--
-- @onThreshold@ and @offThreshold@ permit allow the application to specify
-- that it wants hysteresis to be applied to the threshold operation. If
-- @onThreshold@ is smaller than @offThreshold@, the runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'.
--
-- @onHaptic@ and @offHaptic@ allow the application to specify that it
-- wants automatic haptic feedback to be generated when the boolean output
-- of the threshold operation changes from false to true or vice versa. If
-- these fields are not NULL, the runtime /must/ trigger a haptic output
-- with the specified characteristics. If the device has multiple haptic
-- outputs, the runtime /should/ use the haptic output that is most
-- appropriate for the specified input path.
--
-- If a suggested binding with @action@ and @binding@ is not in the binding
-- list for this interaction profile, the runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_PATH_UNSUPPORTED'.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrInteractionProfileAnalogThresholdVALVE-extension-notenabled#
--     The @@ extension /must/ be enabled prior to using
--     'InteractionProfileAnalogThresholdVALVE'
--
-- -   #VUID-XrInteractionProfileAnalogThresholdVALVE-type-type# @type@
--     /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_INTERACTION_PROFILE_ANALOG_THRESHOLD_VALVE'
--
-- -   #VUID-XrInteractionProfileAnalogThresholdVALVE-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-XrInteractionProfileAnalogThresholdVALVE-action-parameter#
--     @action@ /must/ be a valid 'OpenXR.Core10.Handles.Action' handle
--
-- -   #VUID-XrInteractionProfileAnalogThresholdVALVE-onHaptic-parameter#
--     If @onHaptic@ is not @NULL@, @onHaptic@ /must/ be a pointer to a
--     valid 'OpenXR.Core10.Haptics.HapticBaseHeader'-based structure. See
--     also: 'OpenXR.Core10.OtherTypes.HapticVibration'
--
-- -   #VUID-XrInteractionProfileAnalogThresholdVALVE-offHaptic-parameter#
--     If @offHaptic@ is not @NULL@, @offHaptic@ /must/ be a pointer to a
--     valid 'OpenXR.Core10.Haptics.HapticBaseHeader'-based structure. See
--     also: 'OpenXR.Core10.OtherTypes.HapticVibration'
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Action',
-- 'OpenXR.Core10.Haptics.HapticBaseHeader',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrPath >,
-- 'OpenXR.Core10.Enums.StructureType.StructureType'
data InteractionProfileAnalogThresholdVALVE = InteractionProfileAnalogThresholdVALVE
  { -- | @action@ is the handle of an action in the suggested binding list.
    InteractionProfileAnalogThresholdVALVE -> Ptr Action_T
action :: Ptr Action_T
  , -- | @binding@ is the input path used for the specified action in the
    -- suggested binding list.
    InteractionProfileAnalogThresholdVALVE -> Path
binding :: Path
  , -- | @onThreshold@ is the value between 0.0 and 1.0 at which the runtime
    -- /must/ consider the binding to be true. The binding must remain true
    -- until the input analog value falls below @offThreshold@.
    InteractionProfileAnalogThresholdVALVE -> Float
onThreshold :: Float
  , -- | @offThreshold@ is the value between 0.0 and 1.0 at which the runtime
    -- /must/ consider the binding to be false if it was previous true.
    InteractionProfileAnalogThresholdVALVE -> Float
offThreshold :: Float
  , -- | @onHaptic@ is the haptic output that the runtime /must/ trigger when the
    -- binding changes from false to true. If this field is NULL, the runtime
    -- /must/ not trigger any haptic output on the threshold. This field /can/
    -- point to any supported sub-type of
    -- 'OpenXR.Core10.Haptics.HapticBaseHeader'.
    InteractionProfileAnalogThresholdVALVE
-> Maybe (SomeChild HapticBaseHeader)
onHaptic :: Maybe (SomeChild HapticBaseHeader)
  , -- | @offHaptic@ is the haptic output that the runtime /must/ trigger when
    -- the binding changes from true to false. If this field is NULL, the
    -- runtime /must/ not trigger any haptic output on the threshold. This
    -- field /can/ point to any supported sub-type of
    -- 'OpenXR.Core10.Haptics.HapticBaseHeader'.
    InteractionProfileAnalogThresholdVALVE
-> Maybe (SomeChild HapticBaseHeader)
offHaptic :: Maybe (SomeChild HapticBaseHeader)
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (InteractionProfileAnalogThresholdVALVE)
#endif
deriving instance Show InteractionProfileAnalogThresholdVALVE

instance ToCStruct InteractionProfileAnalogThresholdVALVE where
  withCStruct :: InteractionProfileAnalogThresholdVALVE
-> (Ptr InteractionProfileAnalogThresholdVALVE -> IO b) -> IO b
withCStruct x :: InteractionProfileAnalogThresholdVALVE
x f :: Ptr InteractionProfileAnalogThresholdVALVE -> IO b
f = Int
-> Int
-> (Ptr InteractionProfileAnalogThresholdVALVE -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 56 8 ((Ptr InteractionProfileAnalogThresholdVALVE -> IO b) -> IO b)
-> (Ptr InteractionProfileAnalogThresholdVALVE -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr InteractionProfileAnalogThresholdVALVE
p -> Ptr InteractionProfileAnalogThresholdVALVE
-> InteractionProfileAnalogThresholdVALVE -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr InteractionProfileAnalogThresholdVALVE
p InteractionProfileAnalogThresholdVALVE
x (Ptr InteractionProfileAnalogThresholdVALVE -> IO b
f Ptr InteractionProfileAnalogThresholdVALVE
p)
  pokeCStruct :: Ptr InteractionProfileAnalogThresholdVALVE
-> InteractionProfileAnalogThresholdVALVE -> IO b -> IO b
pokeCStruct p :: Ptr InteractionProfileAnalogThresholdVALVE
p InteractionProfileAnalogThresholdVALVE{..} 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 InteractionProfileAnalogThresholdVALVE
p Ptr InteractionProfileAnalogThresholdVALVE
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_INTERACTION_PROFILE_ANALOG_THRESHOLD_VALVE)
    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 InteractionProfileAnalogThresholdVALVE
p Ptr InteractionProfileAnalogThresholdVALVE -> 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 (Ptr Action_T) -> Ptr Action_T -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr InteractionProfileAnalogThresholdVALVE
p Ptr InteractionProfileAnalogThresholdVALVE
-> Int -> Ptr (Ptr Action_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr (Ptr Action_T))) (Ptr Action_T
action)
    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 Path -> Path -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr InteractionProfileAnalogThresholdVALVE
p Ptr InteractionProfileAnalogThresholdVALVE -> Int -> Ptr Path
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Path)) (Path
binding)
    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 CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr InteractionProfileAnalogThresholdVALVE
p Ptr InteractionProfileAnalogThresholdVALVE -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
onThreshold))
    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 CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr InteractionProfileAnalogThresholdVALVE
p Ptr InteractionProfileAnalogThresholdVALVE -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 36 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
offThreshold))
    Ptr (SomeChild HapticBaseHeader)
onHaptic'' <- case (Maybe (SomeChild HapticBaseHeader)
onHaptic) of
      Nothing -> Ptr (SomeChild HapticBaseHeader)
-> ContT b IO (Ptr (SomeChild HapticBaseHeader))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr (SomeChild HapticBaseHeader)
forall a. Ptr a
nullPtr
      Just j :: SomeChild HapticBaseHeader
j -> ((Ptr (SomeChild HapticBaseHeader) -> IO b) -> IO b)
-> ContT b IO (Ptr (SomeChild HapticBaseHeader))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (SomeChild HapticBaseHeader) -> IO b) -> IO b)
 -> ContT b IO (Ptr (SomeChild HapticBaseHeader)))
-> ((Ptr (SomeChild HapticBaseHeader) -> IO b) -> IO b)
-> ContT b IO (Ptr (SomeChild HapticBaseHeader))
forall a b. (a -> b) -> a -> b
$ SomeChild HapticBaseHeader
-> (Ptr (SomeChild HapticBaseHeader) -> IO b) -> IO b
forall a b. SomeChild a -> (Ptr (SomeChild a) -> IO b) -> IO b
withSomeChild (SomeChild HapticBaseHeader
j)
    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 HapticBaseHeader))
-> Ptr (SomeChild HapticBaseHeader) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr InteractionProfileAnalogThresholdVALVE
p Ptr InteractionProfileAnalogThresholdVALVE -> Int -> Ptr (Ptr _)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr (Ptr _))) Ptr (SomeChild HapticBaseHeader)
onHaptic''
    Ptr (SomeChild HapticBaseHeader)
offHaptic'' <- case (Maybe (SomeChild HapticBaseHeader)
offHaptic) of
      Nothing -> Ptr (SomeChild HapticBaseHeader)
-> ContT b IO (Ptr (SomeChild HapticBaseHeader))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr (SomeChild HapticBaseHeader)
forall a. Ptr a
nullPtr
      Just j :: SomeChild HapticBaseHeader
j -> ((Ptr (SomeChild HapticBaseHeader) -> IO b) -> IO b)
-> ContT b IO (Ptr (SomeChild HapticBaseHeader))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (SomeChild HapticBaseHeader) -> IO b) -> IO b)
 -> ContT b IO (Ptr (SomeChild HapticBaseHeader)))
-> ((Ptr (SomeChild HapticBaseHeader) -> IO b) -> IO b)
-> ContT b IO (Ptr (SomeChild HapticBaseHeader))
forall a b. (a -> b) -> a -> b
$ SomeChild HapticBaseHeader
-> (Ptr (SomeChild HapticBaseHeader) -> IO b) -> IO b
forall a b. SomeChild a -> (Ptr (SomeChild a) -> IO b) -> IO b
withSomeChild (SomeChild HapticBaseHeader
j)
    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 HapticBaseHeader))
-> Ptr (SomeChild HapticBaseHeader) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr InteractionProfileAnalogThresholdVALVE
p Ptr InteractionProfileAnalogThresholdVALVE -> Int -> Ptr (Ptr _)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48 :: Ptr (Ptr _))) Ptr (SomeChild HapticBaseHeader)
offHaptic''
    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 = 56
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr InteractionProfileAnalogThresholdVALVE -> IO b -> IO b
pokeZeroCStruct p :: Ptr InteractionProfileAnalogThresholdVALVE
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr InteractionProfileAnalogThresholdVALVE
p Ptr InteractionProfileAnalogThresholdVALVE
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_INTERACTION_PROFILE_ANALOG_THRESHOLD_VALVE)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr InteractionProfileAnalogThresholdVALVE
p Ptr InteractionProfileAnalogThresholdVALVE -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr (Ptr Action_T) -> Ptr Action_T -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr InteractionProfileAnalogThresholdVALVE
p Ptr InteractionProfileAnalogThresholdVALVE
-> Int -> Ptr (Ptr Action_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr (Ptr Action_T))) (Ptr Action_T
forall a. Zero a => a
zero)
    Ptr Path -> Path -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr InteractionProfileAnalogThresholdVALVE
p Ptr InteractionProfileAnalogThresholdVALVE -> Int -> Ptr Path
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Path)) (Path
forall a. Zero a => a
zero)
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr InteractionProfileAnalogThresholdVALVE
p Ptr InteractionProfileAnalogThresholdVALVE -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr InteractionProfileAnalogThresholdVALVE
p Ptr InteractionProfileAnalogThresholdVALVE -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 36 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct InteractionProfileAnalogThresholdVALVE where
  peekCStruct :: Ptr InteractionProfileAnalogThresholdVALVE
-> IO InteractionProfileAnalogThresholdVALVE
peekCStruct p :: Ptr InteractionProfileAnalogThresholdVALVE
p = do
    Ptr Action_T
action <- Ptr (Ptr Action_T) -> IO (Ptr Action_T)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Action_T) ((Ptr InteractionProfileAnalogThresholdVALVE
p Ptr InteractionProfileAnalogThresholdVALVE
-> Int -> Ptr (Ptr Action_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr (Ptr Action_T)))
    Path
binding <- Ptr Path -> IO Path
forall a. Storable a => Ptr a -> IO a
peek @Path ((Ptr InteractionProfileAnalogThresholdVALVE
p Ptr InteractionProfileAnalogThresholdVALVE -> Int -> Ptr Path
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Path))
    CFloat
onThreshold <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr InteractionProfileAnalogThresholdVALVE
p Ptr InteractionProfileAnalogThresholdVALVE -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr CFloat))
    CFloat
offThreshold <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr InteractionProfileAnalogThresholdVALVE
p Ptr InteractionProfileAnalogThresholdVALVE -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 36 :: Ptr CFloat))
    Ptr (SomeChild HapticBaseHeader)
onHaptic <- Ptr (Ptr (SomeChild HapticBaseHeader))
-> IO (Ptr (SomeChild HapticBaseHeader))
forall a. Storable a => Ptr a -> IO a
peek @(Ptr _) ((Ptr InteractionProfileAnalogThresholdVALVE
p Ptr InteractionProfileAnalogThresholdVALVE -> Int -> Ptr (Ptr _)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr (Ptr _)))
    Maybe (SomeChild HapticBaseHeader)
onHaptic' <- (Ptr (SomeChild HapticBaseHeader)
 -> IO (SomeChild HapticBaseHeader))
-> Ptr (SomeChild HapticBaseHeader)
-> IO (Maybe (SomeChild HapticBaseHeader))
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek (\j :: Ptr (SomeChild HapticBaseHeader)
j -> Ptr (SomeChild HapticBaseHeader) -> IO (SomeChild HapticBaseHeader)
forall a. Inheritable a => Ptr (SomeChild a) -> IO (SomeChild a)
peekSomeCChild (Ptr (SomeChild HapticBaseHeader)
j)) Ptr (SomeChild HapticBaseHeader)
onHaptic
    Ptr (SomeChild HapticBaseHeader)
offHaptic <- Ptr (Ptr (SomeChild HapticBaseHeader))
-> IO (Ptr (SomeChild HapticBaseHeader))
forall a. Storable a => Ptr a -> IO a
peek @(Ptr _) ((Ptr InteractionProfileAnalogThresholdVALVE
p Ptr InteractionProfileAnalogThresholdVALVE -> Int -> Ptr (Ptr _)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48 :: Ptr (Ptr _)))
    Maybe (SomeChild HapticBaseHeader)
offHaptic' <- (Ptr (SomeChild HapticBaseHeader)
 -> IO (SomeChild HapticBaseHeader))
-> Ptr (SomeChild HapticBaseHeader)
-> IO (Maybe (SomeChild HapticBaseHeader))
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek (\j :: Ptr (SomeChild HapticBaseHeader)
j -> Ptr (SomeChild HapticBaseHeader) -> IO (SomeChild HapticBaseHeader)
forall a. Inheritable a => Ptr (SomeChild a) -> IO (SomeChild a)
peekSomeCChild (Ptr (SomeChild HapticBaseHeader)
j)) Ptr (SomeChild HapticBaseHeader)
offHaptic
    InteractionProfileAnalogThresholdVALVE
-> IO InteractionProfileAnalogThresholdVALVE
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InteractionProfileAnalogThresholdVALVE
 -> IO InteractionProfileAnalogThresholdVALVE)
-> InteractionProfileAnalogThresholdVALVE
-> IO InteractionProfileAnalogThresholdVALVE
forall a b. (a -> b) -> a -> b
$ Ptr Action_T
-> Path
-> Float
-> Float
-> Maybe (SomeChild HapticBaseHeader)
-> Maybe (SomeChild HapticBaseHeader)
-> InteractionProfileAnalogThresholdVALVE
InteractionProfileAnalogThresholdVALVE
             Ptr Action_T
action Path
binding (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
onThreshold) (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
offThreshold) Maybe (SomeChild HapticBaseHeader)
onHaptic' Maybe (SomeChild HapticBaseHeader)
offHaptic'

instance Zero InteractionProfileAnalogThresholdVALVE where
  zero :: InteractionProfileAnalogThresholdVALVE
zero = Ptr Action_T
-> Path
-> Float
-> Float
-> Maybe (SomeChild HapticBaseHeader)
-> Maybe (SomeChild HapticBaseHeader)
-> InteractionProfileAnalogThresholdVALVE
InteractionProfileAnalogThresholdVALVE
           Ptr Action_T
forall a. Zero a => a
zero
           Path
forall a. Zero a => a
zero
           Float
forall a. Zero a => a
zero
           Float
forall a. Zero a => a
zero
           Maybe (SomeChild HapticBaseHeader)
forall a. Maybe a
Nothing
           Maybe (SomeChild HapticBaseHeader)
forall a. Maybe a
Nothing


type VALVE_analog_threshold_SPEC_VERSION = 1

-- No documentation found for TopLevel "XR_VALVE_analog_threshold_SPEC_VERSION"
pattern VALVE_analog_threshold_SPEC_VERSION :: forall a . Integral a => a
pattern $bVALVE_analog_threshold_SPEC_VERSION :: a
$mVALVE_analog_threshold_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
VALVE_analog_threshold_SPEC_VERSION = 1


type VALVE_ANALOG_THRESHOLD_EXTENSION_NAME = "XR_VALVE_analog_threshold"

-- No documentation found for TopLevel "XR_VALVE_ANALOG_THRESHOLD_EXTENSION_NAME"
pattern VALVE_ANALOG_THRESHOLD_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bVALVE_ANALOG_THRESHOLD_EXTENSION_NAME :: a
$mVALVE_ANALOG_THRESHOLD_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
VALVE_ANALOG_THRESHOLD_EXTENSION_NAME = "XR_VALVE_analog_threshold"