{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Clutter.Objects.GestureAction.GestureAction' structure contains
-- only private data and should be accessed using the provided API
-- 
-- /Since: 1.8/

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

module GI.Clutter.Objects.GestureAction
    ( 

-- * Exported types
    GestureAction(..)                       ,
    IsGestureAction                         ,
    toGestureAction                         ,


 -- * 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"), [cancel]("GI.Clutter.Objects.GestureAction#g:method:cancel"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [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"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getActor]("GI.Clutter.Objects.ActorMeta#g:method:getActor"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDevice]("GI.Clutter.Objects.GestureAction#g:method:getDevice"), [getEnabled]("GI.Clutter.Objects.ActorMeta#g:method:getEnabled"), [getLastEvent]("GI.Clutter.Objects.GestureAction#g:method:getLastEvent"), [getMotionCoords]("GI.Clutter.Objects.GestureAction#g:method:getMotionCoords"), [getMotionDelta]("GI.Clutter.Objects.GestureAction#g:method:getMotionDelta"), [getNCurrentPoints]("GI.Clutter.Objects.GestureAction#g:method:getNCurrentPoints"), [getNTouchPoints]("GI.Clutter.Objects.GestureAction#g:method:getNTouchPoints"), [getName]("GI.Clutter.Objects.ActorMeta#g:method:getName"), [getPressCoords]("GI.Clutter.Objects.GestureAction#g:method:getPressCoords"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getReleaseCoords]("GI.Clutter.Objects.GestureAction#g:method:getReleaseCoords"), [getSequence]("GI.Clutter.Objects.GestureAction#g:method:getSequence"), [getThresholdTriggerDistance]("GI.Clutter.Objects.GestureAction#g:method:getThresholdTriggerDistance"), [getThresholdTriggerEdge]("GI.Clutter.Objects.GestureAction#g:method:getThresholdTriggerEdge"), [getThresholdTriggerEgde]("GI.Clutter.Objects.GestureAction#g:method:getThresholdTriggerEgde"), [getVelocity]("GI.Clutter.Objects.GestureAction#g:method:getVelocity").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setEnabled]("GI.Clutter.Objects.ActorMeta#g:method:setEnabled"), [setNTouchPoints]("GI.Clutter.Objects.GestureAction#g:method:setNTouchPoints"), [setName]("GI.Clutter.Objects.ActorMeta#g:method:setName"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setThresholdTriggerDistance]("GI.Clutter.Objects.GestureAction#g:method:setThresholdTriggerDistance"), [setThresholdTriggerEdge]("GI.Clutter.Objects.GestureAction#g:method:setThresholdTriggerEdge").

#if defined(ENABLE_OVERLOADING)
    ResolveGestureActionMethod              ,
#endif

-- ** cancel #method:cancel#

#if defined(ENABLE_OVERLOADING)
    GestureActionCancelMethodInfo           ,
#endif
    gestureActionCancel                     ,


-- ** getDevice #method:getDevice#

#if defined(ENABLE_OVERLOADING)
    GestureActionGetDeviceMethodInfo        ,
#endif
    gestureActionGetDevice                  ,


-- ** getLastEvent #method:getLastEvent#

#if defined(ENABLE_OVERLOADING)
    GestureActionGetLastEventMethodInfo     ,
#endif
    gestureActionGetLastEvent               ,


-- ** getMotionCoords #method:getMotionCoords#

#if defined(ENABLE_OVERLOADING)
    GestureActionGetMotionCoordsMethodInfo  ,
#endif
    gestureActionGetMotionCoords            ,


-- ** getMotionDelta #method:getMotionDelta#

#if defined(ENABLE_OVERLOADING)
    GestureActionGetMotionDeltaMethodInfo   ,
#endif
    gestureActionGetMotionDelta             ,


-- ** getNCurrentPoints #method:getNCurrentPoints#

#if defined(ENABLE_OVERLOADING)
    GestureActionGetNCurrentPointsMethodInfo,
#endif
    gestureActionGetNCurrentPoints          ,


-- ** getNTouchPoints #method:getNTouchPoints#

#if defined(ENABLE_OVERLOADING)
    GestureActionGetNTouchPointsMethodInfo  ,
#endif
    gestureActionGetNTouchPoints            ,


-- ** getPressCoords #method:getPressCoords#

#if defined(ENABLE_OVERLOADING)
    GestureActionGetPressCoordsMethodInfo   ,
#endif
    gestureActionGetPressCoords             ,


-- ** getReleaseCoords #method:getReleaseCoords#

#if defined(ENABLE_OVERLOADING)
    GestureActionGetReleaseCoordsMethodInfo ,
#endif
    gestureActionGetReleaseCoords           ,


-- ** getSequence #method:getSequence#

#if defined(ENABLE_OVERLOADING)
    GestureActionGetSequenceMethodInfo      ,
#endif
    gestureActionGetSequence                ,


-- ** getThresholdTriggerDistance #method:getThresholdTriggerDistance#

#if defined(ENABLE_OVERLOADING)
    GestureActionGetThresholdTriggerDistanceMethodInfo,
#endif
    gestureActionGetThresholdTriggerDistance,


-- ** getThresholdTriggerEdge #method:getThresholdTriggerEdge#

#if defined(ENABLE_OVERLOADING)
    GestureActionGetThresholdTriggerEdgeMethodInfo,
#endif
    gestureActionGetThresholdTriggerEdge    ,


-- ** getThresholdTriggerEgde #method:getThresholdTriggerEgde#

#if defined(ENABLE_OVERLOADING)
    GestureActionGetThresholdTriggerEgdeMethodInfo,
#endif
    gestureActionGetThresholdTriggerEgde    ,


-- ** getVelocity #method:getVelocity#

#if defined(ENABLE_OVERLOADING)
    GestureActionGetVelocityMethodInfo      ,
#endif
    gestureActionGetVelocity                ,


-- ** new #method:new#

    gestureActionNew                        ,


-- ** setNTouchPoints #method:setNTouchPoints#

#if defined(ENABLE_OVERLOADING)
    GestureActionSetNTouchPointsMethodInfo  ,
#endif
    gestureActionSetNTouchPoints            ,


-- ** setThresholdTriggerDistance #method:setThresholdTriggerDistance#

#if defined(ENABLE_OVERLOADING)
    GestureActionSetThresholdTriggerDistanceMethodInfo,
#endif
    gestureActionSetThresholdTriggerDistance,


-- ** setThresholdTriggerEdge #method:setThresholdTriggerEdge#

#if defined(ENABLE_OVERLOADING)
    GestureActionSetThresholdTriggerEdgeMethodInfo,
#endif
    gestureActionSetThresholdTriggerEdge    ,




 -- * Properties


-- ** nTouchPoints #attr:nTouchPoints#
-- | Number of touch points to trigger a gesture action.
-- 
-- /Since: 1.16/

#if defined(ENABLE_OVERLOADING)
    GestureActionNTouchPointsPropertyInfo   ,
#endif
    constructGestureActionNTouchPoints      ,
#if defined(ENABLE_OVERLOADING)
    gestureActionNTouchPoints               ,
#endif
    getGestureActionNTouchPoints            ,
    setGestureActionNTouchPoints            ,


-- ** thresholdTriggerDistanceX #attr:thresholdTriggerDistanceX#
-- | The horizontal trigger distance to be used by the action to either
-- emit the [GestureAction::gestureBegin]("GI.Clutter.Objects.GestureAction#g:signal:gestureBegin") signal or to emit
-- the [GestureAction::gestureCancel]("GI.Clutter.Objects.GestureAction#g:signal:gestureCancel") signal.
-- 
-- A negative value will be interpreted as the default drag threshold.
-- 
-- /Since: 1.18/

#if defined(ENABLE_OVERLOADING)
    GestureActionThresholdTriggerDistanceXPropertyInfo,
#endif
    constructGestureActionThresholdTriggerDistanceX,
#if defined(ENABLE_OVERLOADING)
    gestureActionThresholdTriggerDistanceX  ,
#endif
    getGestureActionThresholdTriggerDistanceX,


-- ** thresholdTriggerDistanceY #attr:thresholdTriggerDistanceY#
-- | The vertical trigger distance to be used by the action to either
-- emit the [GestureAction::gestureBegin]("GI.Clutter.Objects.GestureAction#g:signal:gestureBegin") signal or to emit
-- the [GestureAction::gestureCancel]("GI.Clutter.Objects.GestureAction#g:signal:gestureCancel") signal.
-- 
-- A negative value will be interpreted as the default drag threshold.
-- 
-- /Since: 1.18/

#if defined(ENABLE_OVERLOADING)
    GestureActionThresholdTriggerDistanceYPropertyInfo,
#endif
    constructGestureActionThresholdTriggerDistanceY,
#if defined(ENABLE_OVERLOADING)
    gestureActionThresholdTriggerDistanceY  ,
#endif
    getGestureActionThresholdTriggerDistanceY,


-- ** thresholdTriggerEdge #attr:thresholdTriggerEdge#
-- | The trigger edge to be used by the action to either emit the
-- [GestureAction::gestureBegin]("GI.Clutter.Objects.GestureAction#g:signal:gestureBegin") signal or to emit the
-- [GestureAction::gestureCancel]("GI.Clutter.Objects.GestureAction#g:signal:gestureCancel") signal.
-- 
-- /Since: 1.18/

#if defined(ENABLE_OVERLOADING)
    GestureActionThresholdTriggerEdgePropertyInfo,
#endif
    constructGestureActionThresholdTriggerEdge,
#if defined(ENABLE_OVERLOADING)
    gestureActionThresholdTriggerEdge       ,
#endif
    getGestureActionThresholdTriggerEdge    ,




 -- * Signals


-- ** gestureBegin #signal:gestureBegin#

    GestureActionGestureBeginCallback       ,
#if defined(ENABLE_OVERLOADING)
    GestureActionGestureBeginSignalInfo     ,
#endif
    afterGestureActionGestureBegin          ,
    onGestureActionGestureBegin             ,


-- ** gestureCancel #signal:gestureCancel#

    GestureActionGestureCancelCallback      ,
#if defined(ENABLE_OVERLOADING)
    GestureActionGestureCancelSignalInfo    ,
#endif
    afterGestureActionGestureCancel         ,
    onGestureActionGestureCancel            ,


-- ** gestureEnd #signal:gestureEnd#

    GestureActionGestureEndCallback         ,
#if defined(ENABLE_OVERLOADING)
    GestureActionGestureEndSignalInfo       ,
#endif
    afterGestureActionGestureEnd            ,
    onGestureActionGestureEnd               ,


-- ** gestureProgress #signal:gestureProgress#

    GestureActionGestureProgressCallback    ,
#if defined(ENABLE_OVERLOADING)
    GestureActionGestureProgressSignalInfo  ,
#endif
    afterGestureActionGestureProgress       ,
    onGestureActionGestureProgress          ,




    ) 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.Objects.Action as Clutter.Action
import {-# SOURCE #-} qualified GI.Clutter.Objects.Actor as Clutter.Actor
import {-# SOURCE #-} qualified GI.Clutter.Objects.ActorMeta as Clutter.ActorMeta
import {-# SOURCE #-} qualified GI.Clutter.Objects.InputDevice as Clutter.InputDevice
import {-# SOURCE #-} qualified GI.Clutter.Structs.EventSequence as Clutter.EventSequence
import {-# SOURCE #-} qualified GI.Clutter.Unions.Event as Clutter.Event
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "clutter_gesture_action_get_type"
    c_clutter_gesture_action_get_type :: IO B.Types.GType

instance B.Types.TypedObject GestureAction where
    glibType :: IO GType
glibType = IO GType
c_clutter_gesture_action_get_type

instance B.Types.GObject GestureAction

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

instance O.HasParentTypes GestureAction
type instance O.ParentTypes GestureAction = '[Clutter.Action.Action, Clutter.ActorMeta.ActorMeta, GObject.Object.Object]

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

-- | Convert 'GestureAction' 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 GestureAction) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_clutter_gesture_action_get_type
    gvalueSet_ :: Ptr GValue -> Maybe GestureAction -> IO ()
gvalueSet_ Ptr GValue
gv Maybe GestureAction
P.Nothing = Ptr GValue -> Ptr GestureAction -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr GestureAction
forall a. Ptr a
FP.nullPtr :: FP.Ptr GestureAction)
    gvalueSet_ Ptr GValue
gv (P.Just GestureAction
obj) = GestureAction -> (Ptr GestureAction -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr GestureAction
obj (Ptr GValue -> Ptr GestureAction -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe GestureAction)
gvalueGet_ Ptr GValue
gv = do
        Ptr GestureAction
ptr <- Ptr GValue -> IO (Ptr GestureAction)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr GestureAction)
        if Ptr GestureAction
ptr Ptr GestureAction -> Ptr GestureAction -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr GestureAction
forall a. Ptr a
FP.nullPtr
        then GestureAction -> Maybe GestureAction
forall a. a -> Maybe a
P.Just (GestureAction -> Maybe GestureAction)
-> IO GestureAction -> IO (Maybe GestureAction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr GestureAction -> GestureAction)
-> Ptr GestureAction -> IO GestureAction
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr GestureAction -> GestureAction
GestureAction Ptr GestureAction
ptr
        else Maybe GestureAction -> IO (Maybe GestureAction)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GestureAction
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveGestureActionMethod (t :: Symbol) (o :: *) :: * where
    ResolveGestureActionMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveGestureActionMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveGestureActionMethod "cancel" o = GestureActionCancelMethodInfo
    ResolveGestureActionMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveGestureActionMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveGestureActionMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveGestureActionMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveGestureActionMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveGestureActionMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveGestureActionMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveGestureActionMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveGestureActionMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveGestureActionMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveGestureActionMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveGestureActionMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveGestureActionMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveGestureActionMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveGestureActionMethod "getActor" o = Clutter.ActorMeta.ActorMetaGetActorMethodInfo
    ResolveGestureActionMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveGestureActionMethod "getDevice" o = GestureActionGetDeviceMethodInfo
    ResolveGestureActionMethod "getEnabled" o = Clutter.ActorMeta.ActorMetaGetEnabledMethodInfo
    ResolveGestureActionMethod "getLastEvent" o = GestureActionGetLastEventMethodInfo
    ResolveGestureActionMethod "getMotionCoords" o = GestureActionGetMotionCoordsMethodInfo
    ResolveGestureActionMethod "getMotionDelta" o = GestureActionGetMotionDeltaMethodInfo
    ResolveGestureActionMethod "getNCurrentPoints" o = GestureActionGetNCurrentPointsMethodInfo
    ResolveGestureActionMethod "getNTouchPoints" o = GestureActionGetNTouchPointsMethodInfo
    ResolveGestureActionMethod "getName" o = Clutter.ActorMeta.ActorMetaGetNameMethodInfo
    ResolveGestureActionMethod "getPressCoords" o = GestureActionGetPressCoordsMethodInfo
    ResolveGestureActionMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveGestureActionMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveGestureActionMethod "getReleaseCoords" o = GestureActionGetReleaseCoordsMethodInfo
    ResolveGestureActionMethod "getSequence" o = GestureActionGetSequenceMethodInfo
    ResolveGestureActionMethod "getThresholdTriggerDistance" o = GestureActionGetThresholdTriggerDistanceMethodInfo
    ResolveGestureActionMethod "getThresholdTriggerEdge" o = GestureActionGetThresholdTriggerEdgeMethodInfo
    ResolveGestureActionMethod "getThresholdTriggerEgde" o = GestureActionGetThresholdTriggerEgdeMethodInfo
    ResolveGestureActionMethod "getVelocity" o = GestureActionGetVelocityMethodInfo
    ResolveGestureActionMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveGestureActionMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveGestureActionMethod "setEnabled" o = Clutter.ActorMeta.ActorMetaSetEnabledMethodInfo
    ResolveGestureActionMethod "setNTouchPoints" o = GestureActionSetNTouchPointsMethodInfo
    ResolveGestureActionMethod "setName" o = Clutter.ActorMeta.ActorMetaSetNameMethodInfo
    ResolveGestureActionMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveGestureActionMethod "setThresholdTriggerDistance" o = GestureActionSetThresholdTriggerDistanceMethodInfo
    ResolveGestureActionMethod "setThresholdTriggerEdge" o = GestureActionSetThresholdTriggerEdgeMethodInfo
    ResolveGestureActionMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveGestureActionMethod t GestureAction, O.OverloadedMethod info GestureAction p) => OL.IsLabel t (GestureAction -> 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 ~ ResolveGestureActionMethod t GestureAction, O.OverloadedMethod info GestureAction p, R.HasField t GestureAction p) => R.HasField t GestureAction p where
    getField = O.overloadedMethod @info

#endif

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

#endif

-- signal GestureAction::gesture-begin
-- | The [gesture_begin](#g:signal:gesture_begin) signal is emitted when the t'GI.Clutter.Objects.Actor.Actor' to which
-- a t'GI.Clutter.Objects.GestureAction.GestureAction' has been applied starts receiving a gesture.
-- 
-- /Since: 1.8/
type GestureActionGestureBeginCallback =
    Clutter.Actor.Actor
    -- ^ /@actor@/: the t'GI.Clutter.Objects.Actor.Actor' attached to the /@action@/
    -> IO Bool
    -- ^ __Returns:__ 'P.True' if the gesture should start, and 'P.False' if
    --   the gesture should be ignored.

type C_GestureActionGestureBeginCallback =
    Ptr GestureAction ->                    -- object
    Ptr Clutter.Actor.Actor ->
    Ptr () ->                               -- user_data
    IO CInt

-- | Generate a function pointer callable from C code, from a `C_GestureActionGestureBeginCallback`.
foreign import ccall "wrapper"
    mk_GestureActionGestureBeginCallback :: C_GestureActionGestureBeginCallback -> IO (FunPtr C_GestureActionGestureBeginCallback)

wrap_GestureActionGestureBeginCallback :: 
    GObject a => (a -> GestureActionGestureBeginCallback) ->
    C_GestureActionGestureBeginCallback
wrap_GestureActionGestureBeginCallback :: forall a.
GObject a =>
(a -> GestureActionGestureBeginCallback)
-> C_GestureActionGestureBeginCallback
wrap_GestureActionGestureBeginCallback a -> GestureActionGestureBeginCallback
gi'cb Ptr GestureAction
gi'selfPtr Ptr Actor
actor Ptr ()
_ = do
    Actor
actor' <- ((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
actor
    Bool
result <- Ptr GestureAction -> (GestureAction -> IO Bool) -> IO Bool
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr GestureAction
gi'selfPtr ((GestureAction -> IO Bool) -> IO Bool)
-> (GestureAction -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \GestureAction
gi'self -> a -> GestureActionGestureBeginCallback
gi'cb (GestureAction -> a
forall a b. Coercible a b => a -> b
Coerce.coerce GestureAction
gi'self)  Actor
actor'
    let result' :: CInt
result' = (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
result
    CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [gestureBegin](#signal:gestureBegin) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' gestureAction #gestureBegin callback
-- @
-- 
-- 
onGestureActionGestureBegin :: (IsGestureAction a, MonadIO m) => a -> ((?self :: a) => GestureActionGestureBeginCallback) -> m SignalHandlerId
onGestureActionGestureBegin :: forall a (m :: * -> *).
(IsGestureAction a, MonadIO m) =>
a
-> ((?self::a) => GestureActionGestureBeginCallback)
-> m SignalHandlerId
onGestureActionGestureBegin a
obj (?self::a) => GestureActionGestureBeginCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> GestureActionGestureBeginCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => GestureActionGestureBeginCallback
GestureActionGestureBeginCallback
cb
    let wrapped' :: C_GestureActionGestureBeginCallback
wrapped' = (a -> GestureActionGestureBeginCallback)
-> C_GestureActionGestureBeginCallback
forall a.
GObject a =>
(a -> GestureActionGestureBeginCallback)
-> C_GestureActionGestureBeginCallback
wrap_GestureActionGestureBeginCallback a -> GestureActionGestureBeginCallback
wrapped
    FunPtr C_GestureActionGestureBeginCallback
wrapped'' <- C_GestureActionGestureBeginCallback
-> IO (FunPtr C_GestureActionGestureBeginCallback)
mk_GestureActionGestureBeginCallback C_GestureActionGestureBeginCallback
wrapped'
    a
-> Text
-> FunPtr C_GestureActionGestureBeginCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"gesture-begin" FunPtr C_GestureActionGestureBeginCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [gestureBegin](#signal:gestureBegin) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' gestureAction #gestureBegin callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterGestureActionGestureBegin :: (IsGestureAction a, MonadIO m) => a -> ((?self :: a) => GestureActionGestureBeginCallback) -> m SignalHandlerId
afterGestureActionGestureBegin :: forall a (m :: * -> *).
(IsGestureAction a, MonadIO m) =>
a
-> ((?self::a) => GestureActionGestureBeginCallback)
-> m SignalHandlerId
afterGestureActionGestureBegin a
obj (?self::a) => GestureActionGestureBeginCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> GestureActionGestureBeginCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => GestureActionGestureBeginCallback
GestureActionGestureBeginCallback
cb
    let wrapped' :: C_GestureActionGestureBeginCallback
wrapped' = (a -> GestureActionGestureBeginCallback)
-> C_GestureActionGestureBeginCallback
forall a.
GObject a =>
(a -> GestureActionGestureBeginCallback)
-> C_GestureActionGestureBeginCallback
wrap_GestureActionGestureBeginCallback a -> GestureActionGestureBeginCallback
wrapped
    FunPtr C_GestureActionGestureBeginCallback
wrapped'' <- C_GestureActionGestureBeginCallback
-> IO (FunPtr C_GestureActionGestureBeginCallback)
mk_GestureActionGestureBeginCallback C_GestureActionGestureBeginCallback
wrapped'
    a
-> Text
-> FunPtr C_GestureActionGestureBeginCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"gesture-begin" FunPtr C_GestureActionGestureBeginCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data GestureActionGestureBeginSignalInfo
instance SignalInfo GestureActionGestureBeginSignalInfo where
    type HaskellCallbackType GestureActionGestureBeginSignalInfo = GestureActionGestureBeginCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_GestureActionGestureBeginCallback cb
        cb'' <- mk_GestureActionGestureBeginCallback cb'
        connectSignalFunPtr obj "gesture-begin" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.GestureAction::gesture-begin"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-GestureAction.html#g:signal:gestureBegin"})

#endif

-- signal GestureAction::gesture-cancel
-- | The [gestureCancel](#g:signal:gestureCancel) signal is emitted when the ongoing gesture gets
-- cancelled from the [GestureAction::gestureProgress]("GI.Clutter.Objects.GestureAction#g:signal:gestureProgress") signal handler.
-- 
-- This signal is emitted if and only if the [GestureAction::gestureBegin]("GI.Clutter.Objects.GestureAction#g:signal:gestureBegin")
-- signal has been emitted first.
-- 
-- /Since: 1.8/
type GestureActionGestureCancelCallback =
    Clutter.Actor.Actor
    -- ^ /@actor@/: the t'GI.Clutter.Objects.Actor.Actor' attached to the /@action@/
    -> IO ()

type C_GestureActionGestureCancelCallback =
    Ptr GestureAction ->                    -- object
    Ptr Clutter.Actor.Actor ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_GestureActionGestureCancelCallback`.
foreign import ccall "wrapper"
    mk_GestureActionGestureCancelCallback :: C_GestureActionGestureCancelCallback -> IO (FunPtr C_GestureActionGestureCancelCallback)

wrap_GestureActionGestureCancelCallback :: 
    GObject a => (a -> GestureActionGestureCancelCallback) ->
    C_GestureActionGestureCancelCallback
wrap_GestureActionGestureCancelCallback :: forall a.
GObject a =>
(a -> GestureActionGestureCancelCallback)
-> C_GestureActionGestureCancelCallback
wrap_GestureActionGestureCancelCallback a -> GestureActionGestureCancelCallback
gi'cb Ptr GestureAction
gi'selfPtr Ptr Actor
actor Ptr ()
_ = do
    Actor
actor' <- ((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
actor
    Ptr GestureAction -> (GestureAction -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr GestureAction
gi'selfPtr ((GestureAction -> IO ()) -> IO ())
-> (GestureAction -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \GestureAction
gi'self -> a -> GestureActionGestureCancelCallback
gi'cb (GestureAction -> a
forall a b. Coercible a b => a -> b
Coerce.coerce GestureAction
gi'self)  Actor
actor'


-- | Connect a signal handler for the [gestureCancel](#signal:gestureCancel) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' gestureAction #gestureCancel callback
-- @
-- 
-- 
onGestureActionGestureCancel :: (IsGestureAction a, MonadIO m) => a -> ((?self :: a) => GestureActionGestureCancelCallback) -> m SignalHandlerId
onGestureActionGestureCancel :: forall a (m :: * -> *).
(IsGestureAction a, MonadIO m) =>
a
-> ((?self::a) => GestureActionGestureCancelCallback)
-> m SignalHandlerId
onGestureActionGestureCancel a
obj (?self::a) => GestureActionGestureCancelCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> GestureActionGestureCancelCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => GestureActionGestureCancelCallback
GestureActionGestureCancelCallback
cb
    let wrapped' :: C_GestureActionGestureCancelCallback
wrapped' = (a -> GestureActionGestureCancelCallback)
-> C_GestureActionGestureCancelCallback
forall a.
GObject a =>
(a -> GestureActionGestureCancelCallback)
-> C_GestureActionGestureCancelCallback
wrap_GestureActionGestureCancelCallback a -> GestureActionGestureCancelCallback
wrapped
    FunPtr C_GestureActionGestureCancelCallback
wrapped'' <- C_GestureActionGestureCancelCallback
-> IO (FunPtr C_GestureActionGestureCancelCallback)
mk_GestureActionGestureCancelCallback C_GestureActionGestureCancelCallback
wrapped'
    a
-> Text
-> FunPtr C_GestureActionGestureCancelCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"gesture-cancel" FunPtr C_GestureActionGestureCancelCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [gestureCancel](#signal:gestureCancel) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' gestureAction #gestureCancel callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterGestureActionGestureCancel :: (IsGestureAction a, MonadIO m) => a -> ((?self :: a) => GestureActionGestureCancelCallback) -> m SignalHandlerId
afterGestureActionGestureCancel :: forall a (m :: * -> *).
(IsGestureAction a, MonadIO m) =>
a
-> ((?self::a) => GestureActionGestureCancelCallback)
-> m SignalHandlerId
afterGestureActionGestureCancel a
obj (?self::a) => GestureActionGestureCancelCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> GestureActionGestureCancelCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => GestureActionGestureCancelCallback
GestureActionGestureCancelCallback
cb
    let wrapped' :: C_GestureActionGestureCancelCallback
wrapped' = (a -> GestureActionGestureCancelCallback)
-> C_GestureActionGestureCancelCallback
forall a.
GObject a =>
(a -> GestureActionGestureCancelCallback)
-> C_GestureActionGestureCancelCallback
wrap_GestureActionGestureCancelCallback a -> GestureActionGestureCancelCallback
wrapped
    FunPtr C_GestureActionGestureCancelCallback
wrapped'' <- C_GestureActionGestureCancelCallback
-> IO (FunPtr C_GestureActionGestureCancelCallback)
mk_GestureActionGestureCancelCallback C_GestureActionGestureCancelCallback
wrapped'
    a
-> Text
-> FunPtr C_GestureActionGestureCancelCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"gesture-cancel" FunPtr C_GestureActionGestureCancelCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data GestureActionGestureCancelSignalInfo
instance SignalInfo GestureActionGestureCancelSignalInfo where
    type HaskellCallbackType GestureActionGestureCancelSignalInfo = GestureActionGestureCancelCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_GestureActionGestureCancelCallback cb
        cb'' <- mk_GestureActionGestureCancelCallback cb'
        connectSignalFunPtr obj "gesture-cancel" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.GestureAction::gesture-cancel"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-GestureAction.html#g:signal:gestureCancel"})

#endif

-- signal GestureAction::gesture-end
-- | The [gestureEnd](#g:signal:gestureEnd) signal is emitted at the end of the gesture gesture,
-- when the pointer\'s button is released
-- 
-- This signal is emitted if and only if the [GestureAction::gestureBegin]("GI.Clutter.Objects.GestureAction#g:signal:gestureBegin")
-- signal has been emitted first.
-- 
-- /Since: 1.8/
type GestureActionGestureEndCallback =
    Clutter.Actor.Actor
    -- ^ /@actor@/: the t'GI.Clutter.Objects.Actor.Actor' attached to the /@action@/
    -> IO ()

type C_GestureActionGestureEndCallback =
    Ptr GestureAction ->                    -- object
    Ptr Clutter.Actor.Actor ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_GestureActionGestureEndCallback`.
foreign import ccall "wrapper"
    mk_GestureActionGestureEndCallback :: C_GestureActionGestureEndCallback -> IO (FunPtr C_GestureActionGestureEndCallback)

wrap_GestureActionGestureEndCallback :: 
    GObject a => (a -> GestureActionGestureEndCallback) ->
    C_GestureActionGestureEndCallback
wrap_GestureActionGestureEndCallback :: forall a.
GObject a =>
(a -> GestureActionGestureCancelCallback)
-> C_GestureActionGestureCancelCallback
wrap_GestureActionGestureEndCallback a -> GestureActionGestureCancelCallback
gi'cb Ptr GestureAction
gi'selfPtr Ptr Actor
actor Ptr ()
_ = do
    Actor
actor' <- ((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
actor
    Ptr GestureAction -> (GestureAction -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr GestureAction
gi'selfPtr ((GestureAction -> IO ()) -> IO ())
-> (GestureAction -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \GestureAction
gi'self -> a -> GestureActionGestureCancelCallback
gi'cb (GestureAction -> a
forall a b. Coercible a b => a -> b
Coerce.coerce GestureAction
gi'self)  Actor
actor'


-- | Connect a signal handler for the [gestureEnd](#signal:gestureEnd) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' gestureAction #gestureEnd callback
-- @
-- 
-- 
onGestureActionGestureEnd :: (IsGestureAction a, MonadIO m) => a -> ((?self :: a) => GestureActionGestureEndCallback) -> m SignalHandlerId
onGestureActionGestureEnd :: forall a (m :: * -> *).
(IsGestureAction a, MonadIO m) =>
a
-> ((?self::a) => GestureActionGestureCancelCallback)
-> m SignalHandlerId
onGestureActionGestureEnd a
obj (?self::a) => GestureActionGestureCancelCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> GestureActionGestureCancelCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => GestureActionGestureCancelCallback
GestureActionGestureCancelCallback
cb
    let wrapped' :: C_GestureActionGestureCancelCallback
wrapped' = (a -> GestureActionGestureCancelCallback)
-> C_GestureActionGestureCancelCallback
forall a.
GObject a =>
(a -> GestureActionGestureCancelCallback)
-> C_GestureActionGestureCancelCallback
wrap_GestureActionGestureEndCallback a -> GestureActionGestureCancelCallback
wrapped
    FunPtr C_GestureActionGestureCancelCallback
wrapped'' <- C_GestureActionGestureCancelCallback
-> IO (FunPtr C_GestureActionGestureCancelCallback)
mk_GestureActionGestureEndCallback C_GestureActionGestureCancelCallback
wrapped'
    a
-> Text
-> FunPtr C_GestureActionGestureCancelCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"gesture-end" FunPtr C_GestureActionGestureCancelCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [gestureEnd](#signal:gestureEnd) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' gestureAction #gestureEnd callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterGestureActionGestureEnd :: (IsGestureAction a, MonadIO m) => a -> ((?self :: a) => GestureActionGestureEndCallback) -> m SignalHandlerId
afterGestureActionGestureEnd :: forall a (m :: * -> *).
(IsGestureAction a, MonadIO m) =>
a
-> ((?self::a) => GestureActionGestureCancelCallback)
-> m SignalHandlerId
afterGestureActionGestureEnd a
obj (?self::a) => GestureActionGestureCancelCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> GestureActionGestureCancelCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => GestureActionGestureCancelCallback
GestureActionGestureCancelCallback
cb
    let wrapped' :: C_GestureActionGestureCancelCallback
wrapped' = (a -> GestureActionGestureCancelCallback)
-> C_GestureActionGestureCancelCallback
forall a.
GObject a =>
(a -> GestureActionGestureCancelCallback)
-> C_GestureActionGestureCancelCallback
wrap_GestureActionGestureEndCallback a -> GestureActionGestureCancelCallback
wrapped
    FunPtr C_GestureActionGestureCancelCallback
wrapped'' <- C_GestureActionGestureCancelCallback
-> IO (FunPtr C_GestureActionGestureCancelCallback)
mk_GestureActionGestureEndCallback C_GestureActionGestureCancelCallback
wrapped'
    a
-> Text
-> FunPtr C_GestureActionGestureCancelCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"gesture-end" FunPtr C_GestureActionGestureCancelCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data GestureActionGestureEndSignalInfo
instance SignalInfo GestureActionGestureEndSignalInfo where
    type HaskellCallbackType GestureActionGestureEndSignalInfo = GestureActionGestureEndCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_GestureActionGestureEndCallback cb
        cb'' <- mk_GestureActionGestureEndCallback cb'
        connectSignalFunPtr obj "gesture-end" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.GestureAction::gesture-end"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-GestureAction.html#g:signal:gestureEnd"})

#endif

-- signal GestureAction::gesture-progress
-- | The [gestureProgress](#g:signal:gestureProgress) signal is emitted for each motion event after
-- the [GestureAction::gestureBegin]("GI.Clutter.Objects.GestureAction#g:signal:gestureBegin") signal has been emitted.
-- 
-- /Since: 1.8/
type GestureActionGestureProgressCallback =
    Clutter.Actor.Actor
    -- ^ /@actor@/: the t'GI.Clutter.Objects.Actor.Actor' attached to the /@action@/
    -> IO Bool
    -- ^ __Returns:__ 'P.True' if the gesture should continue, and 'P.False' if
    --   the gesture should be cancelled.

type C_GestureActionGestureProgressCallback =
    Ptr GestureAction ->                    -- object
    Ptr Clutter.Actor.Actor ->
    Ptr () ->                               -- user_data
    IO CInt

-- | Generate a function pointer callable from C code, from a `C_GestureActionGestureProgressCallback`.
foreign import ccall "wrapper"
    mk_GestureActionGestureProgressCallback :: C_GestureActionGestureProgressCallback -> IO (FunPtr C_GestureActionGestureProgressCallback)

wrap_GestureActionGestureProgressCallback :: 
    GObject a => (a -> GestureActionGestureProgressCallback) ->
    C_GestureActionGestureProgressCallback
wrap_GestureActionGestureProgressCallback :: forall a.
GObject a =>
(a -> GestureActionGestureBeginCallback)
-> C_GestureActionGestureBeginCallback
wrap_GestureActionGestureProgressCallback a -> GestureActionGestureBeginCallback
gi'cb Ptr GestureAction
gi'selfPtr Ptr Actor
actor Ptr ()
_ = do
    Actor
actor' <- ((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
actor
    Bool
result <- Ptr GestureAction -> (GestureAction -> IO Bool) -> IO Bool
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr GestureAction
gi'selfPtr ((GestureAction -> IO Bool) -> IO Bool)
-> (GestureAction -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \GestureAction
gi'self -> a -> GestureActionGestureBeginCallback
gi'cb (GestureAction -> a
forall a b. Coercible a b => a -> b
Coerce.coerce GestureAction
gi'self)  Actor
actor'
    let result' :: CInt
result' = (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
result
    CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [gestureProgress](#signal:gestureProgress) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' gestureAction #gestureProgress callback
-- @
-- 
-- 
onGestureActionGestureProgress :: (IsGestureAction a, MonadIO m) => a -> ((?self :: a) => GestureActionGestureProgressCallback) -> m SignalHandlerId
onGestureActionGestureProgress :: forall a (m :: * -> *).
(IsGestureAction a, MonadIO m) =>
a
-> ((?self::a) => GestureActionGestureBeginCallback)
-> m SignalHandlerId
onGestureActionGestureProgress a
obj (?self::a) => GestureActionGestureBeginCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> GestureActionGestureBeginCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => GestureActionGestureBeginCallback
GestureActionGestureBeginCallback
cb
    let wrapped' :: C_GestureActionGestureBeginCallback
wrapped' = (a -> GestureActionGestureBeginCallback)
-> C_GestureActionGestureBeginCallback
forall a.
GObject a =>
(a -> GestureActionGestureBeginCallback)
-> C_GestureActionGestureBeginCallback
wrap_GestureActionGestureProgressCallback a -> GestureActionGestureBeginCallback
wrapped
    FunPtr C_GestureActionGestureBeginCallback
wrapped'' <- C_GestureActionGestureBeginCallback
-> IO (FunPtr C_GestureActionGestureBeginCallback)
mk_GestureActionGestureProgressCallback C_GestureActionGestureBeginCallback
wrapped'
    a
-> Text
-> FunPtr C_GestureActionGestureBeginCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"gesture-progress" FunPtr C_GestureActionGestureBeginCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [gestureProgress](#signal:gestureProgress) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' gestureAction #gestureProgress callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterGestureActionGestureProgress :: (IsGestureAction a, MonadIO m) => a -> ((?self :: a) => GestureActionGestureProgressCallback) -> m SignalHandlerId
afterGestureActionGestureProgress :: forall a (m :: * -> *).
(IsGestureAction a, MonadIO m) =>
a
-> ((?self::a) => GestureActionGestureBeginCallback)
-> m SignalHandlerId
afterGestureActionGestureProgress a
obj (?self::a) => GestureActionGestureBeginCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> GestureActionGestureBeginCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => GestureActionGestureBeginCallback
GestureActionGestureBeginCallback
cb
    let wrapped' :: C_GestureActionGestureBeginCallback
wrapped' = (a -> GestureActionGestureBeginCallback)
-> C_GestureActionGestureBeginCallback
forall a.
GObject a =>
(a -> GestureActionGestureBeginCallback)
-> C_GestureActionGestureBeginCallback
wrap_GestureActionGestureProgressCallback a -> GestureActionGestureBeginCallback
wrapped
    FunPtr C_GestureActionGestureBeginCallback
wrapped'' <- C_GestureActionGestureBeginCallback
-> IO (FunPtr C_GestureActionGestureBeginCallback)
mk_GestureActionGestureProgressCallback C_GestureActionGestureBeginCallback
wrapped'
    a
-> Text
-> FunPtr C_GestureActionGestureBeginCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"gesture-progress" FunPtr C_GestureActionGestureBeginCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data GestureActionGestureProgressSignalInfo
instance SignalInfo GestureActionGestureProgressSignalInfo where
    type HaskellCallbackType GestureActionGestureProgressSignalInfo = GestureActionGestureProgressCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_GestureActionGestureProgressCallback cb
        cb'' <- mk_GestureActionGestureProgressCallback cb'
        connectSignalFunPtr obj "gesture-progress" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.GestureAction::gesture-progress"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-GestureAction.html#g:signal:gestureProgress"})

#endif

-- VVV Prop "n-touch-points"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@n-touch-points@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' gestureAction #nTouchPoints
-- @
getGestureActionNTouchPoints :: (MonadIO m, IsGestureAction o) => o -> m Int32
getGestureActionNTouchPoints :: forall (m :: * -> *) o.
(MonadIO m, IsGestureAction o) =>
o -> m Int32
getGestureActionNTouchPoints 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
"n-touch-points"

-- | Set the value of the “@n-touch-points@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' gestureAction [ #nTouchPoints 'Data.GI.Base.Attributes.:=' value ]
-- @
setGestureActionNTouchPoints :: (MonadIO m, IsGestureAction o) => o -> Int32 -> m ()
setGestureActionNTouchPoints :: forall (m :: * -> *) o.
(MonadIO m, IsGestureAction o) =>
o -> Int32 -> m ()
setGestureActionNTouchPoints o
obj Int32
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 -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"n-touch-points" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@n-touch-points@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructGestureActionNTouchPoints :: (IsGestureAction o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructGestureActionNTouchPoints :: forall o (m :: * -> *).
(IsGestureAction o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructGestureActionNTouchPoints 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
"n-touch-points" Int32
val

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

-- VVV Prop "threshold-trigger-distance-x"
   -- Type: TBasicType TFloat
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@threshold-trigger-distance-x@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' gestureAction #thresholdTriggerDistanceX
-- @
getGestureActionThresholdTriggerDistanceX :: (MonadIO m, IsGestureAction o) => o -> m Float
getGestureActionThresholdTriggerDistanceX :: forall (m :: * -> *) o.
(MonadIO m, IsGestureAction o) =>
o -> m Float
getGestureActionThresholdTriggerDistanceX o
obj = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Float
forall a. GObject a => a -> String -> IO Float
B.Properties.getObjectPropertyFloat o
obj String
"threshold-trigger-distance-x"

-- | Construct a `GValueConstruct` with valid value for the “@threshold-trigger-distance-x@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructGestureActionThresholdTriggerDistanceX :: (IsGestureAction o, MIO.MonadIO m) => Float -> m (GValueConstruct o)
constructGestureActionThresholdTriggerDistanceX :: forall o (m :: * -> *).
(IsGestureAction o, MonadIO m) =>
Float -> m (GValueConstruct o)
constructGestureActionThresholdTriggerDistanceX Float
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 -> Float -> IO (GValueConstruct o)
forall o. String -> Float -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFloat String
"threshold-trigger-distance-x" Float
val

#if defined(ENABLE_OVERLOADING)
data GestureActionThresholdTriggerDistanceXPropertyInfo
instance AttrInfo GestureActionThresholdTriggerDistanceXPropertyInfo where
    type AttrAllowedOps GestureActionThresholdTriggerDistanceXPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint GestureActionThresholdTriggerDistanceXPropertyInfo = IsGestureAction
    type AttrSetTypeConstraint GestureActionThresholdTriggerDistanceXPropertyInfo = (~) Float
    type AttrTransferTypeConstraint GestureActionThresholdTriggerDistanceXPropertyInfo = (~) Float
    type AttrTransferType GestureActionThresholdTriggerDistanceXPropertyInfo = Float
    type AttrGetType GestureActionThresholdTriggerDistanceXPropertyInfo = Float
    type AttrLabel GestureActionThresholdTriggerDistanceXPropertyInfo = "threshold-trigger-distance-x"
    type AttrOrigin GestureActionThresholdTriggerDistanceXPropertyInfo = GestureAction
    attrGet = getGestureActionThresholdTriggerDistanceX
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructGestureActionThresholdTriggerDistanceX
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.GestureAction.thresholdTriggerDistanceX"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-GestureAction.html#g:attr:thresholdTriggerDistanceX"
        })
#endif

-- VVV Prop "threshold-trigger-distance-y"
   -- Type: TBasicType TFloat
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@threshold-trigger-distance-y@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' gestureAction #thresholdTriggerDistanceY
-- @
getGestureActionThresholdTriggerDistanceY :: (MonadIO m, IsGestureAction o) => o -> m Float
getGestureActionThresholdTriggerDistanceY :: forall (m :: * -> *) o.
(MonadIO m, IsGestureAction o) =>
o -> m Float
getGestureActionThresholdTriggerDistanceY o
obj = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Float
forall a. GObject a => a -> String -> IO Float
B.Properties.getObjectPropertyFloat o
obj String
"threshold-trigger-distance-y"

-- | Construct a `GValueConstruct` with valid value for the “@threshold-trigger-distance-y@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructGestureActionThresholdTriggerDistanceY :: (IsGestureAction o, MIO.MonadIO m) => Float -> m (GValueConstruct o)
constructGestureActionThresholdTriggerDistanceY :: forall o (m :: * -> *).
(IsGestureAction o, MonadIO m) =>
Float -> m (GValueConstruct o)
constructGestureActionThresholdTriggerDistanceY Float
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 -> Float -> IO (GValueConstruct o)
forall o. String -> Float -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFloat String
"threshold-trigger-distance-y" Float
val

#if defined(ENABLE_OVERLOADING)
data GestureActionThresholdTriggerDistanceYPropertyInfo
instance AttrInfo GestureActionThresholdTriggerDistanceYPropertyInfo where
    type AttrAllowedOps GestureActionThresholdTriggerDistanceYPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint GestureActionThresholdTriggerDistanceYPropertyInfo = IsGestureAction
    type AttrSetTypeConstraint GestureActionThresholdTriggerDistanceYPropertyInfo = (~) Float
    type AttrTransferTypeConstraint GestureActionThresholdTriggerDistanceYPropertyInfo = (~) Float
    type AttrTransferType GestureActionThresholdTriggerDistanceYPropertyInfo = Float
    type AttrGetType GestureActionThresholdTriggerDistanceYPropertyInfo = Float
    type AttrLabel GestureActionThresholdTriggerDistanceYPropertyInfo = "threshold-trigger-distance-y"
    type AttrOrigin GestureActionThresholdTriggerDistanceYPropertyInfo = GestureAction
    attrGet = getGestureActionThresholdTriggerDistanceY
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructGestureActionThresholdTriggerDistanceY
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.GestureAction.thresholdTriggerDistanceY"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-GestureAction.html#g:attr:thresholdTriggerDistanceY"
        })
#endif

-- VVV Prop "threshold-trigger-edge"
   -- Type: TInterface (Name {namespace = "Clutter", name = "GestureTriggerEdge"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Just False)

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

-- | Construct a `GValueConstruct` with valid value for the “@threshold-trigger-edge@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructGestureActionThresholdTriggerEdge :: (IsGestureAction o, MIO.MonadIO m) => Clutter.Enums.GestureTriggerEdge -> m (GValueConstruct o)
constructGestureActionThresholdTriggerEdge :: forall o (m :: * -> *).
(IsGestureAction o, MonadIO m) =>
GestureTriggerEdge -> m (GValueConstruct o)
constructGestureActionThresholdTriggerEdge GestureTriggerEdge
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 -> GestureTriggerEdge -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"threshold-trigger-edge" GestureTriggerEdge
val

#if defined(ENABLE_OVERLOADING)
data GestureActionThresholdTriggerEdgePropertyInfo
instance AttrInfo GestureActionThresholdTriggerEdgePropertyInfo where
    type AttrAllowedOps GestureActionThresholdTriggerEdgePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint GestureActionThresholdTriggerEdgePropertyInfo = IsGestureAction
    type AttrSetTypeConstraint GestureActionThresholdTriggerEdgePropertyInfo = (~) Clutter.Enums.GestureTriggerEdge
    type AttrTransferTypeConstraint GestureActionThresholdTriggerEdgePropertyInfo = (~) Clutter.Enums.GestureTriggerEdge
    type AttrTransferType GestureActionThresholdTriggerEdgePropertyInfo = Clutter.Enums.GestureTriggerEdge
    type AttrGetType GestureActionThresholdTriggerEdgePropertyInfo = Clutter.Enums.GestureTriggerEdge
    type AttrLabel GestureActionThresholdTriggerEdgePropertyInfo = "threshold-trigger-edge"
    type AttrOrigin GestureActionThresholdTriggerEdgePropertyInfo = GestureAction
    attrGet = getGestureActionThresholdTriggerEdge
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructGestureActionThresholdTriggerEdge
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.GestureAction.thresholdTriggerEdge"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-GestureAction.html#g:attr:thresholdTriggerEdge"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList GestureAction
type instance O.AttributeList GestureAction = GestureActionAttributeList
type GestureActionAttributeList = ('[ '("actor", Clutter.ActorMeta.ActorMetaActorPropertyInfo), '("enabled", Clutter.ActorMeta.ActorMetaEnabledPropertyInfo), '("nTouchPoints", GestureActionNTouchPointsPropertyInfo), '("name", Clutter.ActorMeta.ActorMetaNamePropertyInfo), '("thresholdTriggerDistanceX", GestureActionThresholdTriggerDistanceXPropertyInfo), '("thresholdTriggerDistanceY", GestureActionThresholdTriggerDistanceYPropertyInfo), '("thresholdTriggerEdge", GestureActionThresholdTriggerEdgePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
gestureActionNTouchPoints :: AttrLabelProxy "nTouchPoints"
gestureActionNTouchPoints = AttrLabelProxy

gestureActionThresholdTriggerDistanceX :: AttrLabelProxy "thresholdTriggerDistanceX"
gestureActionThresholdTriggerDistanceX = AttrLabelProxy

gestureActionThresholdTriggerDistanceY :: AttrLabelProxy "thresholdTriggerDistanceY"
gestureActionThresholdTriggerDistanceY = AttrLabelProxy

gestureActionThresholdTriggerEdge :: AttrLabelProxy "thresholdTriggerEdge"
gestureActionThresholdTriggerEdge = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList GestureAction = GestureActionSignalList
type GestureActionSignalList = ('[ '("gestureBegin", GestureActionGestureBeginSignalInfo), '("gestureCancel", GestureActionGestureCancelSignalInfo), '("gestureEnd", GestureActionGestureEndSignalInfo), '("gestureProgress", GestureActionGestureProgressSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method GestureAction::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Clutter" , name = "GestureAction" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_gesture_action_new" clutter_gesture_action_new :: 
    IO (Ptr GestureAction)

-- | Creates a new t'GI.Clutter.Objects.GestureAction.GestureAction' instance.
-- 
-- /Since: 1.8/
gestureActionNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m GestureAction
    -- ^ __Returns:__ the newly created t'GI.Clutter.Objects.GestureAction.GestureAction'
gestureActionNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m GestureAction
gestureActionNew  = IO GestureAction -> m GestureAction
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GestureAction -> m GestureAction)
-> IO GestureAction -> m GestureAction
forall a b. (a -> b) -> a -> b
$ do
    Ptr GestureAction
result <- IO (Ptr GestureAction)
clutter_gesture_action_new
    Text -> Ptr GestureAction -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"gestureActionNew" Ptr GestureAction
result
    GestureAction
result' <- ((ManagedPtr GestureAction -> GestureAction)
-> Ptr GestureAction -> IO GestureAction
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr GestureAction -> GestureAction
GestureAction) Ptr GestureAction
result
    GestureAction -> IO GestureAction
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GestureAction
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "clutter_gesture_action_cancel" clutter_gesture_action_cancel :: 
    Ptr GestureAction ->                    -- action : TInterface (Name {namespace = "Clutter", name = "GestureAction"})
    IO ()

-- | Cancel a t'GI.Clutter.Objects.GestureAction.GestureAction' before it begins
-- 
-- /Since: 1.12/
gestureActionCancel ::
    (B.CallStack.HasCallStack, MonadIO m, IsGestureAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.GestureAction.GestureAction'
    -> m ()
gestureActionCancel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGestureAction a) =>
a -> m ()
gestureActionCancel a
action = 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 GestureAction
action' <- a -> IO (Ptr GestureAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    Ptr GestureAction -> IO ()
clutter_gesture_action_cancel Ptr GestureAction
action'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data GestureActionCancelMethodInfo
instance (signature ~ (m ()), MonadIO m, IsGestureAction a) => O.OverloadedMethod GestureActionCancelMethodInfo a signature where
    overloadedMethod = gestureActionCancel

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


#endif

-- method GestureAction::get_device
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "GestureAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterGestureAction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "point"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the touch point index, with 0 being the first touch\n  point received by the action"
--                 , 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_gesture_action_get_device" clutter_gesture_action_get_device :: 
    Ptr GestureAction ->                    -- action : TInterface (Name {namespace = "Clutter", name = "GestureAction"})
    Word32 ->                               -- point : TBasicType TUInt
    IO (Ptr Clutter.InputDevice.InputDevice)

-- | Retrieves the t'GI.Clutter.Objects.InputDevice.InputDevice' of a touch point.
-- 
-- /Since: 1.12/
gestureActionGetDevice ::
    (B.CallStack.HasCallStack, MonadIO m, IsGestureAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.GestureAction.GestureAction'
    -> Word32
    -- ^ /@point@/: the touch point index, with 0 being the first touch
    --   point received by the action
    -> m Clutter.InputDevice.InputDevice
    -- ^ __Returns:__ the t'GI.Clutter.Objects.InputDevice.InputDevice' of a touch point.
gestureActionGetDevice :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGestureAction a) =>
a -> Word32 -> m InputDevice
gestureActionGetDevice a
action Word32
point = 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 GestureAction
action' <- a -> IO (Ptr GestureAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    Ptr InputDevice
result <- Ptr GestureAction -> Word32 -> IO (Ptr InputDevice)
clutter_gesture_action_get_device Ptr GestureAction
action' Word32
point
    Text -> Ptr InputDevice -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"gestureActionGetDevice" 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
Clutter.InputDevice.InputDevice) Ptr InputDevice
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    InputDevice -> IO InputDevice
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InputDevice
result'

#if defined(ENABLE_OVERLOADING)
data GestureActionGetDeviceMethodInfo
instance (signature ~ (Word32 -> m Clutter.InputDevice.InputDevice), MonadIO m, IsGestureAction a) => O.OverloadedMethod GestureActionGetDeviceMethodInfo a signature where
    overloadedMethod = gestureActionGetDevice

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


#endif

-- method GestureAction::get_last_event
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "GestureAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterGestureAction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "point"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "index of a point currently active"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Event" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_gesture_action_get_last_event" clutter_gesture_action_get_last_event :: 
    Ptr GestureAction ->                    -- action : TInterface (Name {namespace = "Clutter", name = "GestureAction"})
    Word32 ->                               -- point : TBasicType TUInt
    IO (Ptr Clutter.Event.Event)

-- | Retrieves a reference to the last t'GI.Clutter.Unions.Event.Event' for a touch point. Call
-- 'GI.Clutter.Unions.Event.eventCopy' if you need to store the reference somewhere.
-- 
-- /Since: 1.14/
gestureActionGetLastEvent ::
    (B.CallStack.HasCallStack, MonadIO m, IsGestureAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.GestureAction.GestureAction'
    -> Word32
    -- ^ /@point@/: index of a point currently active
    -> m Clutter.Event.Event
    -- ^ __Returns:__ the last t'GI.Clutter.Unions.Event.Event' for a touch point.
gestureActionGetLastEvent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGestureAction a) =>
a -> Word32 -> m Event
gestureActionGetLastEvent a
action Word32
point = IO Event -> m Event
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> IO Event -> m Event
forall a b. (a -> b) -> a -> b
$ do
    Ptr GestureAction
action' <- a -> IO (Ptr GestureAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    Ptr Event
result <- Ptr GestureAction -> Word32 -> IO (Ptr Event)
clutter_gesture_action_get_last_event Ptr GestureAction
action' Word32
point
    Text -> Ptr Event -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"gestureActionGetLastEvent" Ptr Event
result
    Event
result' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Event -> Event
Clutter.Event.Event) Ptr Event
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    Event -> IO Event
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result'

#if defined(ENABLE_OVERLOADING)
data GestureActionGetLastEventMethodInfo
instance (signature ~ (Word32 -> m Clutter.Event.Event), MonadIO m, IsGestureAction a) => O.OverloadedMethod GestureActionGetLastEventMethodInfo a signature where
    overloadedMethod = gestureActionGetLastEvent

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


#endif

-- method GestureAction::get_motion_coords
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "GestureAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterGestureAction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "point"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the touch point index, with 0 being the first touch\n  point received by the action"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "motion_x"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the latest motion\n  event's X coordinate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "motion_y"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the latest motion\n  event's 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_gesture_action_get_motion_coords" clutter_gesture_action_get_motion_coords :: 
    Ptr GestureAction ->                    -- action : TInterface (Name {namespace = "Clutter", name = "GestureAction"})
    Word32 ->                               -- point : TBasicType TUInt
    Ptr CFloat ->                           -- motion_x : TBasicType TFloat
    Ptr CFloat ->                           -- motion_y : TBasicType TFloat
    IO ()

-- | Retrieves the coordinates, in stage space, of the latest motion
-- event during the dragging.
-- 
-- /Since: 1.8/
gestureActionGetMotionCoords ::
    (B.CallStack.HasCallStack, MonadIO m, IsGestureAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.GestureAction.GestureAction'
    -> Word32
    -- ^ /@point@/: the touch point index, with 0 being the first touch
    --   point received by the action
    -> m ((Float, Float))
gestureActionGetMotionCoords :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGestureAction a) =>
a -> Word32 -> m (Float, Float)
gestureActionGetMotionCoords a
action Word32
point = IO (Float, Float) -> m (Float, Float)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Float, Float) -> m (Float, Float))
-> IO (Float, Float) -> m (Float, Float)
forall a b. (a -> b) -> a -> b
$ do
    Ptr GestureAction
action' <- a -> IO (Ptr GestureAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    Ptr CFloat
motionX <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr CFloat
motionY <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr GestureAction -> Word32 -> Ptr CFloat -> Ptr CFloat -> IO ()
clutter_gesture_action_get_motion_coords Ptr GestureAction
action' Word32
point Ptr CFloat
motionX Ptr CFloat
motionY
    CFloat
motionX' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
motionX
    let motionX'' :: Float
motionX'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
motionX'
    CFloat
motionY' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
motionY
    let motionY'' :: Float
motionY'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
motionY'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
motionX
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
motionY
    (Float, Float) -> IO (Float, Float)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
motionX'', Float
motionY'')

#if defined(ENABLE_OVERLOADING)
data GestureActionGetMotionCoordsMethodInfo
instance (signature ~ (Word32 -> m ((Float, Float))), MonadIO m, IsGestureAction a) => O.OverloadedMethod GestureActionGetMotionCoordsMethodInfo a signature where
    overloadedMethod = gestureActionGetMotionCoords

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


#endif

-- method GestureAction::get_motion_delta
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "GestureAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterGestureAction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "point"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the touch point index, with 0 being the first touch\n  point received by the action"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "delta_x"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the X axis\n  component of the incremental motion delta"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "delta_y"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the Y axis\n  component of the incremental motion delta"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFloat)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_gesture_action_get_motion_delta" clutter_gesture_action_get_motion_delta :: 
    Ptr GestureAction ->                    -- action : TInterface (Name {namespace = "Clutter", name = "GestureAction"})
    Word32 ->                               -- point : TBasicType TUInt
    Ptr CFloat ->                           -- delta_x : TBasicType TFloat
    Ptr CFloat ->                           -- delta_y : TBasicType TFloat
    IO CFloat

-- | Retrieves the incremental delta since the last motion event
-- during the dragging.
-- 
-- /Since: 1.12/
gestureActionGetMotionDelta ::
    (B.CallStack.HasCallStack, MonadIO m, IsGestureAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.GestureAction.GestureAction'
    -> Word32
    -- ^ /@point@/: the touch point index, with 0 being the first touch
    --   point received by the action
    -> m ((Float, Float, Float))
    -- ^ __Returns:__ the distance since last motion event
gestureActionGetMotionDelta :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGestureAction a) =>
a -> Word32 -> m (Float, Float, Float)
gestureActionGetMotionDelta a
action Word32
point = IO (Float, Float, Float) -> m (Float, Float, Float)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Float, Float, Float) -> m (Float, Float, Float))
-> IO (Float, Float, Float) -> m (Float, Float, Float)
forall a b. (a -> b) -> a -> b
$ do
    Ptr GestureAction
action' <- a -> IO (Ptr GestureAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    Ptr CFloat
deltaX <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr CFloat
deltaY <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    CFloat
result <- Ptr GestureAction
-> Word32 -> Ptr CFloat -> Ptr CFloat -> IO CFloat
clutter_gesture_action_get_motion_delta Ptr GestureAction
action' Word32
point Ptr CFloat
deltaX Ptr CFloat
deltaY
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    CFloat
deltaX' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
deltaX
    let deltaX'' :: Float
deltaX'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
deltaX'
    CFloat
deltaY' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
deltaY
    let deltaY'' :: Float
deltaY'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
deltaY'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
deltaX
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
deltaY
    (Float, Float, Float) -> IO (Float, Float, Float)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
result', Float
deltaX'', Float
deltaY'')

#if defined(ENABLE_OVERLOADING)
data GestureActionGetMotionDeltaMethodInfo
instance (signature ~ (Word32 -> m ((Float, Float, Float))), MonadIO m, IsGestureAction a) => O.OverloadedMethod GestureActionGetMotionDeltaMethodInfo a signature where
    overloadedMethod = gestureActionGetMotionDelta

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


#endif

-- method GestureAction::get_n_current_points
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "GestureAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterGestureAction"
--                 , 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_gesture_action_get_n_current_points" clutter_gesture_action_get_n_current_points :: 
    Ptr GestureAction ->                    -- action : TInterface (Name {namespace = "Clutter", name = "GestureAction"})
    IO Word32

-- | Retrieves the number of points currently active.
-- 
-- /Since: 1.12/
gestureActionGetNCurrentPoints ::
    (B.CallStack.HasCallStack, MonadIO m, IsGestureAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.GestureAction.GestureAction'
    -> m Word32
    -- ^ __Returns:__ the number of points currently active.
gestureActionGetNCurrentPoints :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGestureAction a) =>
a -> m Word32
gestureActionGetNCurrentPoints a
action = 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 GestureAction
action' <- a -> IO (Ptr GestureAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    Word32
result <- Ptr GestureAction -> IO Word32
clutter_gesture_action_get_n_current_points Ptr GestureAction
action'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data GestureActionGetNCurrentPointsMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsGestureAction a) => O.OverloadedMethod GestureActionGetNCurrentPointsMethodInfo a signature where
    overloadedMethod = gestureActionGetNCurrentPoints

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


#endif

-- method GestureAction::get_n_touch_points
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "GestureAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterGestureAction"
--                 , 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_gesture_action_get_n_touch_points" clutter_gesture_action_get_n_touch_points :: 
    Ptr GestureAction ->                    -- action : TInterface (Name {namespace = "Clutter", name = "GestureAction"})
    IO Int32

-- | Retrieves the number of requested points to trigger the gesture.
-- 
-- /Since: 1.12/
gestureActionGetNTouchPoints ::
    (B.CallStack.HasCallStack, MonadIO m, IsGestureAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.GestureAction.GestureAction'
    -> m Int32
    -- ^ __Returns:__ the number of points to trigger the gesture.
gestureActionGetNTouchPoints :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGestureAction a) =>
a -> m Int32
gestureActionGetNTouchPoints a
action = 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 GestureAction
action' <- a -> IO (Ptr GestureAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    Int32
result <- Ptr GestureAction -> IO Int32
clutter_gesture_action_get_n_touch_points Ptr GestureAction
action'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data GestureActionGetNTouchPointsMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsGestureAction a) => O.OverloadedMethod GestureActionGetNTouchPointsMethodInfo a signature where
    overloadedMethod = gestureActionGetNTouchPoints

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


#endif

-- method GestureAction::get_press_coords
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "GestureAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterGestureAction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "point"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the touch point index, with 0 being the first touch\n  point received by the action"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "press_x"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the press\n  event's X coordinate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "press_y"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the press\n  event's 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_gesture_action_get_press_coords" clutter_gesture_action_get_press_coords :: 
    Ptr GestureAction ->                    -- action : TInterface (Name {namespace = "Clutter", name = "GestureAction"})
    Word32 ->                               -- point : TBasicType TUInt
    Ptr CFloat ->                           -- press_x : TBasicType TFloat
    Ptr CFloat ->                           -- press_y : TBasicType TFloat
    IO ()

-- | Retrieves the coordinates, in stage space, of the press event
-- that started the dragging for a specific touch point.
-- 
-- /Since: 1.8/
gestureActionGetPressCoords ::
    (B.CallStack.HasCallStack, MonadIO m, IsGestureAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.GestureAction.GestureAction'
    -> Word32
    -- ^ /@point@/: the touch point index, with 0 being the first touch
    --   point received by the action
    -> m ((Float, Float))
gestureActionGetPressCoords :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGestureAction a) =>
a -> Word32 -> m (Float, Float)
gestureActionGetPressCoords a
action Word32
point = IO (Float, Float) -> m (Float, Float)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Float, Float) -> m (Float, Float))
-> IO (Float, Float) -> m (Float, Float)
forall a b. (a -> b) -> a -> b
$ do
    Ptr GestureAction
