{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Generic representation of an input device. The actual contents of this
-- structure depend on the backend used.

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.Clutter.Objects.InputDevice
    ( 

-- * Exported types
    InputDevice(..)                         ,
    IsInputDevice                           ,
    toInputDevice                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [grab]("GI.Clutter.Objects.InputDevice#g:method:grab"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [keycodeToEvdev]("GI.Clutter.Objects.InputDevice#g:method:keycodeToEvdev"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [sequenceGetGrabbedActor]("GI.Clutter.Objects.InputDevice#g:method:sequenceGetGrabbedActor"), [sequenceGrab]("GI.Clutter.Objects.InputDevice#g:method:sequenceGrab"), [sequenceUngrab]("GI.Clutter.Objects.InputDevice#g:method:sequenceUngrab"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [ungrab]("GI.Clutter.Objects.InputDevice#g:method:ungrab"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [updateFromEvent]("GI.Clutter.Objects.InputDevice#g:method:updateFromEvent"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAssociatedDevice]("GI.Clutter.Objects.InputDevice#g:method:getAssociatedDevice"), [getAxis]("GI.Clutter.Objects.InputDevice#g:method:getAxis"), [getAxisValue]("GI.Clutter.Objects.InputDevice#g:method:getAxisValue"), [getCoords]("GI.Clutter.Objects.InputDevice#g:method:getCoords"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDeviceCoords]("GI.Clutter.Objects.InputDevice#g:method:getDeviceCoords"), [getDeviceId]("GI.Clutter.Objects.InputDevice#g:method:getDeviceId"), [getDeviceMode]("GI.Clutter.Objects.InputDevice#g:method:getDeviceMode"), [getDeviceName]("GI.Clutter.Objects.InputDevice#g:method:getDeviceName"), [getDeviceType]("GI.Clutter.Objects.InputDevice#g:method:getDeviceType"), [getEnabled]("GI.Clutter.Objects.InputDevice#g:method:getEnabled"), [getGrabbedActor]("GI.Clutter.Objects.InputDevice#g:method:getGrabbedActor"), [getHasCursor]("GI.Clutter.Objects.InputDevice#g:method:getHasCursor"), [getKey]("GI.Clutter.Objects.InputDevice#g:method:getKey"), [getModifierState]("GI.Clutter.Objects.InputDevice#g:method:getModifierState"), [getNAxes]("GI.Clutter.Objects.InputDevice#g:method:getNAxes"), [getNKeys]("GI.Clutter.Objects.InputDevice#g:method:getNKeys"), [getPointerActor]("GI.Clutter.Objects.InputDevice#g:method:getPointerActor"), [getPointerStage]("GI.Clutter.Objects.InputDevice#g:method:getPointerStage"), [getProductId]("GI.Clutter.Objects.InputDevice#g:method:getProductId"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSlaveDevices]("GI.Clutter.Objects.InputDevice#g:method:getSlaveDevices"), [getVendorId]("GI.Clutter.Objects.InputDevice#g:method:getVendorId").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setEnabled]("GI.Clutter.Objects.InputDevice#g:method:setEnabled"), [setKey]("GI.Clutter.Objects.InputDevice#g:method:setKey"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveInputDeviceMethod                ,
#endif

-- ** getAssociatedDevice #method:getAssociatedDevice#

#if defined(ENABLE_OVERLOADING)
    InputDeviceGetAssociatedDeviceMethodInfo,
#endif
    inputDeviceGetAssociatedDevice          ,


-- ** getAxis #method:getAxis#

#if defined(ENABLE_OVERLOADING)
    InputDeviceGetAxisMethodInfo            ,
#endif
    inputDeviceGetAxis                      ,


-- ** getAxisValue #method:getAxisValue#

#if defined(ENABLE_OVERLOADING)
    InputDeviceGetAxisValueMethodInfo       ,
#endif
    inputDeviceGetAxisValue                 ,


-- ** getCoords #method:getCoords#

#if defined(ENABLE_OVERLOADING)
    InputDeviceGetCoordsMethodInfo          ,
#endif
    inputDeviceGetCoords                    ,


-- ** getDeviceCoords #method:getDeviceCoords#

#if defined(ENABLE_OVERLOADING)
    InputDeviceGetDeviceCoordsMethodInfo    ,
#endif
    inputDeviceGetDeviceCoords              ,


-- ** getDeviceId #method:getDeviceId#

#if defined(ENABLE_OVERLOADING)
    InputDeviceGetDeviceIdMethodInfo        ,
#endif
    inputDeviceGetDeviceId                  ,


-- ** getDeviceMode #method:getDeviceMode#

#if defined(ENABLE_OVERLOADING)
    InputDeviceGetDeviceModeMethodInfo      ,
#endif
    inputDeviceGetDeviceMode                ,


-- ** getDeviceName #method:getDeviceName#

#if defined(ENABLE_OVERLOADING)
    InputDeviceGetDeviceNameMethodInfo      ,
#endif
    inputDeviceGetDeviceName                ,


-- ** getDeviceType #method:getDeviceType#

#if defined(ENABLE_OVERLOADING)
    InputDeviceGetDeviceTypeMethodInfo      ,
#endif
    inputDeviceGetDeviceType                ,


-- ** getEnabled #method:getEnabled#

#if defined(ENABLE_OVERLOADING)
    InputDeviceGetEnabledMethodInfo         ,
#endif
    inputDeviceGetEnabled                   ,


-- ** getGrabbedActor #method:getGrabbedActor#

#if defined(ENABLE_OVERLOADING)
    InputDeviceGetGrabbedActorMethodInfo    ,
#endif
    inputDeviceGetGrabbedActor              ,


-- ** getHasCursor #method:getHasCursor#

#if defined(ENABLE_OVERLOADING)
    InputDeviceGetHasCursorMethodInfo       ,
#endif
    inputDeviceGetHasCursor                 ,


-- ** getKey #method:getKey#

#if defined(ENABLE_OVERLOADING)
    InputDeviceGetKeyMethodInfo             ,
#endif
    inputDeviceGetKey                       ,


-- ** getModifierState #method:getModifierState#

#if defined(ENABLE_OVERLOADING)
    InputDeviceGetModifierStateMethodInfo   ,
#endif
    inputDeviceGetModifierState             ,


-- ** getNAxes #method:getNAxes#

#if defined(ENABLE_OVERLOADING)
    InputDeviceGetNAxesMethodInfo           ,
#endif
    inputDeviceGetNAxes                     ,


-- ** getNKeys #method:getNKeys#

#if defined(ENABLE_OVERLOADING)
    InputDeviceGetNKeysMethodInfo           ,
#endif
    inputDeviceGetNKeys                     ,


-- ** getPointerActor #method:getPointerActor#

#if defined(ENABLE_OVERLOADING)
    InputDeviceGetPointerActorMethodInfo    ,
#endif
    inputDeviceGetPointerActor              ,


-- ** getPointerStage #method:getPointerStage#

#if defined(ENABLE_OVERLOADING)
    InputDeviceGetPointerStageMethodInfo    ,
#endif
    inputDeviceGetPointerStage              ,


-- ** getProductId #method:getProductId#

#if defined(ENABLE_OVERLOADING)
    InputDeviceGetProductIdMethodInfo       ,
#endif
    inputDeviceGetProductId                 ,


-- ** getSlaveDevices #method:getSlaveDevices#

#if defined(ENABLE_OVERLOADING)
    InputDeviceGetSlaveDevicesMethodInfo    ,
#endif
    inputDeviceGetSlaveDevices              ,


-- ** getVendorId #method:getVendorId#

#if defined(ENABLE_OVERLOADING)
    InputDeviceGetVendorIdMethodInfo        ,
#endif
    inputDeviceGetVendorId                  ,


-- ** grab #method:grab#

#if defined(ENABLE_OVERLOADING)
    InputDeviceGrabMethodInfo               ,
#endif
    inputDeviceGrab                         ,


-- ** keycodeToEvdev #method:keycodeToEvdev#

#if defined(ENABLE_OVERLOADING)
    InputDeviceKeycodeToEvdevMethodInfo     ,
#endif
    inputDeviceKeycodeToEvdev               ,


-- ** sequenceGetGrabbedActor #method:sequenceGetGrabbedActor#

#if defined(ENABLE_OVERLOADING)
    InputDeviceSequenceGetGrabbedActorMethodInfo,
#endif
    inputDeviceSequenceGetGrabbedActor      ,


-- ** sequenceGrab #method:sequenceGrab#

#if defined(ENABLE_OVERLOADING)
    InputDeviceSequenceGrabMethodInfo       ,
#endif
    inputDeviceSequenceGrab                 ,


-- ** sequenceUngrab #method:sequenceUngrab#

#if defined(ENABLE_OVERLOADING)
    InputDeviceSequenceUngrabMethodInfo     ,
#endif
    inputDeviceSequenceUngrab               ,


-- ** setEnabled #method:setEnabled#

#if defined(ENABLE_OVERLOADING)
    InputDeviceSetEnabledMethodInfo         ,
#endif
    inputDeviceSetEnabled                   ,


-- ** setKey #method:setKey#

#if defined(ENABLE_OVERLOADING)
    InputDeviceSetKeyMethodInfo             ,
#endif
    inputDeviceSetKey                       ,


-- ** ungrab #method:ungrab#

#if defined(ENABLE_OVERLOADING)
    InputDeviceUngrabMethodInfo             ,
#endif
    inputDeviceUngrab                       ,


-- ** updateFromEvent #method:updateFromEvent#

#if defined(ENABLE_OVERLOADING)
    InputDeviceUpdateFromEventMethodInfo    ,
#endif
    inputDeviceUpdateFromEvent              ,




 -- * Properties


-- ** backend #attr:backend#
-- | The t'GI.Clutter.Objects.Backend.Backend' that created the device.
-- 
-- /Since: 1.6/

#if defined(ENABLE_OVERLOADING)
    InputDeviceBackendPropertyInfo          ,
#endif
    constructInputDeviceBackend             ,
    getInputDeviceBackend                   ,
#if defined(ENABLE_OVERLOADING)
    inputDeviceBackend                      ,
#endif


-- ** deviceManager #attr:deviceManager#
-- | The t'GI.Clutter.Objects.DeviceManager.DeviceManager' instance which owns the device
-- 
-- /Since: 1.6/

#if defined(ENABLE_OVERLOADING)
    InputDeviceDeviceManagerPropertyInfo    ,
#endif
    constructInputDeviceDeviceManager       ,
    getInputDeviceDeviceManager             ,
#if defined(ENABLE_OVERLOADING)
    inputDeviceDeviceManager                ,
#endif


-- ** deviceMode #attr:deviceMode#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    InputDeviceDeviceModePropertyInfo       ,
#endif
    constructInputDeviceDeviceMode          ,
    getInputDeviceDeviceMode                ,
#if defined(ENABLE_OVERLOADING)
    inputDeviceDeviceMode                   ,
#endif


-- ** deviceType #attr:deviceType#
-- | The type of the device
-- 
-- /Since: 1.2/

#if defined(ENABLE_OVERLOADING)
    InputDeviceDeviceTypePropertyInfo       ,
#endif
    constructInputDeviceDeviceType          ,
    getInputDeviceDeviceType                ,
#if defined(ENABLE_OVERLOADING)
    inputDeviceDeviceType                   ,
#endif


-- ** enabled #attr:enabled#
-- | Whether the device is enabled.
-- 
-- A device with the [InputDevice:deviceMode]("GI.Clutter.Objects.InputDevice#g:attr:deviceMode") property set
-- to 'GI.Clutter.Enums.InputModeMaster' cannot be disabled.
-- 
-- A device must be enabled in order to receive events from it.
-- 
-- /Since: 1.6/

#if defined(ENABLE_OVERLOADING)
    InputDeviceEnabledPropertyInfo          ,
#endif
    constructInputDeviceEnabled             ,
    getInputDeviceEnabled                   ,
#if defined(ENABLE_OVERLOADING)
    inputDeviceEnabled                      ,
#endif
    setInputDeviceEnabled                   ,


-- ** hasCursor #attr:hasCursor#
-- | Whether the device has an on screen cursor following its movement.
-- 
-- /Since: 1.6/

#if defined(ENABLE_OVERLOADING)
    InputDeviceHasCursorPropertyInfo        ,
#endif
    constructInputDeviceHasCursor           ,
    getInputDeviceHasCursor                 ,
#if defined(ENABLE_OVERLOADING)
    inputDeviceHasCursor                    ,
#endif


-- ** id #attr:id#
-- | The unique identifier of the device
-- 
-- /Since: 1.2/

#if defined(ENABLE_OVERLOADING)
    InputDeviceIdPropertyInfo               ,
#endif
    constructInputDeviceId                  ,
    getInputDeviceId                        ,
#if defined(ENABLE_OVERLOADING)
    inputDeviceId                           ,
#endif


-- ** nAxes #attr:nAxes#
-- | The number of axes of the device.
-- 
-- /Since: 1.6/

#if defined(ENABLE_OVERLOADING)
    InputDeviceNAxesPropertyInfo            ,
#endif
    getInputDeviceNAxes                     ,
#if defined(ENABLE_OVERLOADING)
    inputDeviceNAxes                        ,
#endif


-- ** name #attr:name#
-- | The name of the device
-- 
-- /Since: 1.2/

#if defined(ENABLE_OVERLOADING)
    InputDeviceNamePropertyInfo             ,
#endif
    constructInputDeviceName                ,
    getInputDeviceName                      ,
#if defined(ENABLE_OVERLOADING)
    inputDeviceName                         ,
#endif


-- ** productId #attr:productId#
-- | Product ID of this device.
-- 
-- /Since: 1.22/

#if defined(ENABLE_OVERLOADING)
    InputDeviceProductIdPropertyInfo        ,
#endif
    constructInputDeviceProductId           ,
    getInputDeviceProductId                 ,
#if defined(ENABLE_OVERLOADING)
    inputDeviceProductId                    ,
#endif


-- ** vendorId #attr:vendorId#
-- | Vendor ID of this device.
-- 
-- /Since: 1.22/

#if defined(ENABLE_OVERLOADING)
    InputDeviceVendorIdPropertyInfo         ,
#endif
    constructInputDeviceVendorId            ,
    getInputDeviceVendorId                  ,
#if defined(ENABLE_OVERLOADING)
    inputDeviceVendorId                     ,
#endif




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import {-# SOURCE #-} qualified GI.Clutter.Enums as Clutter.Enums
import {-# SOURCE #-} qualified GI.Clutter.Flags as Clutter.Flags
import {-# SOURCE #-} qualified GI.Clutter.Objects.Actor as Clutter.Actor
import {-# SOURCE #-} qualified GI.Clutter.Objects.Backend as Clutter.Backend
import {-# SOURCE #-} qualified GI.Clutter.Objects.DeviceManager as Clutter.DeviceManager
import {-# SOURCE #-} qualified GI.Clutter.Objects.Stage as Clutter.Stage
import {-# SOURCE #-} qualified GI.Clutter.Structs.EventSequence as Clutter.EventSequence
import {-# SOURCE #-} qualified GI.Clutter.Structs.Point as Clutter.Point
import {-# SOURCE #-} qualified GI.Clutter.Unions.Event as Clutter.Event
import qualified GI.GObject.Objects.Object as GObject.Object

-- | Memory-managed wrapper type.
newtype InputDevice = InputDevice (SP.ManagedPtr InputDevice)
    deriving (InputDevice -> InputDevice -> Bool
(InputDevice -> InputDevice -> Bool)
-> (InputDevice -> InputDevice -> Bool) -> Eq InputDevice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputDevice -> InputDevice -> Bool
== :: InputDevice -> InputDevice -> Bool
$c/= :: InputDevice -> InputDevice -> Bool
/= :: InputDevice -> InputDevice -> Bool
Eq)

instance SP.ManagedPtrNewtype InputDevice where
    toManagedPtr :: InputDevice -> ManagedPtr InputDevice
toManagedPtr (InputDevice ManagedPtr InputDevice
p) = ManagedPtr InputDevice
p

foreign import ccall "clutter_input_device_get_type"
    c_clutter_input_device_get_type :: IO B.Types.GType

instance B.Types.TypedObject InputDevice where
    glibType :: IO GType
glibType = IO GType
c_clutter_input_device_get_type

instance B.Types.GObject InputDevice

-- | Type class for types which can be safely cast to `InputDevice`, for instance with `toInputDevice`.
class (SP.GObject o, O.IsDescendantOf InputDevice o) => IsInputDevice o
instance (SP.GObject o, O.IsDescendantOf InputDevice o) => IsInputDevice o

instance O.HasParentTypes InputDevice
type instance O.ParentTypes InputDevice = '[GObject.Object.Object]

-- | Cast to `InputDevice`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toInputDevice :: (MIO.MonadIO m, IsInputDevice o) => o -> m InputDevice
toInputDevice :: forall (m :: * -> *) o.
(MonadIO m, IsInputDevice o) =>
o -> m InputDevice
toInputDevice = IO InputDevice -> m InputDevice
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO InputDevice -> m InputDevice)
-> (o -> IO InputDevice) -> o -> m InputDevice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr InputDevice -> InputDevice) -> o -> IO InputDevice
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr InputDevice -> InputDevice
InputDevice

-- | Convert 'InputDevice' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe InputDevice) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_clutter_input_device_get_type
    gvalueSet_ :: Ptr GValue -> Maybe InputDevice -> IO ()
gvalueSet_ Ptr GValue
gv Maybe InputDevice
P.Nothing = Ptr GValue -> Ptr InputDevice -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr InputDevice
forall a. Ptr a
FP.nullPtr :: FP.Ptr InputDevice)
    gvalueSet_ Ptr GValue
gv (P.Just InputDevice
obj) = InputDevice -> (Ptr InputDevice -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr InputDevice
obj (Ptr GValue -> Ptr InputDevice -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe InputDevice)
gvalueGet_ Ptr GValue
gv = do
        Ptr InputDevice
ptr <- Ptr GValue -> IO (Ptr InputDevice)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr InputDevice)
        if Ptr InputDevice
ptr Ptr InputDevice -> Ptr InputDevice -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr InputDevice
forall a. Ptr a
FP.nullPtr
        then InputDevice -> Maybe InputDevice
forall a. a -> Maybe a
P.Just (InputDevice -> Maybe InputDevice)
-> IO InputDevice -> IO (Maybe InputDevice)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr InputDevice -> InputDevice)
-> Ptr InputDevice -> IO InputDevice
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr InputDevice -> InputDevice
InputDevice Ptr InputDevice
ptr
        else Maybe InputDevice -> IO (Maybe InputDevice)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InputDevice
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveInputDeviceMethod (t :: Symbol) (o :: *) :: * where
    ResolveInputDeviceMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveInputDeviceMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveInputDeviceMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveInputDeviceMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveInputDeviceMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveInputDeviceMethod "grab" o = InputDeviceGrabMethodInfo
    ResolveInputDeviceMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveInputDeviceMethod "keycodeToEvdev" o = InputDeviceKeycodeToEvdevMethodInfo
    ResolveInputDeviceMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveInputDeviceMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveInputDeviceMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveInputDeviceMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveInputDeviceMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveInputDeviceMethod "sequenceGetGrabbedActor" o = InputDeviceSequenceGetGrabbedActorMethodInfo
    ResolveInputDeviceMethod "sequenceGrab" o = InputDeviceSequenceGrabMethodInfo
    ResolveInputDeviceMethod "sequenceUngrab" o = InputDeviceSequenceUngrabMethodInfo
    ResolveInputDeviceMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveInputDeviceMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveInputDeviceMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveInputDeviceMethod "ungrab" o = InputDeviceUngrabMethodInfo
    ResolveInputDeviceMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveInputDeviceMethod "updateFromEvent" o = InputDeviceUpdateFromEventMethodInfo
    ResolveInputDeviceMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveInputDeviceMethod "getAssociatedDevice" o = InputDeviceGetAssociatedDeviceMethodInfo
    ResolveInputDeviceMethod "getAxis" o = InputDeviceGetAxisMethodInfo
    ResolveInputDeviceMethod "getAxisValue" o = InputDeviceGetAxisValueMethodInfo
    ResolveInputDeviceMethod "getCoords" o = InputDeviceGetCoordsMethodInfo
    ResolveInputDeviceMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveInputDeviceMethod "getDeviceCoords" o = InputDeviceGetDeviceCoordsMethodInfo
    ResolveInputDeviceMethod "getDeviceId" o = InputDeviceGetDeviceIdMethodInfo
    ResolveInputDeviceMethod "getDeviceMode" o = InputDeviceGetDeviceModeMethodInfo
    ResolveInputDeviceMethod "getDeviceName" o = InputDeviceGetDeviceNameMethodInfo
    ResolveInputDeviceMethod "getDeviceType" o = InputDeviceGetDeviceTypeMethodInfo
    ResolveInputDeviceMethod "getEnabled" o = InputDeviceGetEnabledMethodInfo
    ResolveInputDeviceMethod "getGrabbedActor" o = InputDeviceGetGrabbedActorMethodInfo
    ResolveInputDeviceMethod "getHasCursor" o = InputDeviceGetHasCursorMethodInfo
    ResolveInputDeviceMethod "getKey" o = InputDeviceGetKeyMethodInfo
    ResolveInputDeviceMethod "getModifierState" o = InputDeviceGetModifierStateMethodInfo
    ResolveInputDeviceMethod "getNAxes" o = InputDeviceGetNAxesMethodInfo
    ResolveInputDeviceMethod "getNKeys" o = InputDeviceGetNKeysMethodInfo
    ResolveInputDeviceMethod "getPointerActor" o = InputDeviceGetPointerActorMethodInfo
    ResolveInputDeviceMethod "getPointerStage" o = InputDeviceGetPointerStageMethodInfo
    ResolveInputDeviceMethod "getProductId" o = InputDeviceGetProductIdMethodInfo
    ResolveInputDeviceMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveInputDeviceMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveInputDeviceMethod "getSlaveDevices" o = InputDeviceGetSlaveDevicesMethodInfo
    ResolveInputDeviceMethod "getVendorId" o = InputDeviceGetVendorIdMethodInfo
    ResolveInputDeviceMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveInputDeviceMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveInputDeviceMethod "setEnabled" o = InputDeviceSetEnabledMethodInfo
    ResolveInputDeviceMethod "setKey" o = InputDeviceSetKeyMethodInfo
    ResolveInputDeviceMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveInputDeviceMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveInputDeviceMethod t InputDevice, O.OverloadedMethod info InputDevice p) => OL.IsLabel t (InputDevice -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveInputDeviceMethod t InputDevice, O.OverloadedMethod info InputDevice p, R.HasField t InputDevice p) => R.HasField t InputDevice p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveInputDeviceMethod t InputDevice, O.OverloadedMethodInfo info InputDevice) => OL.IsLabel t (O.MethodProxy info InputDevice) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

-- VVV Prop "backend"
   -- Type: TInterface (Name {namespace = "Clutter", name = "Backend"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@backend@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' inputDevice #backend
-- @
getInputDeviceBackend :: (MonadIO m, IsInputDevice o) => o -> m (Maybe Clutter.Backend.Backend)
getInputDeviceBackend :: forall (m :: * -> *) o.
(MonadIO m, IsInputDevice o) =>
o -> m (Maybe Backend)
getInputDeviceBackend o
obj = IO (Maybe Backend) -> m (Maybe Backend)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Backend) -> m (Maybe Backend))
-> IO (Maybe Backend) -> m (Maybe Backend)
forall a b. (a -> b) -> a -> b
$ o
-> String -> (ManagedPtr Backend -> Backend) -> IO (Maybe Backend)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"backend" ManagedPtr Backend -> Backend
Clutter.Backend.Backend

-- | Construct a `GValueConstruct` with valid value for the “@backend@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructInputDeviceBackend :: (IsInputDevice o, MIO.MonadIO m, Clutter.Backend.IsBackend a) => a -> m (GValueConstruct o)
constructInputDeviceBackend :: forall o (m :: * -> *) a.
(IsInputDevice o, MonadIO m, IsBackend a) =>
a -> m (GValueConstruct o)
constructInputDeviceBackend a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"backend" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data InputDeviceBackendPropertyInfo
instance AttrInfo InputDeviceBackendPropertyInfo where
    type AttrAllowedOps InputDeviceBackendPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint InputDeviceBackendPropertyInfo = IsInputDevice
    type AttrSetTypeConstraint InputDeviceBackendPropertyInfo = Clutter.Backend.IsBackend
    type AttrTransferTypeConstraint InputDeviceBackendPropertyInfo = Clutter.Backend.IsBackend
    type AttrTransferType InputDeviceBackendPropertyInfo = Clutter.Backend.Backend
    type AttrGetType InputDeviceBackendPropertyInfo = (Maybe Clutter.Backend.Backend)
    type AttrLabel InputDeviceBackendPropertyInfo = "backend"
    type AttrOrigin InputDeviceBackendPropertyInfo = InputDevice
    attrGet = getInputDeviceBackend
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Clutter.Backend.Backend v
    attrConstruct = constructInputDeviceBackend
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.backend"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#g:attr:backend"
        })
#endif

-- VVV Prop "device-manager"
   -- Type: TInterface (Name {namespace = "Clutter", name = "DeviceManager"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@device-manager@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' inputDevice #deviceManager
-- @
getInputDeviceDeviceManager :: (MonadIO m, IsInputDevice o) => o -> m (Maybe Clutter.DeviceManager.DeviceManager)
getInputDeviceDeviceManager :: forall (m :: * -> *) o.
(MonadIO m, IsInputDevice o) =>
o -> m (Maybe DeviceManager)
getInputDeviceDeviceManager o
obj = IO (Maybe DeviceManager) -> m (Maybe DeviceManager)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe DeviceManager) -> m (Maybe DeviceManager))
-> IO (Maybe DeviceManager) -> m (Maybe DeviceManager)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr DeviceManager -> DeviceManager)
-> IO (Maybe DeviceManager)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"device-manager" ManagedPtr DeviceManager -> DeviceManager
Clutter.DeviceManager.DeviceManager

-- | Construct a `GValueConstruct` with valid value for the “@device-manager@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructInputDeviceDeviceManager :: (IsInputDevice o, MIO.MonadIO m, Clutter.DeviceManager.IsDeviceManager a) => a -> m (GValueConstruct o)
constructInputDeviceDeviceManager :: forall o (m :: * -> *) a.
(IsInputDevice o, MonadIO m, IsDeviceManager a) =>
a -> m (GValueConstruct o)
constructInputDeviceDeviceManager a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"device-manager" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data InputDeviceDeviceManagerPropertyInfo
instance AttrInfo InputDeviceDeviceManagerPropertyInfo where
    type AttrAllowedOps InputDeviceDeviceManagerPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint InputDeviceDeviceManagerPropertyInfo = IsInputDevice
    type AttrSetTypeConstraint InputDeviceDeviceManagerPropertyInfo = Clutter.DeviceManager.IsDeviceManager
    type AttrTransferTypeConstraint InputDeviceDeviceManagerPropertyInfo = Clutter.DeviceManager.IsDeviceManager
    type AttrTransferType InputDeviceDeviceManagerPropertyInfo = Clutter.DeviceManager.DeviceManager
    type AttrGetType InputDeviceDeviceManagerPropertyInfo = (Maybe Clutter.DeviceManager.DeviceManager)
    type AttrLabel InputDeviceDeviceManagerPropertyInfo = "device-manager"
    type AttrOrigin InputDeviceDeviceManagerPropertyInfo = InputDevice
    attrGet = getInputDeviceDeviceManager
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Clutter.DeviceManager.DeviceManager v
    attrConstruct = constructInputDeviceDeviceManager
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.deviceManager"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#g:attr:deviceManager"
        })
#endif

-- VVV Prop "device-mode"
   -- Type: TInterface (Name {namespace = "Clutter", name = "InputMode"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@device-mode@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' inputDevice #deviceMode
-- @
getInputDeviceDeviceMode :: (MonadIO m, IsInputDevice o) => o -> m Clutter.Enums.InputMode
getInputDeviceDeviceMode :: forall (m :: * -> *) o.
(MonadIO m, IsInputDevice o) =>
o -> m InputMode
getInputDeviceDeviceMode o
obj = IO InputMode -> m InputMode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO InputMode -> m InputMode) -> IO InputMode -> m InputMode
forall a b. (a -> b) -> a -> b
$ o -> String -> IO InputMode
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"device-mode"

-- | Construct a `GValueConstruct` with valid value for the “@device-mode@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructInputDeviceDeviceMode :: (IsInputDevice o, MIO.MonadIO m) => Clutter.Enums.InputMode -> m (GValueConstruct o)
constructInputDeviceDeviceMode :: forall o (m :: * -> *).
(IsInputDevice o, MonadIO m) =>
InputMode -> m (GValueConstruct o)
constructInputDeviceDeviceMode InputMode
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> InputMode -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"device-mode" InputMode
val

#if defined(ENABLE_OVERLOADING)
data InputDeviceDeviceModePropertyInfo
instance AttrInfo InputDeviceDeviceModePropertyInfo where
    type AttrAllowedOps InputDeviceDeviceModePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint InputDeviceDeviceModePropertyInfo = IsInputDevice
    type AttrSetTypeConstraint InputDeviceDeviceModePropertyInfo = (~) Clutter.Enums.InputMode
    type AttrTransferTypeConstraint InputDeviceDeviceModePropertyInfo = (~) Clutter.Enums.InputMode
    type AttrTransferType InputDeviceDeviceModePropertyInfo = Clutter.Enums.InputMode
    type AttrGetType InputDeviceDeviceModePropertyInfo = Clutter.Enums.InputMode
    type AttrLabel InputDeviceDeviceModePropertyInfo = "device-mode"
    type AttrOrigin InputDeviceDeviceModePropertyInfo = InputDevice
    attrGet = getInputDeviceDeviceMode
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructInputDeviceDeviceMode
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.deviceMode"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#g:attr:deviceMode"
        })
#endif

-- VVV Prop "device-type"
   -- Type: TInterface (Name {namespace = "Clutter", name = "InputDeviceType"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@device-type@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' inputDevice #deviceType
-- @
getInputDeviceDeviceType :: (MonadIO m, IsInputDevice o) => o -> m Clutter.Enums.InputDeviceType
getInputDeviceDeviceType :: forall (m :: * -> *) o.
(MonadIO m, IsInputDevice o) =>
o -> m InputDeviceType
getInputDeviceDeviceType o
obj = IO InputDeviceType -> m InputDeviceType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO InputDeviceType -> m InputDeviceType)
-> IO InputDeviceType -> m InputDeviceType
forall a b. (a -> b) -> a -> b
$ o -> String -> IO InputDeviceType
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"device-type"

-- | Construct a `GValueConstruct` with valid value for the “@device-type@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructInputDeviceDeviceType :: (IsInputDevice o, MIO.MonadIO m) => Clutter.Enums.InputDeviceType -> m (GValueConstruct o)
constructInputDeviceDeviceType :: forall o (m :: * -> *).
(IsInputDevice o, MonadIO m) =>
InputDeviceType -> m (GValueConstruct o)
constructInputDeviceDeviceType InputDeviceType
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> InputDeviceType -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"device-type" InputDeviceType
val

#if defined(ENABLE_OVERLOADING)
data InputDeviceDeviceTypePropertyInfo
instance AttrInfo InputDeviceDeviceTypePropertyInfo where
    type AttrAllowedOps InputDeviceDeviceTypePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint InputDeviceDeviceTypePropertyInfo = IsInputDevice
    type AttrSetTypeConstraint InputDeviceDeviceTypePropertyInfo = (~) Clutter.Enums.InputDeviceType
    type AttrTransferTypeConstraint InputDeviceDeviceTypePropertyInfo = (~) Clutter.Enums.InputDeviceType
    type AttrTransferType InputDeviceDeviceTypePropertyInfo = Clutter.Enums.InputDeviceType
    type AttrGetType InputDeviceDeviceTypePropertyInfo = Clutter.Enums.InputDeviceType
    type AttrLabel InputDeviceDeviceTypePropertyInfo = "device-type"
    type AttrOrigin InputDeviceDeviceTypePropertyInfo = InputDevice
    attrGet = getInputDeviceDeviceType
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructInputDeviceDeviceType
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.deviceType"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#g:attr:deviceType"
        })
#endif

-- VVV Prop "enabled"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@enabled@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' inputDevice #enabled
-- @
getInputDeviceEnabled :: (MonadIO m, IsInputDevice o) => o -> m Bool
getInputDeviceEnabled :: forall (m :: * -> *) o. (MonadIO m, IsInputDevice o) => o -> m Bool
getInputDeviceEnabled o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"enabled"

-- | Set the value of the “@enabled@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' inputDevice [ #enabled 'Data.GI.Base.Attributes.:=' value ]
-- @
setInputDeviceEnabled :: (MonadIO m, IsInputDevice o) => o -> Bool -> m ()
setInputDeviceEnabled :: forall (m :: * -> *) o.
(MonadIO m, IsInputDevice o) =>
o -> Bool -> m ()
setInputDeviceEnabled o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"enabled" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@enabled@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructInputDeviceEnabled :: (IsInputDevice o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructInputDeviceEnabled :: forall o (m :: * -> *).
(IsInputDevice o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructInputDeviceEnabled Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"enabled" Bool
val

#if defined(ENABLE_OVERLOADING)
data InputDeviceEnabledPropertyInfo
instance AttrInfo InputDeviceEnabledPropertyInfo where
    type AttrAllowedOps InputDeviceEnabledPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint InputDeviceEnabledPropertyInfo = IsInputDevice
    type AttrSetTypeConstraint InputDeviceEnabledPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint InputDeviceEnabledPropertyInfo = (~) Bool
    type AttrTransferType InputDeviceEnabledPropertyInfo = Bool
    type AttrGetType InputDeviceEnabledPropertyInfo = Bool
    type AttrLabel InputDeviceEnabledPropertyInfo = "enabled"
    type AttrOrigin InputDeviceEnabledPropertyInfo = InputDevice
    attrGet = getInputDeviceEnabled
    attrSet = setInputDeviceEnabled
    attrTransfer _ v = do
        return v
    attrConstruct = constructInputDeviceEnabled
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.enabled"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#g:attr:enabled"
        })
#endif

-- VVV Prop "has-cursor"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@has-cursor@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' inputDevice #hasCursor
-- @
getInputDeviceHasCursor :: (MonadIO m, IsInputDevice o) => o -> m Bool
getInputDeviceHasCursor :: forall (m :: * -> *) o. (MonadIO m, IsInputDevice o) => o -> m Bool
getInputDeviceHasCursor o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"has-cursor"

-- | Construct a `GValueConstruct` with valid value for the “@has-cursor@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructInputDeviceHasCursor :: (IsInputDevice o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructInputDeviceHasCursor :: forall o (m :: * -> *).
(IsInputDevice o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructInputDeviceHasCursor Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"has-cursor" Bool
val

#if defined(ENABLE_OVERLOADING)
data InputDeviceHasCursorPropertyInfo
instance AttrInfo InputDeviceHasCursorPropertyInfo where
    type AttrAllowedOps InputDeviceHasCursorPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint InputDeviceHasCursorPropertyInfo = IsInputDevice
    type AttrSetTypeConstraint InputDeviceHasCursorPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint InputDeviceHasCursorPropertyInfo = (~) Bool
    type AttrTransferType InputDeviceHasCursorPropertyInfo = Bool
    type AttrGetType InputDeviceHasCursorPropertyInfo = Bool
    type AttrLabel InputDeviceHasCursorPropertyInfo = "has-cursor"
    type AttrOrigin InputDeviceHasCursorPropertyInfo = InputDevice
    attrGet = getInputDeviceHasCursor
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructInputDeviceHasCursor
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.hasCursor"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#g:attr:hasCursor"
        })
#endif

-- VVV Prop "id"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@id@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' inputDevice #id
-- @
getInputDeviceId :: (MonadIO m, IsInputDevice o) => o -> m Int32
getInputDeviceId :: forall (m :: * -> *) o.
(MonadIO m, IsInputDevice o) =>
o -> m Int32
getInputDeviceId o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"id"

-- | Construct a `GValueConstruct` with valid value for the “@id@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructInputDeviceId :: (IsInputDevice o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructInputDeviceId :: forall o (m :: * -> *).
(IsInputDevice o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructInputDeviceId Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"id" Int32
val

#if defined(ENABLE_OVERLOADING)
data InputDeviceIdPropertyInfo
instance AttrInfo InputDeviceIdPropertyInfo where
    type AttrAllowedOps InputDeviceIdPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint InputDeviceIdPropertyInfo = IsInputDevice
    type AttrSetTypeConstraint InputDeviceIdPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint InputDeviceIdPropertyInfo = (~) Int32
    type AttrTransferType InputDeviceIdPropertyInfo = Int32
    type AttrGetType InputDeviceIdPropertyInfo = Int32
    type AttrLabel InputDeviceIdPropertyInfo = "id"
    type AttrOrigin InputDeviceIdPropertyInfo = InputDevice
    attrGet = getInputDeviceId
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructInputDeviceId
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.id"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#g:attr:id"
        })
#endif

-- VVV Prop "n-axes"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@n-axes@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' inputDevice #nAxes
-- @
getInputDeviceNAxes :: (MonadIO m, IsInputDevice o) => o -> m Word32
getInputDeviceNAxes :: forall (m :: * -> *) o.
(MonadIO m, IsInputDevice o) =>
o -> m Word32
getInputDeviceNAxes o
obj = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"n-axes"

#if defined(ENABLE_OVERLOADING)
data InputDeviceNAxesPropertyInfo
instance AttrInfo InputDeviceNAxesPropertyInfo where
    type AttrAllowedOps InputDeviceNAxesPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint InputDeviceNAxesPropertyInfo = IsInputDevice
    type AttrSetTypeConstraint InputDeviceNAxesPropertyInfo = (~) ()
    type AttrTransferTypeConstraint InputDeviceNAxesPropertyInfo = (~) ()
    type AttrTransferType InputDeviceNAxesPropertyInfo = ()
    type AttrGetType InputDeviceNAxesPropertyInfo = Word32
    type AttrLabel InputDeviceNAxesPropertyInfo = "n-axes"
    type AttrOrigin InputDeviceNAxesPropertyInfo = InputDevice
    attrGet = getInputDeviceNAxes
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.nAxes"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#g:attr:nAxes"
        })
#endif

-- VVV Prop "name"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' inputDevice #name
-- @
getInputDeviceName :: (MonadIO m, IsInputDevice o) => o -> m (Maybe T.Text)
getInputDeviceName :: forall (m :: * -> *) o.
(MonadIO m, IsInputDevice o) =>
o -> m (Maybe Text)
getInputDeviceName o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"name"

-- | Construct a `GValueConstruct` with valid value for the “@name@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructInputDeviceName :: (IsInputDevice o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructInputDeviceName :: forall o (m :: * -> *).
(IsInputDevice o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructInputDeviceName Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data InputDeviceNamePropertyInfo
instance AttrInfo InputDeviceNamePropertyInfo where
    type AttrAllowedOps InputDeviceNamePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint InputDeviceNamePropertyInfo = IsInputDevice
    type AttrSetTypeConstraint InputDeviceNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint InputDeviceNamePropertyInfo = (~) T.Text
    type AttrTransferType InputDeviceNamePropertyInfo = T.Text
    type AttrGetType InputDeviceNamePropertyInfo = (Maybe T.Text)
    type AttrLabel InputDeviceNamePropertyInfo = "name"
    type AttrOrigin InputDeviceNamePropertyInfo = InputDevice
    attrGet = getInputDeviceName
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructInputDeviceName
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.name"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#g:attr:name"
        })