action' <- a -> IO (Ptr GestureAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    Ptr CFloat
pressX <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr CFloat
pressY <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr GestureAction -> Word32 -> Ptr CFloat -> Ptr CFloat -> IO ()
clutter_gesture_action_get_press_coords Ptr GestureAction
action' Word32
point Ptr CFloat
pressX Ptr CFloat
pressY
    CFloat
pressX' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
pressX
    let pressX'' :: Float
pressX'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
pressX'
    CFloat
pressY' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
pressY
    let pressY'' :: Float
pressY'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
pressY'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
pressX
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
pressY
    (Float, Float) -> IO (Float, Float)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
pressX'', Float
pressY'')

#if defined(ENABLE_OVERLOADING)
data GestureActionGetPressCoordsMethodInfo
instance (signature ~ (Word32 -> m ((Float, Float))), MonadIO m, IsGestureAction a) => O.OverloadedMethod GestureActionGetPressCoordsMethodInfo a signature where
    overloadedMethod = gestureActionGetPressCoords

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


#endif

-- method GestureAction::get_release_coords
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "GestureAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterGestureAction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "point"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the touch point index, with 0 being the first touch\n  point received by the action"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "release_x"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the X coordinate of\n  the last release"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "release_y"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the Y coordinate of\n  the last release"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_gesture_action_get_release_coords" clutter_gesture_action_get_release_coords :: 
    Ptr GestureAction ->                    -- action : TInterface (Name {namespace = "Clutter", name = "GestureAction"})
    Word32 ->                               -- point : TBasicType TUInt
    Ptr CFloat ->                           -- release_x : TBasicType TFloat
    Ptr CFloat ->                           -- release_y : TBasicType TFloat
    IO ()