#endif

-- VVV Prop "product-id"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@product-id@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' inputDevice #productId
-- @
getInputDeviceProductId :: (MonadIO m, IsInputDevice o) => o -> m T.Text
getInputDeviceProductId :: forall (m :: * -> *) o. (MonadIO m, IsInputDevice o) => o -> m Text
getInputDeviceProductId o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getInputDeviceProductId" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"product-id"

-- | Construct a `GValueConstruct` with valid value for the “@product-id@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructInputDeviceProductId :: (IsInputDevice o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructInputDeviceProductId :: forall o (m :: * -> *).
(IsInputDevice o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructInputDeviceProductId Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"product-id" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data InputDeviceProductIdPropertyInfo
instance AttrInfo InputDeviceProductIdPropertyInfo where
    type AttrAllowedOps InputDeviceProductIdPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint InputDeviceProductIdPropertyInfo = IsInputDevice
    type AttrSetTypeConstraint InputDeviceProductIdPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint InputDeviceProductIdPropertyInfo = (~) T.Text
    type AttrTransferType InputDeviceProductIdPropertyInfo = T.Text
    type AttrGetType InputDeviceProductIdPropertyInfo = T.Text
    type AttrLabel InputDeviceProductIdPropertyInfo = "product-id"
    type AttrOrigin InputDeviceProductIdPropertyInfo = InputDevice
    attrGet = getInputDeviceProductId
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructInputDeviceProductId
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.productId"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#g:attr:productId"
        })