-- | Retrieves the coordinates, in stage space, where the touch point was
-- last released.
-- 
-- /Since: 1.8/
gestureActionGetReleaseCoords ::
    (B.CallStack.HasCallStack, MonadIO m, IsGestureAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.GestureAction.GestureAction'
    -> Word32
    -- ^ /@point@/: the touch point index, with 0 being the first touch
    --   point received by the action
    -> m ((Float, Float))
gestureActionGetReleaseCoords :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGestureAction a) =>
a -> Word32 -> m (Float, Float)
gestureActionGetReleaseCoords a
action Word32
point = IO (Float, Float) -> m (Float, Float)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Float, Float) -> m (Float, Float))
-> IO (Float, Float) -> m (Float, Float)
forall a b. (a -> b) -> a -> b
$ do
    Ptr GestureAction
action' <- a -> IO (Ptr GestureAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    Ptr CFloat
releaseX <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr CFloat
releaseY <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr GestureAction -> Word32 -> Ptr CFloat -> Ptr CFloat -> IO ()
clutter_gesture_action_get_release_coords Ptr GestureAction
action' Word32
point Ptr CFloat
releaseX Ptr CFloat
releaseY
    CFloat
releaseX' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
releaseX
    let releaseX'' :: Float
releaseX'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
releaseX'
    CFloat