#endif

-- VVV Prop "vendor-id"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@vendor-id@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' inputDevice #vendorId
-- @
getInputDeviceVendorId :: (MonadIO m, IsInputDevice o) => o -> m T.Text
getInputDeviceVendorId :: forall (m :: * -> *) o. (MonadIO m, IsInputDevice o) => o -> m Text
getInputDeviceVendorId o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getInputDeviceVendorId" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"vendor-id"

-- | Construct a `GValueConstruct` with valid value for the “@vendor-id@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructInputDeviceVendorId :: (IsInputDevice o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructInputDeviceVendorId :: forall o (m :: * -> *).
(IsInputDevice o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructInputDeviceVendorId Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"vendor-id" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data InputDeviceVendorIdPropertyInfo
instance AttrInfo InputDeviceVendorIdPropertyInfo where
    type AttrAllowedOps InputDeviceVendorIdPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint InputDeviceVendorIdPropertyInfo = IsInputDevice
    type AttrSetTypeConstraint InputDeviceVendorIdPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint InputDeviceVendorIdPropertyInfo = (~) T.Text
    type AttrTransferType InputDeviceVendorIdPropertyInfo = T.Text
    type AttrGetType InputDeviceVendorIdPropertyInfo = T.Text
    type AttrLabel InputDeviceVendorIdPropertyInfo = "vendor-id"
    type AttrOrigin InputDeviceVendorIdPropertyInfo = InputDevice
    attrGet = getInputDeviceVendorId
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructInputDeviceVendorId
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.vendorId"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#g:attr:vendorId"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList InputDevice
type instance O.AttributeList InputDevice = InputDeviceAttributeList
type InputDeviceAttributeList = ('[ '("backend", InputDeviceBackendPropertyInfo), '("deviceManager", InputDeviceDeviceManagerPropertyInfo), '("deviceMode", InputDeviceDeviceModePropertyInfo), '("deviceType", InputDeviceDeviceTypePropertyInfo), '("enabled", InputDeviceEnabledPropertyInfo), '("hasCursor", InputDeviceHasCursorPropertyInfo), '("id", InputDeviceIdPropertyInfo), '("nAxes", InputDeviceNAxesPropertyInfo), '("name", InputDeviceNamePropertyInfo), '("productId", InputDeviceProductIdPropertyInfo), '("vendorId", InputDeviceVendorIdPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
inputDeviceBackend :: AttrLabelProxy "backend"
inputDeviceBackend = AttrLabelProxy

inputDeviceDeviceManager :: AttrLabelProxy "deviceManager"
inputDeviceDeviceManager = AttrLabelProxy

inputDeviceDeviceMode :: AttrLabelProxy "deviceMode"
inputDeviceDeviceMode = AttrLabelProxy

inputDeviceDeviceType :: AttrLabelProxy "deviceType"
inputDeviceDeviceType = AttrLabelProxy

inputDeviceEnabled :: AttrLabelProxy "enabled"
inputDeviceEnabled = AttrLabelProxy

inputDeviceHasCursor :: AttrLabelProxy "hasCursor"
inputDeviceHasCursor = AttrLabelProxy

inputDeviceId :: AttrLabelProxy "id"
inputDeviceId = AttrLabelProxy

inputDeviceNAxes :: AttrLabelProxy "nAxes"
inputDeviceNAxes = AttrLabelProxy

inputDeviceName :: AttrLabelProxy "name"
inputDeviceName = AttrLabelProxy

inputDeviceProductId :: AttrLabelProxy "productId"
inputDeviceProductId = AttrLabelProxy

inputDeviceVendorId :: AttrLabelProxy "vendorId"
inputDeviceVendorId = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList InputDevice = InputDeviceSignalList
type InputDeviceSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method InputDevice::get_associated_device
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInputDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "InputDevice" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_get_associated_device" clutter_input_device_get_associated_device :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    IO (Ptr InputDevice)

-- | Retrieves a pointer to the t'GI.Clutter.Objects.InputDevice.InputDevice' that has been
-- associated to /@device@/.
-- 
-- If the [InputDevice:deviceMode]("GI.Clutter.Objects.InputDevice#g:attr:deviceMode") property of /@device@/ is
-- set to 'GI.Clutter.Enums.InputModeMaster', this function will return
-- 'P.Nothing'.
-- 
-- /Since: 1.6/
inputDeviceGetAssociatedDevice ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Clutter.Objects.InputDevice.InputDevice'
    -> m InputDevice
    -- ^ __Returns:__ a t'GI.Clutter.Objects.InputDevice.InputDevice', or 'P.Nothing'
inputDeviceGetAssociatedDevice :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> m InputDevice
inputDeviceGetAssociatedDevice a
device = IO InputDevice -> m InputDevice
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InputDevice -> m InputDevice)
-> IO InputDevice -> m InputDevice
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    Ptr InputDevice
result <- Ptr InputDevice -> IO (Ptr InputDevice)
clutter_input_device_get_associated_device Ptr InputDevice
device'
    Text -> Ptr InputDevice -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"inputDeviceGetAssociatedDevice" Ptr InputDevice
result
    InputDevice
result' <- ((ManagedPtr InputDevice -> InputDevice)
-> Ptr InputDevice -> IO InputDevice
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr InputDevice -> InputDevice
InputDevice) Ptr InputDevice
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    InputDevice -> IO InputDevice
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InputDevice
result'

#if defined(ENABLE_OVERLOADING)
data InputDeviceGetAssociatedDeviceMethodInfo
instance (signature ~ (m InputDevice), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceGetAssociatedDeviceMethodInfo a signature where
    overloadedMethod = inputDeviceGetAssociatedDevice

instance O.OverloadedMethodInfo InputDeviceGetAssociatedDeviceMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceGetAssociatedDevice",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceGetAssociatedDevice"
        })


#endif

-- method InputDevice::get_axis
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInputDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the axis"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "InputAxis" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_get_axis" clutter_input_device_get_axis :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    Word32 ->                               -- index_ : TBasicType TUInt
    IO CUInt

-- | Retrieves the type of axis on /@device@/ at the given index.
-- 
-- /Since: 1.6/
inputDeviceGetAxis ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Clutter.Objects.InputDevice.InputDevice'
    -> Word32
    -- ^ /@index_@/: the index of the axis
    -> m Clutter.Enums.InputAxis
    -- ^ __Returns:__ the axis type
inputDeviceGetAxis :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> Word32 -> m InputAxis
inputDeviceGetAxis a
device Word32
index_ = IO InputAxis -> m InputAxis
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InputAxis -> m InputAxis) -> IO InputAxis -> m InputAxis
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    CUInt
result <- Ptr InputDevice -> Word32 -> IO CUInt
clutter_input_device_get_axis Ptr InputDevice
device' Word32
index_
    let result' :: InputAxis
result' = (Int -> InputAxis
forall a. Enum a => Int -> a
toEnum (Int -> InputAxis) -> (CUInt -> Int) -> CUInt -> InputAxis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    InputAxis -> IO InputAxis
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InputAxis
result'

#if defined(ENABLE_OVERLOADING)
data InputDeviceGetAxisMethodInfo
instance (signature ~ (Word32 -> m Clutter.Enums.InputAxis), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceGetAxisMethodInfo a signature where
    overloadedMethod = inputDeviceGetAxis

instance O.OverloadedMethodInfo InputDeviceGetAxisMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceGetAxis",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceGetAxis"
        })


#endif

-- method InputDevice::get_axis_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInputDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "axes"
--           , argType = TCArray False (-1) (-1) (TBasicType TDouble)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "an array of axes values, typically\n  coming from clutter_event_get_axes()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "axis"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputAxis" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the axis to extract"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the axis value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_get_axis_value" clutter_input_device_get_axis_value :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    Ptr CDouble ->                          -- axes : TCArray False (-1) (-1) (TBasicType TDouble)
    CUInt ->                                -- axis : TInterface (Name {namespace = "Clutter", name = "InputAxis"})
    Ptr CDouble ->                          -- value : TBasicType TDouble
    IO CInt

-- | Extracts the value of the given /@axis@/ of a t'GI.Clutter.Objects.InputDevice.InputDevice' from
-- an array of axis values.
-- 
-- An example of typical usage for this function is:
-- 
-- >
-- >  ClutterInputDevice *device = clutter_event_get_device (event);
-- >  gdouble *axes = clutter_event_get_axes (event, NULL);
-- >  gdouble pressure_value = 0;
-- >
-- >  clutter_input_device_get_axis_value (device, axes,
-- >                                       CLUTTER_INPUT_AXIS_PRESSURE,
-- >                                       &pressure_value);
-- 
-- 
-- /Since: 1.6/
inputDeviceGetAxisValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Clutter.Objects.InputDevice.InputDevice'
    -> [Double]
    -- ^ /@axes@/: an array of axes values, typically
    --   coming from 'GI.Clutter.Unions.Event.eventGetAxes'
    -> Clutter.Enums.InputAxis
    -- ^ /@axis@/: the axis to extract
    -> m ((Bool, Double))
    -- ^ __Returns:__ 'P.True' if the value was set, and 'P.False' otherwise
inputDeviceGetAxisValue :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> [Double] -> InputAxis -> m (Bool, Double)
inputDeviceGetAxisValue a
device [Double]
axes InputAxis
axis = IO (Bool, Double) -> m (Bool, Double)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Double) -> m (Bool, Double))
-> IO (Bool, Double) -> m (Bool, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    Ptr CDouble
axes' <- ((Double -> CDouble) -> [Double] -> IO (Ptr CDouble)
forall a b. Storable b => (a -> b) -> [a] -> IO (Ptr b)
packMapStorableArray Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac) [Double]
axes
    let axis' :: CUInt
axis' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (InputAxis -> Int) -> InputAxis -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputAxis -> Int
forall a. Enum a => a -> Int
fromEnum) InputAxis
axis
    Ptr CDouble
value <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    CInt
result <- Ptr InputDevice -> Ptr CDouble -> CUInt -> Ptr CDouble -> IO CInt
clutter_input_device_get_axis_value Ptr InputDevice
device' Ptr CDouble
axes' CUInt
axis' Ptr CDouble
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CDouble
value' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
value
    let value'' :: Double
value'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
axes'
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
value
    (Bool, Double) -> IO (Bool, Double)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Double
value'')

#if defined(ENABLE_OVERLOADING)
data InputDeviceGetAxisValueMethodInfo
instance (signature ~ ([Double] -> Clutter.Enums.InputAxis -> m ((Bool, Double))), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceGetAxisValueMethodInfo a signature where
    overloadedMethod = inputDeviceGetAxisValue

instance O.OverloadedMethodInfo InputDeviceGetAxisValueMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceGetAxisValue",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceGetAxisValue"
        })


#endif

-- method InputDevice::get_coords
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInputDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sequence"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "EventSequence" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #ClutterEventSequence, or %NULL if\n  the device is not touch-based"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "point"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Point" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the pointer\n  or touch point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_get_coords" clutter_input_device_get_coords :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    Ptr Clutter.EventSequence.EventSequence -> -- sequence : TInterface (Name {namespace = "Clutter", name = "EventSequence"})
    Ptr Clutter.Point.Point ->              -- point : TInterface (Name {namespace = "Clutter", name = "Point"})
    IO CInt

-- | Retrieves the latest coordinates of a pointer or touch point of
-- /@device@/.
-- 
-- /Since: 1.12/
inputDeviceGetCoords ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Clutter.Objects.InputDevice.InputDevice'
    -> Maybe (Clutter.EventSequence.EventSequence)
    -- ^ /@sequence@/: a t'GI.Clutter.Structs.EventSequence.EventSequence', or 'P.Nothing' if
    --   the device is not touch-based
    -> m ((Bool, Clutter.Point.Point))
    -- ^ __Returns:__ 'P.False' if the device\'s sequence hasn\'t been found,
    --   and 'P.True' otherwise.
inputDeviceGetCoords :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> Maybe EventSequence -> m (Bool, Point)
inputDeviceGetCoords a
device Maybe EventSequence
sequence = IO (Bool, Point) -> m (Bool, Point)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Point) -> m (Bool, Point))
-> IO (Bool, Point) -> m (Bool, Point)
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    Ptr EventSequence
maybeSequence <- case Maybe EventSequence
sequence of
        Maybe EventSequence
Nothing -> Ptr EventSequence -> IO (Ptr EventSequence)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr EventSequence
forall a. Ptr a
nullPtr
        Just EventSequence
jSequence -> do
            Ptr EventSequence
jSequence' <- EventSequence -> IO (Ptr EventSequence)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr EventSequence
jSequence
            Ptr EventSequence -> IO (Ptr EventSequence)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr EventSequence
jSequence'
    Ptr Point
point <- Int -> IO (Ptr Point)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
8 :: IO (Ptr Clutter.Point.Point)
    CInt
result <- Ptr InputDevice -> Ptr EventSequence -> Ptr Point -> IO CInt
clutter_input_device_get_coords Ptr InputDevice
device' Ptr EventSequence
maybeSequence Ptr Point
point
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Point
point' <- ((ManagedPtr Point -> Point) -> Ptr Point -> IO Point
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Point -> Point
Clutter.Point.Point) Ptr Point
point
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Maybe EventSequence -> (EventSequence -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe EventSequence
sequence EventSequence -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    (Bool, Point) -> IO (Bool, Point)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Point
point')

#if defined(ENABLE_OVERLOADING)
data InputDeviceGetCoordsMethodInfo
instance (signature ~ (Maybe (Clutter.EventSequence.EventSequence) -> m ((Bool, Clutter.Point.Point))), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceGetCoordsMethodInfo a signature where
    overloadedMethod = inputDeviceGetCoords

instance O.OverloadedMethodInfo InputDeviceGetCoordsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceGetCoords",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceGetCoords"
        })


#endif

-- method InputDevice::get_device_coords
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #ClutterInputDevice of type %CLUTTER_POINTER_DEVICE"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the X coordinate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the Y coordinate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_get_device_coords" clutter_input_device_get_device_coords :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    Ptr Int32 ->                            -- x : TBasicType TInt
    Ptr Int32 ->                            -- y : TBasicType TInt
    IO ()

{-# DEPRECATED inputDeviceGetDeviceCoords ["(Since version 1.12)","Use 'GI.Clutter.Objects.InputDevice.inputDeviceGetCoords' instead."] #-}
-- | Retrieves the latest coordinates of the pointer of /@device@/
-- 
-- /Since: 1.2/
inputDeviceGetDeviceCoords ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Clutter.Objects.InputDevice.InputDevice' of type 'GI.Clutter.Enums.InputDeviceTypePointerDevice'
    -> m ((Int32, Int32))
inputDeviceGetDeviceCoords :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> m (Int32, Int32)
inputDeviceGetDeviceCoords a
device = IO (Int32, Int32) -> m (Int32, Int32)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Int32) -> m (Int32, Int32))
-> IO (Int32, Int32) -> m (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    Ptr Int32
x <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32
y <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr InputDevice -> Ptr Int32 -> Ptr Int32 -> IO ()
clutter_input_device_get_device_coords Ptr InputDevice
device' Ptr Int32
x Ptr Int32
y
    Int32
x' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
x
    Int32
y' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
x
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
y
    (Int32, Int32) -> IO (Int32, Int32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
x', Int32
y')

#if defined(ENABLE_OVERLOADING)
data InputDeviceGetDeviceCoordsMethodInfo
instance (signature ~ (m ((Int32, Int32))), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceGetDeviceCoordsMethodInfo a signature where
    overloadedMethod = inputDeviceGetDeviceCoords

instance O.OverloadedMethodInfo InputDeviceGetDeviceCoordsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceGetDeviceCoords",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceGetDeviceCoords"
        })


#endif

-- method InputDevice::get_device_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInputDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_get_device_id" clutter_input_device_get_device_id :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    IO Int32

-- | Retrieves the unique identifier of /@device@/
-- 
-- /Since: 1.0/
inputDeviceGetDeviceId ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Clutter.Objects.InputDevice.InputDevice'
    -> m Int32
    -- ^ __Returns:__ the identifier of the device
inputDeviceGetDeviceId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> m Int32
inputDeviceGetDeviceId a
device = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    Int32
result <- Ptr InputDevice -> IO Int32
clutter_input_device_get_device_id Ptr InputDevice
device'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data InputDeviceGetDeviceIdMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceGetDeviceIdMethodInfo a signature where
    overloadedMethod = inputDeviceGetDeviceId

instance O.OverloadedMethodInfo InputDeviceGetDeviceIdMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceGetDeviceId",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceGetDeviceId"
        })


#endif

-- method InputDevice::get_device_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInputDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "InputMode" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_get_device_mode" clutter_input_device_get_device_mode :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    IO CUInt

-- | Retrieves the t'GI.Clutter.Enums.InputMode' of /@device@/.
-- 
-- /Since: 1.6/
inputDeviceGetDeviceMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Clutter.Objects.InputDevice.InputDevice'
    -> m Clutter.Enums.InputMode
    -- ^ __Returns:__ the device mode
inputDeviceGetDeviceMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> m InputMode
inputDeviceGetDeviceMode a
device = IO InputMode -> m InputMode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InputMode -> m InputMode) -> IO InputMode -> m InputMode
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    CUInt
result <- Ptr InputDevice -> IO CUInt
clutter_input_device_get_device_mode Ptr InputDevice
device'
    let result' :: InputMode
result' = (Int -> InputMode
forall a. Enum a => Int -> a
toEnum (Int -> InputMode) -> (CUInt -> Int) -> CUInt -> InputMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    InputMode -> IO InputMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InputMode
result'

#if defined(ENABLE_OVERLOADING)
data InputDeviceGetDeviceModeMethodInfo
instance (signature ~ (m Clutter.Enums.InputMode), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceGetDeviceModeMethodInfo a signature where
    overloadedMethod = inputDeviceGetDeviceMode

instance O.OverloadedMethodInfo InputDeviceGetDeviceModeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceGetDeviceMode",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceGetDeviceMode"
        })


#endif

-- method InputDevice::get_device_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInputDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_get_device_name" clutter_input_device_get_device_name :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    IO CString

-- | Retrieves the name of the /@device@/
-- 
-- /Since: 1.2/
inputDeviceGetDeviceName ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Clutter.Objects.InputDevice.InputDevice'
    -> m T.Text
    -- ^ __Returns:__ the name of the device, or 'P.Nothing'. The returned string
    --   is owned by the t'GI.Clutter.Objects.InputDevice.InputDevice' and should never be modified
    --   or freed
inputDeviceGetDeviceName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> m Text
inputDeviceGetDeviceName a
device = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    CString
result <- Ptr InputDevice -> IO CString
clutter_input_device_get_device_name Ptr InputDevice
device'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"inputDeviceGetDeviceName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data InputDeviceGetDeviceNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceGetDeviceNameMethodInfo a signature where
    overloadedMethod = inputDeviceGetDeviceName

instance O.OverloadedMethodInfo InputDeviceGetDeviceNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceGetDeviceName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceGetDeviceName"
        })


#endif

-- method InputDevice::get_device_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInputDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Clutter" , name = "InputDeviceType" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_get_device_type" clutter_input_device_get_device_type :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    IO CUInt

-- | Retrieves the type of /@device@/
-- 
-- /Since: 1.0/
inputDeviceGetDeviceType ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Clutter.Objects.InputDevice.InputDevice'
    -> m Clutter.Enums.InputDeviceType
    -- ^ __Returns:__ the type of the device