releaseY' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
releaseY
    let releaseY'' :: Float
releaseY'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
releaseY'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
releaseX
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
releaseY
    (Float, Float) -> IO (Float, Float)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
releaseX'', Float
releaseY'')

#if defined(ENABLE_OVERLOADING)
data GestureActionGetReleaseCoordsMethodInfo
instance (signature ~ (Word32 -> m ((Float, Float))), MonadIO m, IsGestureAction a) => O.OverloadedMethod GestureActionGetReleaseCoordsMethodInfo a signature where
    overloadedMethod = gestureActionGetReleaseCoords

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


#endif

-- method GestureAction::get_sequence
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "GestureAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterGestureAction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "point"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "index of a point currently active"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Clutter" , name = "EventSequence" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_gesture_action_get_sequence" clutter_gesture_action_get_sequence :: 
    Ptr GestureAction ->                    -- action : TInterface (Name {namespace = "Clutter", name = "GestureAction"})
    Word32 ->                               -- point : TBasicType TUInt
    IO (Ptr Clutter.EventSequence.EventSequence)

-- | Retrieves the t'GI.Clutter.Structs.EventSequence.EventSequence' of a touch point.
-- 
-- /Since: 1.12/
gestureActionGetSequence ::
    (B.CallStack.HasCallStack, MonadIO m, IsGestureAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.GestureAction.GestureAction'
    -> Word32
    -- ^ /@point@/: index of a point currently active
    -> m Clutter.EventSequence.EventSequence
    -- ^ __Returns:__ the t'GI.Clutter.Structs.EventSequence.EventSequence' of a touch point.
gestureActionGetSequence :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGestureAction a) =>
a -> Word32 -> m EventSequence
gestureActionGetSequence a
action Word32
point = IO EventSequence -> m EventSequence
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EventSequence -> m EventSequence)
-> IO EventSequence -> m EventSequence
forall a b. (a -> b) -> a -> b
$ do
    Ptr GestureAction