inputDeviceGetDeviceType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> m InputDeviceType
inputDeviceGetDeviceType a
device = IO InputDeviceType -> m InputDeviceType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InputDeviceType -> m InputDeviceType)
-> IO InputDeviceType -> m InputDeviceType
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    CUInt
result <- Ptr InputDevice -> IO CUInt
clutter_input_device_get_device_type Ptr InputDevice
device'
    let result' :: InputDeviceType
result' = (Int -> InputDeviceType
forall a. Enum a => Int -> a
toEnum (Int -> InputDeviceType)
-> (CUInt -> Int) -> CUInt -> InputDeviceType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    InputDeviceType -> IO InputDeviceType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InputDeviceType
result'

#if defined(ENABLE_OVERLOADING)
data InputDeviceGetDeviceTypeMethodInfo
instance (signature ~ (m Clutter.Enums.InputDeviceType), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceGetDeviceTypeMethodInfo a signature where
    overloadedMethod = inputDeviceGetDeviceType

instance O.OverloadedMethodInfo InputDeviceGetDeviceTypeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceGetDeviceType",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceGetDeviceType"
        })


#endif

-- method InputDevice::get_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInputDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_get_enabled" clutter_input_device_get_enabled :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    IO CInt

-- | Retrieves whether /@device@/ is enabled.
-- 
-- /Since: 1.6/
inputDeviceGetEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Clutter.Objects.InputDevice.InputDevice'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the device is enabled
inputDeviceGetEnabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> m Bool
inputDeviceGetEnabled a
device = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    CInt
result <- Ptr InputDevice -> IO CInt
clutter_input_device_get_enabled Ptr InputDevice
device'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data InputDeviceGetEnabledMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceGetEnabledMethodInfo a signature where
    overloadedMethod = inputDeviceGetEnabled

instance O.OverloadedMethodInfo InputDeviceGetEnabledMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceGetEnabled",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceGetEnabled"
        })


#endif

-- method InputDevice::get_grabbed_actor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInputDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Actor" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_get_grabbed_actor" clutter_input_device_get_grabbed_actor :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    IO (Ptr Clutter.Actor.Actor)

-- | Retrieves a pointer to the t'GI.Clutter.Objects.Actor.Actor' currently grabbing all
-- the events coming from /@device@/.
-- 
-- /Since: 1.10/
inputDeviceGetGrabbedActor ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Clutter.Objects.InputDevice.InputDevice'
    -> m Clutter.Actor.Actor
    -- ^ __Returns:__ a t'GI.Clutter.Objects.Actor.Actor', or 'P.Nothing'
inputDeviceGetGrabbedActor :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> m Actor
inputDeviceGetGrabbedActor a
device = IO Actor -> m Actor
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Actor -> m Actor) -> IO Actor -> m Actor
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    Ptr Actor
result <- Ptr InputDevice -> IO (Ptr Actor)
clutter_input_device_get_grabbed_actor Ptr InputDevice
device'
    Text -> Ptr Actor -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"inputDeviceGetGrabbedActor" Ptr Actor
result
    Actor
result' <- ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) Ptr Actor
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Actor -> IO Actor
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Actor
result'

#if defined(ENABLE_OVERLOADING)
data InputDeviceGetGrabbedActorMethodInfo
instance (signature ~ (m Clutter.Actor.Actor), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceGetGrabbedActorMethodInfo a signature where
    overloadedMethod = inputDeviceGetGrabbedActor

instance O.OverloadedMethodInfo InputDeviceGetGrabbedActorMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceGetGrabbedActor",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceGetGrabbedActor"
        })


#endif

-- method InputDevice::get_has_cursor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInputDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_get_has_cursor" clutter_input_device_get_has_cursor :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    IO CInt

-- | Retrieves whether /@device@/ has a pointer that follows the
-- device motion.
-- 
-- /Since: 1.6/
inputDeviceGetHasCursor ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Clutter.Objects.InputDevice.InputDevice'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the device has a cursor
inputDeviceGetHasCursor :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> m Bool
inputDeviceGetHasCursor a
device = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    CInt
result <- Ptr InputDevice -> IO CInt
clutter_input_device_get_has_cursor Ptr InputDevice
device'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data InputDeviceGetHasCursorMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceGetHasCursorMethodInfo a signature where
    overloadedMethod = inputDeviceGetHasCursor

instance O.OverloadedMethodInfo InputDeviceGetHasCursorMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceGetHasCursor",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceGetHasCursor"
        })


#endif

-- method InputDevice::get_key
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInputDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the key"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "keyval"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the keyval at @index_"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "modifiers"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ModifierType" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the modifiers at @index_"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_get_key" clutter_input_device_get_key :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    Word32 ->                               -- index_ : TBasicType TUInt
    Ptr Word32 ->                           -- keyval : TBasicType TUInt
    Ptr CUInt ->                            -- modifiers : TInterface (Name {namespace = "Clutter", name = "ModifierType"})
    IO CInt

-- | Retrieves the key set using 'GI.Clutter.Objects.InputDevice.inputDeviceSetKey'
-- 
-- /Since: 1.6/
inputDeviceGetKey ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Clutter.Objects.InputDevice.InputDevice'
    -> Word32
    -- ^ /@index_@/: the index of the key
    -> m ((Bool, Word32, [Clutter.Flags.ModifierType]))
    -- ^ __Returns:__ 'P.True' if a key was set at the given index
inputDeviceGetKey :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> Word32 -> m (Bool, Word32, [ModifierType])
inputDeviceGetKey a
device Word32
index_ = IO (Bool, Word32, [ModifierType])
-> m (Bool, Word32, [ModifierType])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32, [ModifierType])
 -> m (Bool, Word32, [ModifierType]))
-> IO (Bool, Word32, [ModifierType])
-> m (Bool, Word32, [ModifierType])
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    Ptr Word32
keyval <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr CUInt
modifiers <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    CInt
result <- Ptr InputDevice -> Word32 -> Ptr Word32 -> Ptr CUInt -> IO CInt
clutter_input_device_get_key Ptr InputDevice
device' Word32
index_ Ptr Word32
keyval Ptr CUInt
modifiers
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word32
keyval' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
keyval
    CUInt
modifiers' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
modifiers
    let modifiers'' :: [ModifierType]
modifiers'' = CUInt -> [ModifierType]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
modifiers'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
keyval
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
modifiers
    (Bool, Word32, [ModifierType]) -> IO (Bool, Word32, [ModifierType])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
keyval', [ModifierType]
modifiers'')

#if defined(ENABLE_OVERLOADING)
data InputDeviceGetKeyMethodInfo
instance (signature ~ (Word32 -> m ((Bool, Word32, [Clutter.Flags.ModifierType]))), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceGetKeyMethodInfo a signature where
    overloadedMethod = inputDeviceGetKey

instance O.OverloadedMethodInfo InputDeviceGetKeyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceGetKey",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceGetKey"
        })


#endif

-- method InputDevice::get_modifier_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInputDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "ModifierType" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_get_modifier_state" clutter_input_device_get_modifier_state :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    IO CUInt

-- | Retrieves the current modifiers state of the device, as seen
-- by the last event Clutter processed.
-- 
-- /Since: 1.16/
inputDeviceGetModifierState ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Clutter.Objects.InputDevice.InputDevice'
    -> m [Clutter.Flags.ModifierType]
    -- ^ __Returns:__ the last known modifier state
inputDeviceGetModifierState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> m [ModifierType]
inputDeviceGetModifierState a
device = IO [ModifierType] -> m [ModifierType]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ModifierType] -> m [ModifierType])
-> IO [ModifierType] -> m [ModifierType]
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    CUInt
result <- Ptr InputDevice -> IO CUInt
clutter_input_device_get_modifier_state Ptr InputDevice
device'
    let result' :: [ModifierType]
result' = CUInt -> [ModifierType]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    [ModifierType] -> IO [ModifierType]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ModifierType]
result'

#if defined(ENABLE_OVERLOADING)
data InputDeviceGetModifierStateMethodInfo
instance (signature ~ (m [Clutter.Flags.ModifierType]), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceGetModifierStateMethodInfo a signature where
    overloadedMethod = inputDeviceGetModifierState

instance O.OverloadedMethodInfo InputDeviceGetModifierStateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceGetModifierState",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceGetModifierState"
        })


#endif

-- method InputDevice::get_n_axes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInputDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_get_n_axes" clutter_input_device_get_n_axes :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    IO Word32

-- | Retrieves the number of axes available on /@device@/.
-- 
-- /Since: 1.6/
inputDeviceGetNAxes ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Clutter.Objects.InputDevice.InputDevice'
    -> m Word32
    -- ^ __Returns:__ the number of axes on the device
inputDeviceGetNAxes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> m Word32
inputDeviceGetNAxes a
device = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    Word32
result <- Ptr InputDevice -> IO Word32
clutter_input_device_get_n_axes Ptr InputDevice
device'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data InputDeviceGetNAxesMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceGetNAxesMethodInfo a signature where
    overloadedMethod = inputDeviceGetNAxes

instance O.OverloadedMethodInfo InputDeviceGetNAxesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceGetNAxes",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceGetNAxes"
        })


#endif

-- method InputDevice::get_n_keys
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInputDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_get_n_keys" clutter_input_device_get_n_keys :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    IO Word32

-- | Retrieves the number of keys registered for /@device@/.
-- 
-- /Since: 1.6/
inputDeviceGetNKeys ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Clutter.Objects.InputDevice.InputDevice'
    -> m Word32
    -- ^ __Returns:__ the number of registered keys
inputDeviceGetNKeys :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> m Word32
inputDeviceGetNKeys a
device = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    Word32
result <- Ptr InputDevice -> IO Word32
clutter_input_device_get_n_keys Ptr InputDevice
device'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data InputDeviceGetNKeysMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceGetNKeysMethodInfo a signature where
    overloadedMethod = inputDeviceGetNKeys

instance O.OverloadedMethodInfo InputDeviceGetNKeysMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceGetNKeys",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceGetNKeys"
        })


#endif

-- method InputDevice::get_pointer_actor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #ClutterInputDevice of type %CLUTTER_POINTER_DEVICE"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Actor" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_get_pointer_actor" clutter_input_device_get_pointer_actor :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    IO (Ptr Clutter.Actor.Actor)

-- | Retrieves the t'GI.Clutter.Objects.Actor.Actor' underneath the pointer of /@device@/
-- 
-- /Since: 1.2/
inputDeviceGetPointerActor ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Clutter.Objects.InputDevice.InputDevice' of type 'GI.Clutter.Enums.InputDeviceTypePointerDevice'
    -> m Clutter.Actor.Actor
    -- ^ __Returns:__ a pointer to the t'GI.Clutter.Objects.Actor.Actor' or 'P.Nothing'
inputDeviceGetPointerActor :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> m Actor
inputDeviceGetPointerActor a
device = IO Actor -> m Actor
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Actor -> m Actor) -> IO Actor -> m Actor
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    Ptr Actor
result <- Ptr InputDevice -> IO (Ptr Actor)
clutter_input_device_get_pointer_actor Ptr InputDevice
device'
    Text -> Ptr Actor -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"inputDeviceGetPointerActor" Ptr Actor
result
    Actor
result' <- ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) Ptr Actor
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Actor -> IO Actor
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Actor
result'

#if defined(ENABLE_OVERLOADING)
data InputDeviceGetPointerActorMethodInfo
instance (signature ~ (m Clutter.Actor.Actor), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceGetPointerActorMethodInfo a signature where
    overloadedMethod = inputDeviceGetPointerActor

instance O.OverloadedMethodInfo InputDeviceGetPointerActorMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceGetPointerActor",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceGetPointerActor"
        })


#endif

-- method InputDevice::get_pointer_stage
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #ClutterInputDevice of type %CLUTTER_POINTER_DEVICE"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Stage" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_get_pointer_stage" clutter_input_device_get_pointer_stage :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    IO (Ptr Clutter.Stage.Stage)

-- | Retrieves the t'GI.Clutter.Objects.Stage.Stage' underneath the pointer of /@device@/
-- 
-- /Since: 1.2/
inputDeviceGetPointerStage ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Clutter.Objects.InputDevice.InputDevice' of type 'GI.Clutter.Enums.InputDeviceTypePointerDevice'
    -> m Clutter.Stage.Stage
    -- ^ __Returns:__ a pointer to the t'GI.Clutter.Objects.Stage.Stage' or 'P.Nothing'
inputDeviceGetPointerStage :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> m Stage
inputDeviceGetPointerStage a
device = IO Stage -> m Stage
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Stage -> m Stage) -> IO Stage -> m Stage
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    Ptr Stage
result <- Ptr InputDevice -> IO (Ptr Stage)
clutter_input_device_get_pointer_stage Ptr InputDevice
device'
    Text -> Ptr Stage -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"inputDeviceGetPointerStage" Ptr Stage
result
    Stage
result' <- ((ManagedPtr Stage -> Stage) -> Ptr Stage -> IO Stage
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Stage -> Stage
Clutter.Stage.Stage) Ptr Stage
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Stage -> IO Stage
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Stage
result'

#if defined(ENABLE_OVERLOADING)
data InputDeviceGetPointerStageMethodInfo
instance (signature ~ (m Clutter.Stage.Stage), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceGetPointerStageMethodInfo a signature where
    overloadedMethod = inputDeviceGetPointerStage

instance O.OverloadedMethodInfo InputDeviceGetPointerStageMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceGetPointerStage",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceGetPointerStage"
        })


#endif

-- method InputDevice::get_product_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a slave #ClutterInputDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_get_product_id" clutter_input_device_get_product_id :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    IO CString

-- | Gets the product ID of this device.
-- 
-- /Since: 1.22/
inputDeviceGetProductId ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: a slave t'GI.Clutter.Objects.InputDevice.InputDevice'
    -> m T.Text
    -- ^ __Returns:__ the product ID
inputDeviceGetProductId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> m Text
inputDeviceGetProductId a
device = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    CString
result <- Ptr InputDevice -> IO CString
clutter_input_device_get_product_id Ptr InputDevice
device'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"inputDeviceGetProductId" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data InputDeviceGetProductIdMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceGetProductIdMethodInfo a signature where
    overloadedMethod = inputDeviceGetProductId

instance O.OverloadedMethodInfo InputDeviceGetProductIdMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceGetProductId",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceGetProductId"
        })


#endif

-- method InputDevice::get_slave_devices
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInputDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "Clutter" , name = "InputDevice" }))
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_get_slave_devices" clutter_input_device_get_slave_devices :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    IO (Ptr (GList (Ptr InputDevice)))

-- | Retrieves the slave devices attached to /@device@/.
-- 
-- /Since: 1.6/
inputDeviceGetSlaveDevices ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Clutter.Objects.InputDevice.InputDevice'
    -> m [InputDevice]
    -- ^ __Returns:__ a
    --   list of t'GI.Clutter.Objects.InputDevice.InputDevice', or 'P.Nothing'. The contents of the list are
    --   owned by the device. Use @/g_list_free()/@ when done
inputDeviceGetSlaveDevices :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> m [InputDevice]
inputDeviceGetSlaveDevices a
device = IO [InputDevice] -> m [InputDevice]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [InputDevice] -> m [InputDevice])
-> IO [InputDevice] -> m [InputDevice]
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    Ptr (GList (Ptr InputDevice))
result <- Ptr InputDevice -> IO (Ptr (GList (Ptr InputDevice)))
clutter_input_device_get_slave_devices Ptr InputDevice
device'
    [Ptr InputDevice]
result' <- Ptr (GList (Ptr InputDevice)) -> IO [Ptr InputDevice]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr InputDevice))
result
    [InputDevice]
result'' <- (Ptr InputDevice -> IO InputDevice)
-> [Ptr InputDevice] -> IO [InputDevice]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr InputDevice -> InputDevice)
-> Ptr InputDevice -> IO InputDevice
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr InputDevice -> InputDevice
InputDevice) [Ptr InputDevice]
result'
    Ptr (GList (Ptr InputDevice)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr InputDevice))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    [InputDevice] -> IO [InputDevice]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [InputDevice]
result''

#if defined(ENABLE_OVERLOADING)
data InputDeviceGetSlaveDevicesMethodInfo
instance (signature ~ (m [InputDevice]), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceGetSlaveDevicesMethodInfo a signature where
    overloadedMethod = inputDeviceGetSlaveDevices

instance O.OverloadedMethodInfo InputDeviceGetSlaveDevicesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceGetSlaveDevices",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceGetSlaveDevices"
        })


#endif

-- method InputDevice::get_vendor_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a slave #ClutterInputDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_get_vendor_id" clutter_input_device_get_vendor_id :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    IO CString

-- | Gets the vendor ID of this device.
-- 
-- /Since: 1.22/
inputDeviceGetVendorId ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: a slave t'GI.Clutter.Objects.InputDevice.InputDevice'
    -> m T.Text
    -- ^ __Returns:__ the vendor ID
inputDeviceGetVendorId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> m Text
inputDeviceGetVendorId a
device = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    CString
result <- Ptr InputDevice -> IO CString
clutter_input_device_get_vendor_id Ptr InputDevice
device'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"inputDeviceGetVendorId" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data InputDeviceGetVendorIdMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceGetVendorIdMethodInfo a signature where
    overloadedMethod = inputDeviceGetVendorId

instance O.OverloadedMethodInfo InputDeviceGetVendorIdMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceGetVendorId",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceGetVendorId"
        })


#endif

-- method InputDevice::grab
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInputDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "actor"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_grab" clutter_input_device_grab :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    Ptr Clutter.Actor.Actor ->              -- actor : TInterface (Name {namespace = "Clutter", name = "Actor"})
    IO ()

-- | Acquires a grab on /@actor@/ for the given /@device@/.
-- 
-- Any event coming from /@device@/ will be delivered to /@actor@/, bypassing
-- the usual event delivery mechanism, until the grab is released by
-- calling 'GI.Clutter.Objects.InputDevice.inputDeviceUngrab'.
-- 
-- The grab is client-side: even if the windowing system used by the Clutter
-- backend has the concept of \"device grabs\", Clutter will not use them.
-- 
-- Only t'GI.Clutter.Objects.InputDevice.InputDevice' of types 'GI.Clutter.Enums.InputDeviceTypePointerDevice' and
-- 'GI.Clutter.Enums.InputDeviceTypeKeyboardDevice' can hold a grab.
-- 
-- /Since: 1.10/
inputDeviceGrab ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a, Clutter.Actor.IsActor b) =>
    a
    -- ^ /@device@/: a t'GI.Clutter.Objects.InputDevice.InputDevice'
    -> b
    -- ^ /@actor@/: a t'GI.Clutter.Objects.Actor.Actor'
    -> m ()
inputDeviceGrab :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsInputDevice a, IsActor b) =>
a -> b -> m ()
inputDeviceGrab a
device b
actor = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    Ptr Actor
actor' <- b -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
actor
    Ptr InputDevice -> Ptr Actor -> IO ()
clutter_input_device_grab Ptr InputDevice
device' Ptr Actor
actor'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
actor
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data InputDeviceGrabMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsInputDevice a, Clutter.Actor.IsActor b) => O.OverloadedMethod InputDeviceGrabMethodInfo a signature where
    overloadedMethod = inputDeviceGrab

instance O.OverloadedMethodInfo InputDeviceGrabMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceGrab",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceGrab"
        })


#endif

-- method InputDevice::keycode_to_evdev
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #ClutterInputDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "hardware_keycode"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The hardware keycode from a #ClutterKeyEvent"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "evdev_keycode"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The return location for the evdev keycode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_keycode_to_evdev" clutter_input_device_keycode_to_evdev :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    Word32 ->                               -- hardware_keycode : TBasicType TUInt
    Word32 ->                               -- evdev_keycode : TBasicType TUInt
    IO CInt

-- | Translates a hardware keycode from a t'GI.Clutter.Structs.KeyEvent.KeyEvent' to the
-- equivalent evdev keycode. Note that depending on the input backend
-- used by Clutter this function can fail if there is no obvious
-- mapping between the key codes. The hardware keycode can be taken
-- from the t'GI.Clutter.Structs.KeyEvent.KeyEvent'.@/hardware_keycode/@ member of t'GI.Clutter.Structs.KeyEvent.KeyEvent'.
-- 
-- /Since: 1.10/
inputDeviceKeycodeToEvdev ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: A t'GI.Clutter.Objects.InputDevice.InputDevice'
    -> Word32
    -- ^ /@hardwareKeycode@/: The hardware keycode from a t'GI.Clutter.Structs.KeyEvent.KeyEvent'
    -> Word32
    -- ^ /@evdevKeycode@/: The return location for the evdev keycode
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the conversion succeeded, 'P.False' otherwise.
inputDeviceKeycodeToEvdev :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> Word32 -> Word32 -> m Bool
inputDeviceKeycodeToEvdev a
device Word32
hardwareKeycode Word32
evdevKeycode = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    CInt
result <- Ptr InputDevice -> Word32 -> Word32 -> IO CInt
clutter_input_device_keycode_to_evdev Ptr InputDevice
device' Word32
hardwareKeycode Word32
evdevKeycode
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data InputDeviceKeycodeToEvdevMethodInfo
instance (signature ~ (Word32 -> Word32 -> m Bool), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceKeycodeToEvdevMethodInfo a signature where
    overloadedMethod = inputDeviceKeycodeToEvdev

instance O.OverloadedMethodInfo InputDeviceKeycodeToEvdevMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceKeycodeToEvdev",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceKeycodeToEvdev"
        })


#endif

-- method InputDevice::sequence_get_grabbed_actor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInputDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sequence"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "EventSequence" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterEventSequence"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Actor" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_sequence_get_grabbed_actor" clutter_input_device_sequence_get_grabbed_actor :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    Ptr Clutter.EventSequence.EventSequence -> -- sequence : TInterface (Name {namespace = "Clutter", name = "EventSequence"})
    IO (Ptr Clutter.Actor.Actor)

-- | Retrieves a pointer to the t'GI.Clutter.Objects.Actor.Actor' currently grabbing the
-- touch events coming from /@device@/ given the /@sequence@/.
-- 
-- /Since: 1.12/
inputDeviceSequenceGetGrabbedActor ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Clutter.Objects.InputDevice.InputDevice'
    -> Clutter.EventSequence.EventSequence
    -- ^ /@sequence@/: a t'GI.Clutter.Structs.EventSequence.EventSequence'
    -> m Clutter.Actor.Actor
    -- ^ __Returns:__ a t'GI.Clutter.Objects.Actor.Actor', or 'P.Nothing'
inputDeviceSequenceGetGrabbedActor :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> EventSequence -> m Actor
inputDeviceSequenceGetGrabbedActor a
device EventSequence
sequence = IO Actor -> m Actor
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Actor -> m Actor) -> IO Actor -> m Actor
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    Ptr EventSequence
sequence' <- EventSequence -> IO (Ptr EventSequence)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr EventSequence
sequence
    Ptr Actor
result <- Ptr InputDevice -> Ptr EventSequence -> IO (Ptr Actor)
clutter_input_device_sequence_get_grabbed_actor Ptr InputDevice
device' Ptr EventSequence
sequence'
    Text -> Ptr Actor -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"inputDeviceSequenceGetGrabbedActor" Ptr Actor
result
    Actor
result' <- ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) Ptr Actor
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    EventSequence -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr EventSequence
sequence
    Actor -> IO Actor
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Actor
result'

#if defined(ENABLE_OVERLOADING)
data InputDeviceSequenceGetGrabbedActorMethodInfo
instance (signature ~ (Clutter.EventSequence.EventSequence -> m Clutter.Actor.Actor), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceSequenceGetGrabbedActorMethodInfo a signature where
    overloadedMethod = inputDeviceSequenceGetGrabbedActor

instance O.OverloadedMethodInfo InputDeviceSequenceGetGrabbedActorMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceSequenceGetGrabbedActor",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceSequenceGetGrabbedActor"
        })


#endif

-- method InputDevice::sequence_grab
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInputDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sequence"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "EventSequence" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterEventSequence"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "actor"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_sequence_grab" clutter_input_device_sequence_grab :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    Ptr Clutter.EventSequence.EventSequence -> -- sequence : TInterface (Name {namespace = "Clutter", name = "EventSequence"})
    Ptr Clutter.Actor.Actor ->              -- actor : TInterface (Name {namespace = "Clutter", name = "Actor"})
    IO ()