action' <- a -> IO (Ptr GestureAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    Ptr EventSequence
result <- Ptr GestureAction -> Word32 -> IO (Ptr EventSequence)
clutter_gesture_action_get_sequence Ptr GestureAction
action' Word32
point
    Text -> Ptr EventSequence -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"gestureActionGetSequence" Ptr EventSequence
result
    EventSequence
result' <- ((ManagedPtr EventSequence -> EventSequence)
-> Ptr EventSequence -> IO EventSequence
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr EventSequence -> EventSequence
Clutter.EventSequence.EventSequence) Ptr EventSequence
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    EventSequence -> IO EventSequence
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return EventSequence
result'

#if defined(ENABLE_OVERLOADING)
data GestureActionGetSequenceMethodInfo
instance (signature ~ (Word32 -> m Clutter.EventSequence.EventSequence), MonadIO m, IsGestureAction a) => O.OverloadedMethod GestureActionGetSequenceMethodInfo a signature where
    overloadedMethod = gestureActionGetSequence

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


#endif

-- method GestureAction::get_threshold_trigger_distance
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "GestureAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterGestureAction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The return location for the horizontal distance, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The return location for the vertical distance, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_gesture_action_get_threshold_trigger_distance" clutter_gesture_action_get_threshold_trigger_distance :: 
    Ptr GestureAction ->                    -- action : TInterface (Name {namespace = "Clutter", name = "GestureAction"})
    Ptr CFloat ->                           -- x : TBasicType TFloat
    Ptr CFloat ->                           -- y : TBasicType TFloat
    IO ()

-- | Retrieves the threshold trigger distance of the gesture /@action@/,
-- as set using 'GI.Clutter.Objects.GestureAction.gestureActionSetThresholdTriggerDistance'.
-- 
-- /Since: 1.18/
gestureActionGetThresholdTriggerDistance ::
    (B.CallStack.HasCallStack, MonadIO m, IsGestureAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.GestureAction.GestureAction'
    -> m ((Float, Float))
gestureActionGetThresholdTriggerDistance :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGestureAction a) =>
a -> m (Float, Float)
gestureActionGetThresholdTriggerDistance a
action = IO (Float, Float) -> m (Float, Float)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Float, Float) -> m (Float, Float))
-> IO (Float, Float) -> m (Float, Float)
forall a b. (a -> b) -> a -> b
$ do
    Ptr GestureAction
action' <- a -> IO (Ptr GestureAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    Ptr CFloat
x <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr CFloat
y <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr GestureAction -> Ptr CFloat -> Ptr CFloat -> IO ()
clutter_gesture_action_get_threshold_trigger_distance Ptr GestureAction
action' Ptr CFloat
x Ptr CFloat
y
    CFloat
x' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
x
    let x'' :: Float
x'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
x'
    CFloat
y' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
y
    let y'' :: Float
y'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
y'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
x
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
y
    (Float, Float) -> IO (Float, Float)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