-- | Acquires a grab on /@actor@/ for the given /@device@/ and the given touch
-- /@sequence@/.
-- 
-- Any touch event coming from /@device@/ and from /@sequence@/ will be
-- delivered to /@actor@/, bypassing the usual event delivery mechanism,
-- until the grab is released by calling
-- 'GI.Clutter.Objects.InputDevice.inputDeviceSequenceUngrab'.
-- 
-- The grab is client-side: even if the windowing system used by the Clutter
-- backend has the concept of \"device grabs\", Clutter will not use them.
-- 
-- /Since: 1.12/
inputDeviceSequenceGrab ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a, Clutter.Actor.IsActor b) =>
    a
    -- ^ /@device@/: a t'GI.Clutter.Objects.InputDevice.InputDevice'
    -> Clutter.EventSequence.EventSequence
    -- ^ /@sequence@/: a t'GI.Clutter.Structs.EventSequence.EventSequence'
    -> b
    -- ^ /@actor@/: a t'GI.Clutter.Objects.Actor.Actor'
    -> m ()
inputDeviceSequenceGrab :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsInputDevice a, IsActor b) =>
a -> EventSequence -> b -> m ()
inputDeviceSequenceGrab a
device EventSequence
sequence b
actor = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    Ptr EventSequence
sequence' <- EventSequence -> IO (Ptr EventSequence)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr EventSequence
sequence
    Ptr Actor
actor' <- b -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
actor
    Ptr InputDevice -> Ptr EventSequence -> Ptr Actor -> IO ()
clutter_input_device_sequence_grab Ptr InputDevice
device' Ptr EventSequence
sequence' Ptr Actor
actor'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    EventSequence -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr EventSequence
sequence
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
actor
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data InputDeviceSequenceGrabMethodInfo
instance (signature ~ (Clutter.EventSequence.EventSequence -> b -> m ()), MonadIO m, IsInputDevice a, Clutter.Actor.IsActor b) => O.OverloadedMethod InputDeviceSequenceGrabMethodInfo a signature where
    overloadedMethod = inputDeviceSequenceGrab

instance O.OverloadedMethodInfo InputDeviceSequenceGrabMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceSequenceGrab",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceSequenceGrab"
        })


#endif

-- method InputDevice::sequence_ungrab
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInputDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sequence"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "EventSequence" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterEventSequence"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_sequence_ungrab" clutter_input_device_sequence_ungrab :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    Ptr Clutter.EventSequence.EventSequence -> -- sequence : TInterface (Name {namespace = "Clutter", name = "EventSequence"})
    IO ()

-- | Releases the grab on the /@device@/ for the given /@sequence@/, if one is
-- in place.
-- 
-- /Since: 1.12/
inputDeviceSequenceUngrab ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Clutter.Objects.InputDevice.InputDevice'
    -> Clutter.EventSequence.EventSequence
    -- ^ /@sequence@/: a t'GI.Clutter.Structs.EventSequence.EventSequence'
    -> m ()
inputDeviceSequenceUngrab :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> EventSequence -> m ()
inputDeviceSequenceUngrab a
device EventSequence
sequence = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    Ptr EventSequence
sequence' <- EventSequence -> IO (Ptr EventSequence)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr EventSequence
sequence
    Ptr InputDevice -> Ptr EventSequence -> IO ()
clutter_input_device_sequence_ungrab Ptr InputDevice
device' Ptr EventSequence
sequence'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    EventSequence -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr EventSequence
sequence
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data InputDeviceSequenceUngrabMethodInfo
instance (signature ~ (Clutter.EventSequence.EventSequence -> m ()), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceSequenceUngrabMethodInfo a signature where
    overloadedMethod = inputDeviceSequenceUngrab

instance O.OverloadedMethodInfo InputDeviceSequenceUngrabMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceSequenceUngrab",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceSequenceUngrab"
        })


#endif

-- method InputDevice::set_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInputDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "enabled"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to enable the @device"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_set_enabled" clutter_input_device_set_enabled :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    CInt ->                                 -- enabled : TBasicType TBoolean
    IO ()

-- | Enables or disables a t'GI.Clutter.Objects.InputDevice.InputDevice'.
-- 
-- Only devices with a [InputDevice:deviceMode]("GI.Clutter.Objects.InputDevice#g:attr:deviceMode") property set
-- to 'GI.Clutter.Enums.InputModeSlave' or 'GI.Clutter.Enums.InputModeFloating' can
-- be disabled.
-- 
-- /Since: 1.6/
inputDeviceSetEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Clutter.Objects.InputDevice.InputDevice'
    -> Bool
    -- ^ /@enabled@/: 'P.True' to enable the /@device@/
    -> m ()
inputDeviceSetEnabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> Bool -> m ()
inputDeviceSetEnabled a
device Bool
enabled = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    let enabled' :: CInt
enabled' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
enabled
    Ptr InputDevice -> CInt -> IO ()
clutter_input_device_set_enabled Ptr InputDevice
device' CInt
enabled'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data InputDeviceSetEnabledMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceSetEnabledMethodInfo a signature where
    overloadedMethod = inputDeviceSetEnabled

instance O.OverloadedMethodInfo InputDeviceSetEnabledMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceSetEnabled",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceSetEnabled"
        })


#endif

-- method InputDevice::set_key
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInputDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the key"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "keyval"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the keyval" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "modifiers"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ModifierType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a bitmask of modifiers"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_set_key" clutter_input_device_set_key :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    Word32 ->                               -- index_ : TBasicType TUInt
    Word32 ->                               -- keyval : TBasicType TUInt
    CUInt ->                                -- modifiers : TInterface (Name {namespace = "Clutter", name = "ModifierType"})
    IO ()

-- | Sets the keyval and modifiers at the given /@index_@/ for /@device@/.
-- 
-- Clutter will use the keyval and modifiers set when filling out
-- an event coming from the same input device.
-- 
-- /Since: 1.6/
inputDeviceSetKey ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Clutter.Objects.InputDevice.InputDevice'
    -> Word32
    -- ^ /@index_@/: the index of the key
    -> Word32
    -- ^ /@keyval@/: the keyval
    -> [Clutter.Flags.ModifierType]
    -- ^ /@modifiers@/: a bitmask of modifiers
    -> m ()
inputDeviceSetKey :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> Word32 -> Word32 -> [ModifierType] -> m ()
inputDeviceSetKey a
device Word32
index_ Word32
keyval [ModifierType]
modifiers = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    let modifiers' :: CUInt
modifiers' = [ModifierType] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ModifierType]
modifiers
    Ptr InputDevice -> Word32 -> Word32 -> CUInt -> IO ()
clutter_input_device_set_key Ptr InputDevice
device' Word32
index_ Word32
keyval CUInt
modifiers'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data InputDeviceSetKeyMethodInfo
instance (signature ~ (Word32 -> Word32 -> [Clutter.Flags.ModifierType] -> m ()), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceSetKeyMethodInfo a signature where
    overloadedMethod = inputDeviceSetKey

instance O.OverloadedMethodInfo InputDeviceSetKeyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceSetKey",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceSetKey"
        })


#endif

-- method InputDevice::ungrab
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInputDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_ungrab" clutter_input_device_ungrab :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    IO ()

-- | Releases the grab on the /@device@/, if one is in place.
-- 
-- /Since: 1.10/
inputDeviceUngrab ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Clutter.Objects.InputDevice.InputDevice'
    -> m ()
inputDeviceUngrab :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> m ()
inputDeviceUngrab a
device = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    Ptr InputDevice -> IO ()
clutter_input_device_ungrab Ptr InputDevice
device'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data InputDeviceUngrabMethodInfo
instance (signature ~ (m ()), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceUngrabMethodInfo a signature where
    overloadedMethod = inputDeviceUngrab

instance O.OverloadedMethodInfo InputDeviceUngrabMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceUngrab",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceUngrab"
        })


#endif

-- method InputDevice::update_from_event
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "InputDevice" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInputDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "update_stage"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "whether to update the #ClutterStage of the @device\n  using the stage of the event"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_input_device_update_from_event" clutter_input_device_update_from_event :: 
    Ptr InputDevice ->                      -- device : TInterface (Name {namespace = "Clutter", name = "InputDevice"})
    Ptr Clutter.Event.Event ->              -- event : TInterface (Name {namespace = "Clutter", name = "Event"})
    CInt ->                                 -- update_stage : TBasicType TBoolean
    IO ()

-- | Forcibly updates the state of the /@device@/ using a t'GI.Clutter.Unions.Event.Event'
-- 
-- This function should never be used by applications: it is meant
-- for integration with embedding toolkits, like clutter-gtk
-- 
-- Embedding toolkits that disable the event collection inside Clutter
-- need to use this function to update the state of input devices depending
-- on a t'GI.Clutter.Unions.Event.Event' that they are going to submit to the event handling code
-- in Clutter though 'GI.Clutter.Functions.doEvent'. Since the input devices hold the state
-- that is going to be used to fill in fields like the t'GI.Clutter.Structs.ButtonEvent.ButtonEvent'
-- click count, or to emit synthesized events like 'GI.Clutter.Enums.EventTypeEnter' and
-- 'GI.Clutter.Enums.EventTypeLeave', it is necessary for embedding toolkits to also be
-- responsible of updating the input device state.
-- 
-- For instance, this might be the code to translate an embedding toolkit
-- native motion notification into a Clutter t'GI.Clutter.Structs.MotionEvent.MotionEvent' and ask
-- Clutter to process it:
-- 
-- >
-- >  ClutterEvent c_event;
-- >
-- >  translate_native_event_to_clutter (native_event, &c_event);
-- >
-- >  clutter_do_event (&c_event);
-- 
-- 
-- Before letting 'GI.Clutter.Functions.doEvent' process the event, it is necessary to call
-- 'GI.Clutter.Objects.InputDevice.inputDeviceUpdateFromEvent':
-- 
-- >
-- >  ClutterEvent c_event;
-- >  ClutterDeviceManager *manager;
-- >  ClutterInputDevice *device;
-- >
-- >  translate_native_event_to_clutter (native_event, &c_event);
-- >
-- >  // get the device manager
-- >  manager = clutter_device_manager_get_default ();
-- >
-- >  // use the default Core Pointer that Clutter backends register by default
-- >  device = clutter_device_manager_get_core_device (manager, %CLUTTER_POINTER_DEVICE);
-- >
-- >  // update the state of the input device
-- >  clutter_input_device_update_from_event (device, &c_event, FALSE);
-- >
-- >  clutter_do_event (&c_event);
-- 
-- 
-- The /@updateStage@/ boolean argument should be used when the input device
-- enters and leaves a t'GI.Clutter.Objects.Stage.Stage'; it will use the t'GI.Clutter.Objects.Stage.Stage' field
-- of the passed /@event@/ to update the stage associated to the input device.
-- 
-- /Since: 1.2/
inputDeviceUpdateFromEvent ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Clutter.Objects.InputDevice.InputDevice'
    -> Clutter.Event.Event
    -- ^ /@event@/: a t'GI.Clutter.Unions.Event.Event'
    -> Bool
    -- ^ /@updateStage@/: whether to update the t'GI.Clutter.Objects.Stage.Stage' of the /@device@/
    --   using the stage of the event
    -> m ()
inputDeviceUpdateFromEvent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputDevice a) =>
a -> Event -> Bool -> m ()
inputDeviceUpdateFromEvent a
device Event
event Bool
updateStage = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
device' <- a -> IO (Ptr InputDevice)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    let updateStage' :: CInt
updateStage' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
updateStage
    Ptr InputDevice -> Ptr Event -> CInt -> IO ()
clutter_input_device_update_from_event Ptr InputDevice
device' Ptr Event
event' CInt
updateStage'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data InputDeviceUpdateFromEventMethodInfo
instance (signature ~ (Clutter.Event.Event -> Bool -> m ()), MonadIO m, IsInputDevice a) => O.OverloadedMethod InputDeviceUpdateFromEventMethodInfo a signature where
    overloadedMethod = inputDeviceUpdateFromEvent

instance O.OverloadedMethodInfo InputDeviceUpdateFromEventMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.InputDevice.inputDeviceUpdateFromEvent",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-InputDevice.html#v:inputDeviceUpdateFromEvent"
        })


#endif