x'', Float
y'')

#if defined(ENABLE_OVERLOADING)
data GestureActionGetThresholdTriggerDistanceMethodInfo
instance (signature ~ (m ((Float, Float))), MonadIO m, IsGestureAction a) => O.OverloadedMethod GestureActionGetThresholdTriggerDistanceMethodInfo a signature where
    overloadedMethod = gestureActionGetThresholdTriggerDistance

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


#endif

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

foreign import ccall "clutter_gesture_action_get_threshold_trigger_edge" clutter_gesture_action_get_threshold_trigger_edge :: 
    Ptr GestureAction ->                    -- action : TInterface (Name {namespace = "Clutter", name = "GestureAction"})
    IO CUInt

-- | Retrieves the edge trigger of the gesture /@action@/, as set using
-- 'GI.Clutter.Objects.GestureAction.gestureActionSetThresholdTriggerEdge'.
-- 
-- /Since: 1.20/
gestureActionGetThresholdTriggerEdge ::
    (B.CallStack.HasCallStack, MonadIO m, IsGestureAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.GestureAction.GestureAction'
    -> m Clutter.Enums.GestureTriggerEdge
    -- ^ __Returns:__ the edge trigger
gestureActionGetThresholdTriggerEdge :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGestureAction a) =>
a -> m GestureTriggerEdge
gestureActionGetThresholdTriggerEdge a
action = IO GestureTriggerEdge -> m GestureTriggerEdge
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GestureTriggerEdge -> m GestureTriggerEdge)
-> IO GestureTriggerEdge -> m GestureTriggerEdge
forall a b. (a -> b) -> a -> b
$ do
    Ptr GestureAction
action' <- a -> IO (Ptr GestureAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    CUInt
result <- Ptr GestureAction -> IO CUInt
clutter_gesture_action_get_threshold_trigger_edge Ptr GestureAction
action'
    let result' :: GestureTriggerEdge
result' = (Int -> GestureTriggerEdge
forall a. Enum a => Int -> a
toEnum (Int -> GestureTriggerEdge)
-> (CUInt -> Int) -> CUInt -> GestureTriggerEdge
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
action
    GestureTriggerEdge -> IO GestureTriggerEdge
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GestureTriggerEdge
result'

#if defined(ENABLE_OVERLOADING)
data GestureActionGetThresholdTriggerEdgeMethodInfo
instance (signature ~ (m Clutter.Enums.GestureTriggerEdge), MonadIO m, IsGestureAction a) => O.OverloadedMethod GestureActionGetThresholdTriggerEdgeMethodInfo a signature where
    overloadedMethod = gestureActionGetThresholdTriggerEdge

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


#endif

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

foreign import ccall "clutter_gesture_action_get_threshold_trigger_egde" clutter_gesture_action_get_threshold_trigger_egde :: 
    Ptr GestureAction ->                    -- action : TInterface (Name {namespace = "Clutter", name = "GestureAction"})
    IO CUInt

{-# DEPRECATED gestureActionGetThresholdTriggerEgde ["(Since version 1.20)","Use 'GI.Clutter.Objects.GestureAction.gestureActionGetThresholdTriggerEdge' instead."] #-}
-- | Retrieves the edge trigger of the gesture /@action@/, as set using
-- 'GI.Clutter.Objects.GestureAction.gestureActionSetThresholdTriggerEdge'.
-- 
-- /Since: 1.18/
gestureActionGetThresholdTriggerEgde ::
    (B.CallStack.HasCallStack, MonadIO m, IsGestureAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.GestureAction.GestureAction'
    -> m Clutter.Enums.GestureTriggerEdge
    -- ^ __Returns:__ the edge trigger
gestureActionGetThresholdTriggerEgde :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGestureAction a) =>
a -> m GestureTriggerEdge
gestureActionGetThresholdTriggerEgde a
action = IO GestureTriggerEdge -> m GestureTriggerEdge
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GestureTriggerEdge -> m GestureTriggerEdge)
-> IO GestureTriggerEdge -> m GestureTriggerEdge
forall a b. (a -> b) -> a -> b
$ do
    Ptr GestureAction
action' <- a -> IO (Ptr GestureAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    CUInt
result <- Ptr GestureAction -> IO CUInt
clutter_gesture_action_get_threshold_trigger_egde Ptr GestureAction
action'
    let result' :: GestureTriggerEdge
result' = (Int -> GestureTriggerEdge
forall a. Enum a => Int -> a
toEnum (Int -> GestureTriggerEdge)
-> (CUInt -> Int) -> CUInt -> GestureTriggerEdge
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
action
    GestureTriggerEdge -> IO GestureTriggerEdge
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GestureTriggerEdge
result'

#if defined(ENABLE_OVERLOADING)
data GestureActionGetThresholdTriggerEgdeMethodInfo
instance (signature ~ (m Clutter.Enums.GestureTriggerEdge), MonadIO m, IsGestureAction a) => O.OverloadedMethod GestureActionGetThresholdTriggerEgdeMethodInfo a signature where
    overloadedMethod = gestureActionGetThresholdTriggerEgde

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


#endif

-- method GestureAction::get_velocity
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "GestureAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterGestureAction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "point"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the touch point index, with 0 being the first touch\n  point received by the action"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "velocity_x"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the latest motion\n  event's X velocity"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "velocity_y"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the latest motion\n  event's Y velocity"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFloat)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_gesture_action_get_velocity" clutter_gesture_action_get_velocity :: 
    Ptr GestureAction ->                    -- action : TInterface (Name {namespace = "Clutter", name = "GestureAction"})
    Word32 ->                               -- point : TBasicType TUInt
    Ptr CFloat ->                           -- velocity_x : TBasicType TFloat
    Ptr CFloat ->                           -- velocity_y : TBasicType TFloat
    IO CFloat

-- | Retrieves the velocity, in stage pixels per millisecond, of the
-- latest motion event during the dragging.
-- 
-- /Since: 1.12/
gestureActionGetVelocity ::
    (B.CallStack.HasCallStack, MonadIO m, IsGestureAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.GestureAction.GestureAction'
    -> Word32
    -- ^ /@point@/: the touch point index, with 0 being the first touch
    --   point received by the action
    -> m ((Float, Float, Float))
gestureActionGetVelocity :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGestureAction a) =>
a -> Word32 -> m (Float, Float, Float)
gestureActionGetVelocity a
action Word32
point = IO (Float, Float, Float) -> m (Float, Float, Float)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Float, Float, Float) -> m (Float, Float, Float))
-> IO (Float, Float, Float) -> m (Float, Float, Float)
forall a b. (a -> b) -> a -> b
$ do
    Ptr GestureAction
action' <- a -> IO (Ptr GestureAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    Ptr CFloat
velocityX <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr CFloat
velocityY <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    CFloat
result <- Ptr GestureAction
-> Word32 -> Ptr CFloat -> Ptr CFloat -> IO CFloat
clutter_gesture_action_get_velocity Ptr GestureAction
action' Word32
point Ptr CFloat
velocityX Ptr CFloat
velocityY
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    CFloat
velocityX' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
velocityX
    let velocityX'' :: Float
velocityX'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
velocityX'
    CFloat
velocityY' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
velocityY
    let velocityY'' :: Float
velocityY'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
velocityY'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
velocityX
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
velocityY
    (Float, Float, Float) -> IO (Float, Float, Float)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
result', Float
velocityX'', Float
velocityY'')

#if defined(ENABLE_OVERLOADING)
data GestureActionGetVelocityMethodInfo
instance (signature ~ (Word32 -> m ((Float, Float, Float))), MonadIO m, IsGestureAction a) => O.OverloadedMethod GestureActionGetVelocityMethodInfo a signature where
    overloadedMethod = gestureActionGetVelocity

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


#endif

-- method GestureAction::set_n_touch_points
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "GestureAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterGestureAction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "nb_points"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a number of points" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_gesture_action_set_n_touch_points" clutter_gesture_action_set_n_touch_points :: 
    Ptr GestureAction ->                    -- action : TInterface (Name {namespace = "Clutter", name = "GestureAction"})
    Int32 ->                                -- nb_points : TBasicType TInt
    IO ()

-- | Sets the number of points needed to trigger the gesture.
-- 
-- /Since: 1.12/
gestureActionSetNTouchPoints ::
    (B.CallStack.HasCallStack, MonadIO m, IsGestureAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.GestureAction.GestureAction'
    -> Int32
    -- ^ /@nbPoints@/: a number of points
    -> m ()
gestureActionSetNTouchPoints :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGestureAction a) =>
a -> Int32 -> m ()
gestureActionSetNTouchPoints a
action Int32
nbPoints = 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 GestureAction
action' <- a -> IO (Ptr GestureAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    Ptr GestureAction -> Int32 -> IO ()
clutter_gesture_action_set_n_touch_points Ptr GestureAction
action' Int32
nbPoints
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data GestureActionSetNTouchPointsMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsGestureAction a) => O.OverloadedMethod GestureActionSetNTouchPointsMethodInfo a signature where
    overloadedMethod = gestureActionSetNTouchPoints

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


#endif

-- method GestureAction::set_threshold_trigger_distance
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "GestureAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterGestureAction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the distance on the horizontal axis"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the distance on the vertical axis"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_gesture_action_set_threshold_trigger_distance" clutter_gesture_action_set_threshold_trigger_distance :: 
    Ptr GestureAction ->                    -- action : TInterface (Name {namespace = "Clutter", name = "GestureAction"})
    CFloat ->                               -- x : TBasicType TFloat
    CFloat ->                               -- y : TBasicType TFloat
    IO ()

-- | Sets the threshold trigger distance for the gesture drag threshold, if any.
-- 
-- This function should only be called by sub-classes of
-- t'GI.Clutter.Objects.GestureAction.GestureAction' during their construction phase.
-- 
-- /Since: 1.18/
gestureActionSetThresholdTriggerDistance ::
    (B.CallStack.HasCallStack, MonadIO m, IsGestureAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.GestureAction.GestureAction'
    -> Float
    -- ^ /@x@/: the distance on the horizontal axis
    -> Float
    -- ^ /@y@/: the distance on the vertical axis
    -> m ()
gestureActionSetThresholdTriggerDistance :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGestureAction a) =>
a -> Float -> Float -> m ()
gestureActionSetThresholdTriggerDistance a
action Float
x Float
y = 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 GestureAction
action' <- a -> IO (Ptr GestureAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    let x' :: CFloat
x' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x
    let y' :: CFloat
y' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y
    Ptr GestureAction -> CFloat -> CFloat -> IO ()
clutter_gesture_action_set_threshold_trigger_distance Ptr GestureAction
action' CFloat
x' CFloat
y'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data GestureActionSetThresholdTriggerDistanceMethodInfo
instance (signature ~ (Float -> Float -> m ()), MonadIO m, IsGestureAction a) => O.OverloadedMethod GestureActionSetThresholdTriggerDistanceMethodInfo a signature where
    overloadedMethod = gestureActionSetThresholdTriggerDistance

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


#endif

-- method GestureAction::set_threshold_trigger_edge
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "GestureAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterGestureAction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "edge"
--           , argType =
--               TInterface
--                 Name { namespace = "Clutter" , name = "GestureTriggerEdge" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the %ClutterGestureTriggerEdge"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_gesture_action_set_threshold_trigger_edge" clutter_gesture_action_set_threshold_trigger_edge :: 
    Ptr GestureAction ->                    -- action : TInterface (Name {namespace = "Clutter", name = "GestureAction"})
    CUInt ->                                -- edge : TInterface (Name {namespace = "Clutter", name = "GestureTriggerEdge"})
    IO ()

-- | Sets the edge trigger for the gesture drag threshold, if any.
-- 
-- This function should only be called by sub-classes of
-- t'GI.Clutter.Objects.GestureAction.GestureAction' during their construction phase.
-- 
-- /Since: 1.18/
gestureActionSetThresholdTriggerEdge ::
    (B.CallStack.HasCallStack, MonadIO m, IsGestureAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.GestureAction.GestureAction'
    -> Clutter.Enums.GestureTriggerEdge
    -- ^ /@edge@/: the @/ClutterGestureTriggerEdge/@
    -> m ()
gestureActionSetThresholdTriggerEdge :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsGestureAction a) =>
a -> GestureTriggerEdge -> m ()
gestureActionSetThresholdTriggerEdge a
action GestureTriggerEdge
edge = 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 GestureAction
action' <- a -> IO (Ptr GestureAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    let edge' :: CUInt
edge' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (GestureTriggerEdge -> Int) -> GestureTriggerEdge -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GestureTriggerEdge -> Int
forall a. Enum a => a -> Int
fromEnum) GestureTriggerEdge
edge
    Ptr GestureAction -> CUInt -> IO ()
clutter_gesture_action_set_threshold_trigger_edge Ptr GestureAction
action' CUInt
edge'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data GestureActionSetThresholdTriggerEdgeMethodInfo
instance (signature ~ (Clutter.Enums.GestureTriggerEdge -> m ()), MonadIO m, IsGestureAction a) => O.OverloadedMethod GestureActionSetThresholdTriggerEdgeMethodInfo a signature where
    overloadedMethod = gestureActionSetThresholdTriggerEdge

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


#endif