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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Clutter.Objects.Behaviour.Behaviour'-struct contains only private data and should
-- be accessed with the functions below.
-- 
-- /Since: 0.2/

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

module GI.Clutter.Objects.Behaviour
    ( 

-- * Exported types
    Behaviour(..)                           ,
    IsBehaviour                             ,
    toBehaviour                             ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [actorsForeach]("GI.Clutter.Objects.Behaviour#g:method:actorsForeach"), [apply]("GI.Clutter.Objects.Behaviour#g:method:apply"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isApplied]("GI.Clutter.Objects.Behaviour#g:method:isApplied"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [parseCustomNode]("GI.Clutter.Interfaces.Scriptable#g:method:parseCustomNode"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [remove]("GI.Clutter.Objects.Behaviour#g:method:remove"), [removeAll]("GI.Clutter.Objects.Behaviour#g:method:removeAll"), [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
-- [getActors]("GI.Clutter.Objects.Behaviour#g:method:getActors"), [getAlpha]("GI.Clutter.Objects.Behaviour#g:method:getAlpha"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getId]("GI.Clutter.Interfaces.Scriptable#g:method:getId"), [getNActors]("GI.Clutter.Objects.Behaviour#g:method:getNActors"), [getNthActor]("GI.Clutter.Objects.Behaviour#g:method:getNthActor"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setAlpha]("GI.Clutter.Objects.Behaviour#g:method:setAlpha"), [setCustomProperty]("GI.Clutter.Interfaces.Scriptable#g:method:setCustomProperty"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setId]("GI.Clutter.Interfaces.Scriptable#g:method:setId"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveBehaviourMethod                  ,
#endif

-- ** actorsForeach #method:actorsForeach#

#if defined(ENABLE_OVERLOADING)
    BehaviourActorsForeachMethodInfo        ,
#endif
    behaviourActorsForeach                  ,


-- ** apply #method:apply#

#if defined(ENABLE_OVERLOADING)
    BehaviourApplyMethodInfo                ,
#endif
    behaviourApply                          ,


-- ** getActors #method:getActors#

#if defined(ENABLE_OVERLOADING)
    BehaviourGetActorsMethodInfo            ,
#endif
    behaviourGetActors                      ,


-- ** getAlpha #method:getAlpha#

#if defined(ENABLE_OVERLOADING)
    BehaviourGetAlphaMethodInfo             ,
#endif
    behaviourGetAlpha                       ,


-- ** getNActors #method:getNActors#

#if defined(ENABLE_OVERLOADING)
    BehaviourGetNActorsMethodInfo           ,
#endif
    behaviourGetNActors                     ,


-- ** getNthActor #method:getNthActor#

#if defined(ENABLE_OVERLOADING)
    BehaviourGetNthActorMethodInfo          ,
#endif
    behaviourGetNthActor                    ,


-- ** isApplied #method:isApplied#

#if defined(ENABLE_OVERLOADING)
    BehaviourIsAppliedMethodInfo            ,
#endif
    behaviourIsApplied                      ,


-- ** remove #method:remove#

#if defined(ENABLE_OVERLOADING)
    BehaviourRemoveMethodInfo               ,
#endif
    behaviourRemove                         ,


-- ** removeAll #method:removeAll#

#if defined(ENABLE_OVERLOADING)
    BehaviourRemoveAllMethodInfo            ,
#endif
    behaviourRemoveAll                      ,


-- ** setAlpha #method:setAlpha#

#if defined(ENABLE_OVERLOADING)
    BehaviourSetAlphaMethodInfo             ,
#endif
    behaviourSetAlpha                       ,




 -- * Properties


-- ** alpha #attr:alpha#
-- | The t'GI.Clutter.Objects.Alpha.Alpha' object used to drive this behaviour. A t'GI.Clutter.Objects.Alpha.Alpha'
-- object binds a t'GI.Clutter.Objects.Timeline.Timeline' and a function which computes a value
-- (the \"alpha\") depending on the time. Each time the alpha value changes
-- the alpha-notify virtual function is called.
-- 
-- /Since: 0.2/

#if defined(ENABLE_OVERLOADING)
    BehaviourAlphaPropertyInfo              ,
#endif
#if defined(ENABLE_OVERLOADING)
    behaviourAlpha                          ,
#endif
    constructBehaviourAlpha                 ,
    getBehaviourAlpha                       ,
    setBehaviourAlpha                       ,




 -- * Signals


-- ** applied #signal:applied#

    BehaviourAppliedCallback                ,
#if defined(ENABLE_OVERLOADING)
    BehaviourAppliedSignalInfo              ,
#endif
    afterBehaviourApplied                   ,
    onBehaviourApplied                      ,


-- ** removed #signal:removed#

    BehaviourRemovedCallback                ,
#if defined(ENABLE_OVERLOADING)
    BehaviourRemovedSignalInfo              ,
#endif
    afterBehaviourRemoved                   ,
    onBehaviourRemoved                      ,




    ) 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 qualified GI.Clutter.Callbacks as Clutter.Callbacks
import {-# SOURCE #-} qualified GI.Clutter.Interfaces.Scriptable as Clutter.Scriptable
import {-# SOURCE #-} qualified GI.Clutter.Objects.Actor as Clutter.Actor
import {-# SOURCE #-} qualified GI.Clutter.Objects.Alpha as Clutter.Alpha
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "clutter_behaviour_get_type"
    c_clutter_behaviour_get_type :: IO B.Types.GType

instance B.Types.TypedObject Behaviour where
    glibType :: IO GType
glibType = IO GType
c_clutter_behaviour_get_type

instance B.Types.GObject Behaviour

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

instance O.HasParentTypes Behaviour
type instance O.ParentTypes Behaviour = '[GObject.Object.Object, Clutter.Scriptable.Scriptable]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveBehaviourMethod (t :: Symbol) (o :: *) :: * where
    ResolveBehaviourMethod "actorsForeach" o = BehaviourActorsForeachMethodInfo
    ResolveBehaviourMethod "apply" o = BehaviourApplyMethodInfo
    ResolveBehaviourMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveBehaviourMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveBehaviourMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveBehaviourMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveBehaviourMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveBehaviourMethod "isApplied" o = BehaviourIsAppliedMethodInfo
    ResolveBehaviourMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveBehaviourMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveBehaviourMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveBehaviourMethod "parseCustomNode" o = Clutter.Scriptable.ScriptableParseCustomNodeMethodInfo
    ResolveBehaviourMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveBehaviourMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveBehaviourMethod "remove" o = BehaviourRemoveMethodInfo
    ResolveBehaviourMethod "removeAll" o = BehaviourRemoveAllMethodInfo
    ResolveBehaviourMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveBehaviourMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveBehaviourMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveBehaviourMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveBehaviourMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveBehaviourMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveBehaviourMethod "getActors" o = BehaviourGetActorsMethodInfo
    ResolveBehaviourMethod "getAlpha" o = BehaviourGetAlphaMethodInfo
    ResolveBehaviourMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveBehaviourMethod "getId" o = Clutter.Scriptable.ScriptableGetIdMethodInfo
    ResolveBehaviourMethod "getNActors" o = BehaviourGetNActorsMethodInfo
    ResolveBehaviourMethod "getNthActor" o = BehaviourGetNthActorMethodInfo
    ResolveBehaviourMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveBehaviourMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveBehaviourMethod "setAlpha" o = BehaviourSetAlphaMethodInfo
    ResolveBehaviourMethod "setCustomProperty" o = Clutter.Scriptable.ScriptableSetCustomPropertyMethodInfo
    ResolveBehaviourMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveBehaviourMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveBehaviourMethod "setId" o = Clutter.Scriptable.ScriptableSetIdMethodInfo
    ResolveBehaviourMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveBehaviourMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal Behaviour::applied
{-# DEPRECATED BehaviourAppliedCallback ["(Since version 1.6)"] #-}
-- | The [apply](#g:signal:apply) signal is emitted each time the behaviour is applied
-- to an actor.
-- 
-- /Since: 0.4/
type BehaviourAppliedCallback =
    Clutter.Actor.Actor
    -- ^ /@actor@/: the actor the behaviour was applied to.
    -> IO ()

type C_BehaviourAppliedCallback =
    Ptr Behaviour ->                        -- object
    Ptr Clutter.Actor.Actor ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_BehaviourAppliedCallback :: 
    GObject a => (a -> BehaviourAppliedCallback) ->
    C_BehaviourAppliedCallback
wrap_BehaviourAppliedCallback :: forall a.
GObject a =>
(a -> BehaviourAppliedCallback) -> C_BehaviourAppliedCallback
wrap_BehaviourAppliedCallback a -> BehaviourAppliedCallback
gi'cb Ptr Behaviour
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 Behaviour -> (Behaviour -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Behaviour
gi'selfPtr ((Behaviour -> IO ()) -> IO ()) -> (Behaviour -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Behaviour
gi'self -> a -> BehaviourAppliedCallback
gi'cb (Behaviour -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Behaviour
gi'self)  Actor
actor'


-- | Connect a signal handler for the [applied](#signal:applied) 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' behaviour #applied callback
-- @
-- 
-- 
onBehaviourApplied :: (IsBehaviour a, MonadIO m) => a -> ((?self :: a) => BehaviourAppliedCallback) -> m SignalHandlerId
onBehaviourApplied :: forall a (m :: * -> *).
(IsBehaviour a, MonadIO m) =>
a -> ((?self::a) => BehaviourAppliedCallback) -> m SignalHandlerId
onBehaviourApplied a
obj (?self::a) => BehaviourAppliedCallback
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 -> BehaviourAppliedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => BehaviourAppliedCallback
BehaviourAppliedCallback
cb
    let wrapped' :: C_BehaviourAppliedCallback
wrapped' = (a -> BehaviourAppliedCallback) -> C_BehaviourAppliedCallback
forall a.
GObject a =>
(a -> BehaviourAppliedCallback) -> C_BehaviourAppliedCallback
wrap_BehaviourAppliedCallback a -> BehaviourAppliedCallback
wrapped
    FunPtr C_BehaviourAppliedCallback
wrapped'' <- C_BehaviourAppliedCallback
-> IO (FunPtr C_BehaviourAppliedCallback)
mk_BehaviourAppliedCallback C_BehaviourAppliedCallback
wrapped'
    a
-> Text
-> FunPtr C_BehaviourAppliedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"applied" FunPtr C_BehaviourAppliedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [applied](#signal:applied) 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' behaviour #applied 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.
-- 
afterBehaviourApplied :: (IsBehaviour a, MonadIO m) => a -> ((?self :: a) => BehaviourAppliedCallback) -> m SignalHandlerId
afterBehaviourApplied :: forall a (m :: * -> *).
(IsBehaviour a, MonadIO m) =>
a -> ((?self::a) => BehaviourAppliedCallback) -> m SignalHandlerId
afterBehaviourApplied a
obj (?self::a) => BehaviourAppliedCallback
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 -> BehaviourAppliedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => BehaviourAppliedCallback
BehaviourAppliedCallback
cb
    let wrapped' :: C_BehaviourAppliedCallback
wrapped' = (a -> BehaviourAppliedCallback) -> C_BehaviourAppliedCallback
forall a.
GObject a =>
(a -> BehaviourAppliedCallback) -> C_BehaviourAppliedCallback
wrap_BehaviourAppliedCallback a -> BehaviourAppliedCallback
wrapped
    FunPtr C_BehaviourAppliedCallback
wrapped'' <- C_BehaviourAppliedCallback
-> IO (FunPtr C_BehaviourAppliedCallback)
mk_BehaviourAppliedCallback C_BehaviourAppliedCallback
wrapped'
    a
-> Text
-> FunPtr C_BehaviourAppliedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"applied" FunPtr C_BehaviourAppliedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data BehaviourAppliedSignalInfo
instance SignalInfo BehaviourAppliedSignalInfo where
    type HaskellCallbackType BehaviourAppliedSignalInfo = BehaviourAppliedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_BehaviourAppliedCallback cb
        cb'' <- mk_BehaviourAppliedCallback cb'
        connectSignalFunPtr obj "applied" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Behaviour::applied"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Behaviour.html#g:signal:applied"})

#endif

-- signal Behaviour::removed
{-# DEPRECATED BehaviourRemovedCallback ["(Since version 1.6)"] #-}
-- | The [removed](#g:signal:removed) signal is emitted each time a behaviour is not applied
-- to an actor anymore.
-- 
-- /Since: 0.4/
type BehaviourRemovedCallback =
    Clutter.Actor.Actor
    -- ^ /@actor@/: the removed actor
    -> IO ()

type C_BehaviourRemovedCallback =
    Ptr Behaviour ->                        -- object
    Ptr Clutter.Actor.Actor ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_BehaviourRemovedCallback :: 
    GObject a => (a -> BehaviourRemovedCallback) ->
    C_BehaviourRemovedCallback
wrap_BehaviourRemovedCallback :: forall a.
GObject a =>
(a -> BehaviourAppliedCallback) -> C_BehaviourAppliedCallback
wrap_BehaviourRemovedCallback a -> BehaviourAppliedCallback
gi'cb Ptr Behaviour
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 Behaviour -> (Behaviour -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Behaviour
gi'selfPtr ((Behaviour -> IO ()) -> IO ()) -> (Behaviour -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Behaviour
gi'self -> a -> BehaviourAppliedCallback
gi'cb (Behaviour -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Behaviour
gi'self)  Actor
actor'


-- | Connect a signal handler for the [removed](#signal:removed) 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' behaviour #removed callback
-- @
-- 
-- 
onBehaviourRemoved :: (IsBehaviour a, MonadIO m) => a -> ((?self :: a) => BehaviourRemovedCallback) -> m SignalHandlerId
onBehaviourRemoved :: forall a (m :: * -> *).
(IsBehaviour a, MonadIO m) =>
a -> ((?self::a) => BehaviourAppliedCallback) -> m SignalHandlerId
onBehaviourRemoved a
obj (?self::a) => BehaviourAppliedCallback
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 -> BehaviourAppliedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => BehaviourAppliedCallback
BehaviourAppliedCallback
cb
    let wrapped' :: C_BehaviourAppliedCallback
wrapped' = (a -> BehaviourAppliedCallback) -> C_BehaviourAppliedCallback
forall a.
GObject a =>
(a -> BehaviourAppliedCallback) -> C_BehaviourAppliedCallback
wrap_BehaviourRemovedCallback a -> BehaviourAppliedCallback
wrapped
    FunPtr C_BehaviourAppliedCallback
wrapped'' <- C_BehaviourAppliedCallback
-> IO (FunPtr C_BehaviourAppliedCallback)
mk_BehaviourRemovedCallback C_BehaviourAppliedCallback
wrapped'
    a
-> Text
-> FunPtr C_BehaviourAppliedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"removed" FunPtr C_BehaviourAppliedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [removed](#signal:removed) 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' behaviour #removed 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.
-- 
afterBehaviourRemoved :: (IsBehaviour a, MonadIO m) => a -> ((?self :: a) => BehaviourRemovedCallback) -> m SignalHandlerId
afterBehaviourRemoved :: forall a (m :: * -> *).
(IsBehaviour a, MonadIO m) =>
a -> ((?self::a) => BehaviourAppliedCallback) -> m SignalHandlerId
afterBehaviourRemoved a
obj (?self::a) => BehaviourAppliedCallback
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 -> BehaviourAppliedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => BehaviourAppliedCallback
BehaviourAppliedCallback
cb
    let wrapped' :: C_BehaviourAppliedCallback
wrapped' = (a -> BehaviourAppliedCallback) -> C_BehaviourAppliedCallback
forall a.
GObject a =>
(a -> BehaviourAppliedCallback) -> C_BehaviourAppliedCallback
wrap_BehaviourRemovedCallback a -> BehaviourAppliedCallback
wrapped
    FunPtr C_BehaviourAppliedCallback
wrapped'' <- C_BehaviourAppliedCallback
-> IO (FunPtr C_BehaviourAppliedCallback)
mk_BehaviourRemovedCallback C_BehaviourAppliedCallback
wrapped'
    a
-> Text
-> FunPtr C_BehaviourAppliedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"removed" FunPtr C_BehaviourAppliedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data BehaviourRemovedSignalInfo
instance SignalInfo BehaviourRemovedSignalInfo where
    type HaskellCallbackType BehaviourRemovedSignalInfo = BehaviourRemovedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_BehaviourRemovedCallback cb
        cb'' <- mk_BehaviourRemovedCallback cb'
        connectSignalFunPtr obj "removed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Behaviour::removed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Behaviour.html#g:signal:removed"})

#endif

-- VVV Prop "alpha"
   -- Type: TInterface (Name {namespace = "Clutter", name = "Alpha"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@alpha@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' behaviour [ #alpha 'Data.GI.Base.Attributes.:=' value ]
-- @
setBehaviourAlpha :: (MonadIO m, IsBehaviour o, Clutter.Alpha.IsAlpha a) => o -> a -> m ()
setBehaviourAlpha :: forall (m :: * -> *) o a.
(MonadIO m, IsBehaviour o, IsAlpha a) =>
o -> a -> m ()
setBehaviourAlpha o
obj a
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 -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"alpha" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

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

#if defined(ENABLE_OVERLOADING)
data BehaviourAlphaPropertyInfo
instance AttrInfo BehaviourAlphaPropertyInfo where
    type AttrAllowedOps BehaviourAlphaPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint BehaviourAlphaPropertyInfo = IsBehaviour
    type AttrSetTypeConstraint BehaviourAlphaPropertyInfo = Clutter.Alpha.IsAlpha
    type AttrTransferTypeConstraint BehaviourAlphaPropertyInfo = Clutter.Alpha.IsAlpha
    type AttrTransferType BehaviourAlphaPropertyInfo = Clutter.Alpha.Alpha
    type AttrGetType BehaviourAlphaPropertyInfo = Clutter.Alpha.Alpha
    type AttrLabel BehaviourAlphaPropertyInfo = "alpha"
    type AttrOrigin BehaviourAlphaPropertyInfo = Behaviour
    attrGet = getBehaviourAlpha
    attrSet = setBehaviourAlpha
    attrTransfer _ v = do
        unsafeCastTo Clutter.Alpha.Alpha v
    attrConstruct = constructBehaviourAlpha
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Behaviour.alpha"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Behaviour.html#g:attr:alpha"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Behaviour
type instance O.AttributeList Behaviour = BehaviourAttributeList
type BehaviourAttributeList = ('[ '("alpha", BehaviourAlphaPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
behaviourAlpha :: AttrLabelProxy "alpha"
behaviourAlpha = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Behaviour = BehaviourSignalList
type BehaviourSignalList = ('[ '("applied", BehaviourAppliedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("removed", BehaviourRemovedSignalInfo)] :: [(Symbol, *)])

#endif

-- method Behaviour::actors_foreach
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "behave"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Behaviour" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterBehaviour"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface
--                 Name { namespace = "Clutter" , name = "BehaviourForeachFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a function called for each actor"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional data to be passed to the function, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_behaviour_actors_foreach" clutter_behaviour_actors_foreach :: 
    Ptr Behaviour ->                        -- behave : TInterface (Name {namespace = "Clutter", name = "Behaviour"})
    FunPtr Clutter.Callbacks.C_BehaviourForeachFunc -> -- func : TInterface (Name {namespace = "Clutter", name = "BehaviourForeachFunc"})
    Ptr () ->                               -- data : TBasicType TPtr
    IO ()

{-# DEPRECATED behaviourActorsForeach ["(Since version 1.6)"] #-}
-- | Calls /@func@/ for every actor driven by /@behave@/.
-- 
-- /Since: 0.2/
behaviourActorsForeach ::
    (B.CallStack.HasCallStack, MonadIO m, IsBehaviour a) =>
    a
    -- ^ /@behave@/: a t'GI.Clutter.Objects.Behaviour.Behaviour'
    -> Clutter.Callbacks.BehaviourForeachFunc
    -- ^ /@func@/: a function called for each actor
    -> m ()
behaviourActorsForeach :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBehaviour a) =>
a -> BehaviourForeachFunc -> m ()
behaviourActorsForeach a
behave BehaviourForeachFunc
func = 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 Behaviour
behave' <- a -> IO (Ptr Behaviour)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
behave
    FunPtr C_BehaviourAppliedCallback
func' <- C_BehaviourAppliedCallback
-> IO (FunPtr C_BehaviourAppliedCallback)
Clutter.Callbacks.mk_BehaviourForeachFunc (Maybe (Ptr (FunPtr C_BehaviourAppliedCallback))
-> BehaviourForeachFunc_WithClosures -> C_BehaviourAppliedCallback
Clutter.Callbacks.wrap_BehaviourForeachFunc Maybe (Ptr (FunPtr C_BehaviourAppliedCallback))
forall a. Maybe a
Nothing (BehaviourForeachFunc -> BehaviourForeachFunc_WithClosures
Clutter.Callbacks.drop_closures_BehaviourForeachFunc BehaviourForeachFunc
func))
    let data_ :: Ptr a
data_ = Ptr a
forall a. Ptr a
nullPtr
    Ptr Behaviour
-> FunPtr C_BehaviourAppliedCallback -> Ptr () -> IO ()
clutter_behaviour_actors_foreach Ptr Behaviour
behave' FunPtr C_BehaviourAppliedCallback
func' Ptr ()
forall a. Ptr a
data_
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_BehaviourAppliedCallback -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_BehaviourAppliedCallback
func'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
behave
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BehaviourActorsForeachMethodInfo
instance (signature ~ (Clutter.Callbacks.BehaviourForeachFunc -> m ()), MonadIO m, IsBehaviour a) => O.OverloadedMethod BehaviourActorsForeachMethodInfo a signature where
    overloadedMethod = behaviourActorsForeach

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


#endif

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

foreign import ccall "clutter_behaviour_apply" clutter_behaviour_apply :: 
    Ptr Behaviour ->                        -- behave : TInterface (Name {namespace = "Clutter", name = "Behaviour"})
    Ptr Clutter.Actor.Actor ->              -- actor : TInterface (Name {namespace = "Clutter", name = "Actor"})
    IO ()

{-# DEPRECATED behaviourApply ["(Since version 1.6)"] #-}
-- | Applies /@behave@/ to /@actor@/.  This function adds a reference on
-- the actor.
-- 
-- /Since: 0.2/
behaviourApply ::
    (B.CallStack.HasCallStack, MonadIO m, IsBehaviour a, Clutter.Actor.IsActor b) =>
    a
    -- ^ /@behave@/: a t'GI.Clutter.Objects.Behaviour.Behaviour'
    -> b
    -- ^ /@actor@/: a t'GI.Clutter.Objects.Actor.Actor'
    -> m ()
behaviourApply :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsBehaviour a, IsActor b) =>
a -> b -> m ()
behaviourApply a
behave b
actor = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Behaviour
behave' <- a -> IO (Ptr Behaviour)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
behave
    Ptr Actor
actor' <- b -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
actor
    Ptr Behaviour -> Ptr Actor -> IO ()
clutter_behaviour_apply Ptr Behaviour
behave' Ptr Actor
actor'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
behave
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
actor
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

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

foreign import ccall "clutter_behaviour_get_actors" clutter_behaviour_get_actors :: 
    Ptr Behaviour ->                        -- behave : TInterface (Name {namespace = "Clutter", name = "Behaviour"})
    IO (Ptr (GSList (Ptr Clutter.Actor.Actor)))

{-# DEPRECATED behaviourGetActors ["(Since version 1.6)"] #-}
-- | Retrieves all the actors to which /@behave@/ applies. It is not recommended
-- for derived classes to use this in there alpha notify method but use
-- @/clutter_behaviour_actors_foreach/@ as it avoids alot of needless allocations.
-- 
-- /Since: 0.2/
behaviourGetActors ::
    (B.CallStack.HasCallStack, MonadIO m, IsBehaviour a) =>
    a
    -- ^ /@behave@/: a t'GI.Clutter.Objects.Behaviour.Behaviour'
    -> m [Clutter.Actor.Actor]
    -- ^ __Returns:__ a list of
    --   actors. You should free the returned list with @/g_slist_free()/@ when
    --   finished using it.
behaviourGetActors :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBehaviour a) =>
a -> m [Actor]
behaviourGetActors a
behave = IO [Actor] -> m [Actor]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Actor] -> m [Actor]) -> IO [Actor] -> m [Actor]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Behaviour
behave' <- a -> IO (Ptr Behaviour)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
behave
    Ptr (GSList (Ptr Actor))
result <- Ptr Behaviour -> IO (Ptr (GSList (Ptr Actor)))
clutter_behaviour_get_actors Ptr Behaviour
behave'
    [Ptr Actor]
result' <- Ptr (GSList (Ptr Actor)) -> IO [Ptr Actor]
forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList (Ptr Actor))
result
    [Actor]
result'' <- (Ptr Actor -> IO Actor) -> [Ptr Actor] -> IO [Actor]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) [Ptr Actor]
result'
    Ptr (GSList (Ptr Actor)) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList (Ptr Actor))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
behave
    [Actor] -> IO [Actor]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Actor]
result''

#if defined(ENABLE_OVERLOADING)
data BehaviourGetActorsMethodInfo
instance (signature ~ (m [Clutter.Actor.Actor]), MonadIO m, IsBehaviour a) => O.OverloadedMethod BehaviourGetActorsMethodInfo a signature where
    overloadedMethod = behaviourGetActors

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


#endif

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

foreign import ccall "clutter_behaviour_get_alpha" clutter_behaviour_get_alpha :: 
    Ptr Behaviour ->                        -- behave : TInterface (Name {namespace = "Clutter", name = "Behaviour"})
    IO (Ptr Clutter.Alpha.Alpha)

{-# DEPRECATED behaviourGetAlpha ["(Since version 1.6)"] #-}
-- | Retrieves the t'GI.Clutter.Objects.Alpha.Alpha' object bound to /@behave@/.
-- 
-- /Since: 0.2/
behaviourGetAlpha ::
    (B.CallStack.HasCallStack, MonadIO m, IsBehaviour a) =>
    a
    -- ^ /@behave@/: a t'GI.Clutter.Objects.Behaviour.Behaviour'
    -> m Clutter.Alpha.Alpha
    -- ^ __Returns:__ a t'GI.Clutter.Objects.Alpha.Alpha' object, or 'P.Nothing' if no alpha
    --   object has been bound to this behaviour.
behaviourGetAlpha :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBehaviour a) =>
a -> m Alpha
behaviourGetAlpha a
behave = IO Alpha -> m Alpha
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Alpha -> m Alpha) -> IO Alpha -> m Alpha
forall a b. (a -> b) -> a -> b
$ do
    Ptr Behaviour
behave' <- a -> IO (Ptr Behaviour)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
behave
    Ptr Alpha
result <- Ptr Behaviour -> IO (Ptr Alpha)
clutter_behaviour_get_alpha Ptr Behaviour
behave'
    Text -> Ptr Alpha -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"behaviourGetAlpha" Ptr Alpha
result
    Alpha
result' <- ((ManagedPtr Alpha -> Alpha) -> Ptr Alpha -> IO Alpha
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Alpha -> Alpha
Clutter.Alpha.Alpha) Ptr Alpha
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
behave
    Alpha -> IO Alpha
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Alpha
result'

#if defined(ENABLE_OVERLOADING)
data BehaviourGetAlphaMethodInfo
instance (signature ~ (m Clutter.Alpha.Alpha), MonadIO m, IsBehaviour a) => O.OverloadedMethod BehaviourGetAlphaMethodInfo a signature where
    overloadedMethod = behaviourGetAlpha

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


#endif

-- method Behaviour::get_n_actors
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "behave"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Behaviour" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterBehaviour"
--                 , 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_behaviour_get_n_actors" clutter_behaviour_get_n_actors :: 
    Ptr Behaviour ->                        -- behave : TInterface (Name {namespace = "Clutter", name = "Behaviour"})
    IO Int32

{-# DEPRECATED behaviourGetNActors ["(Since version 1.6)"] #-}
-- | Gets the number of actors this behaviour is applied too.
-- 
-- /Since: 0.2/
behaviourGetNActors ::
    (B.CallStack.HasCallStack, MonadIO m, IsBehaviour a) =>
    a
    -- ^ /@behave@/: a t'GI.Clutter.Objects.Behaviour.Behaviour'
    -> m Int32
    -- ^ __Returns:__ The number of applied actors
behaviourGetNActors :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBehaviour a) =>
a -> m Int32
behaviourGetNActors a
behave = 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 Behaviour
behave' <- a -> IO (Ptr Behaviour)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
behave
    Int32
result <- Ptr Behaviour -> IO Int32
clutter_behaviour_get_n_actors Ptr Behaviour
behave'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
behave
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data BehaviourGetNActorsMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsBehaviour a) => O.OverloadedMethod BehaviourGetNActorsMethodInfo a signature where
    overloadedMethod = behaviourGetNActors

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


#endif

-- method Behaviour::get_nth_actor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "behave"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Behaviour" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterBehaviour"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the index of an actor this behaviour is applied too."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Actor" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_behaviour_get_nth_actor" clutter_behaviour_get_nth_actor :: 
    Ptr Behaviour ->                        -- behave : TInterface (Name {namespace = "Clutter", name = "Behaviour"})
    Int32 ->                                -- index_ : TBasicType TInt
    IO (Ptr Clutter.Actor.Actor)

{-# DEPRECATED behaviourGetNthActor ["(Since version 1.6)"] #-}
-- | Gets an actor the behaviour was applied to referenced by index num.
-- 
-- /Since: 0.2/
behaviourGetNthActor ::
    (B.CallStack.HasCallStack, MonadIO m, IsBehaviour a) =>
    a
    -- ^ /@behave@/: a t'GI.Clutter.Objects.Behaviour.Behaviour'
    -> Int32
    -- ^ /@index_@/: the index of an actor this behaviour is applied too.
    -> m Clutter.Actor.Actor
    -- ^ __Returns:__ A Clutter actor or NULL if /@index_@/ is invalid.
behaviourGetNthActor :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBehaviour a) =>
a -> Int32 -> m Actor
behaviourGetNthActor a
behave Int32
index_ = IO Actor -> m Actor
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Actor -> m Actor) -> IO Actor -> m Actor
forall a b. (a -> b) -> a -> b
$ do
    Ptr Behaviour
behave' <- a -> IO (Ptr Behaviour)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
behave
    Ptr Actor
result <- Ptr Behaviour -> Int32 -> IO (Ptr Actor)
clutter_behaviour_get_nth_actor Ptr Behaviour
behave' Int32
index_
    Text -> Ptr Actor -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"behaviourGetNthActor" Ptr Actor
result
    Actor
result' <- ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) Ptr Actor
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
behave
    Actor -> IO Actor
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Actor
result'

#if defined(ENABLE_OVERLOADING)
data BehaviourGetNthActorMethodInfo
instance (signature ~ (Int32 -> m Clutter.Actor.Actor), MonadIO m, IsBehaviour a) => O.OverloadedMethod BehaviourGetNthActorMethodInfo a signature where
    overloadedMethod = behaviourGetNthActor

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


#endif

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

foreign import ccall "clutter_behaviour_is_applied" clutter_behaviour_is_applied :: 
    Ptr Behaviour ->                        -- behave : TInterface (Name {namespace = "Clutter", name = "Behaviour"})
    Ptr Clutter.Actor.Actor ->              -- actor : TInterface (Name {namespace = "Clutter", name = "Actor"})
    IO CInt

{-# DEPRECATED behaviourIsApplied ["(Since version 1.6)"] #-}
-- | Check if /@behave@/ applied to  /@actor@/.
-- 
-- /Since: 0.4/
behaviourIsApplied ::
    (B.CallStack.HasCallStack, MonadIO m, IsBehaviour a, Clutter.Actor.IsActor b) =>
    a
    -- ^ /@behave@/: a t'GI.Clutter.Objects.Behaviour.Behaviour'
    -> b
    -- ^ /@actor@/: a t'GI.Clutter.Objects.Actor.Actor'
    -> m Bool
    -- ^ __Returns:__ TRUE if actor has behaviour. FALSE otherwise.
behaviourIsApplied :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsBehaviour a, IsActor b) =>
a -> b -> m Bool
behaviourIsApplied a
behave b
actor = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Behaviour
behave' <- a -> IO (Ptr Behaviour)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
behave
    Ptr Actor
actor' <- b -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
actor
    CInt
result <- Ptr Behaviour -> Ptr Actor -> IO CInt
clutter_behaviour_is_applied Ptr Behaviour
behave' Ptr Actor
actor'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
behave
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
actor
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BehaviourIsAppliedMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsBehaviour a, Clutter.Actor.IsActor b) => O.OverloadedMethod BehaviourIsAppliedMethodInfo a signature where
    overloadedMethod = behaviourIsApplied

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


#endif

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

foreign import ccall "clutter_behaviour_remove" clutter_behaviour_remove :: 
    Ptr Behaviour ->                        -- behave : TInterface (Name {namespace = "Clutter", name = "Behaviour"})
    Ptr Clutter.Actor.Actor ->              -- actor : TInterface (Name {namespace = "Clutter", name = "Actor"})
    IO ()

{-# DEPRECATED behaviourRemove ["(Since version 1.6)"] #-}
-- | Removes /@actor@/ from the list of t'GI.Clutter.Objects.Actor.Actor's to which
-- /@behave@/ applies.  This function removes a reference on the actor.
-- 
-- /Since: 0.2/
behaviourRemove ::
    (B.CallStack.HasCallStack, MonadIO m, IsBehaviour a, Clutter.Actor.IsActor b) =>
    a
    -- ^ /@behave@/: a t'GI.Clutter.Objects.Behaviour.Behaviour'
    -> b
    -- ^ /@actor@/: a t'GI.Clutter.Objects.Actor.Actor'
    -> m ()
behaviourRemove :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsBehaviour a, IsActor b) =>
a -> b -> m ()
behaviourRemove a
behave b
actor = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Behaviour
behave' <- a -> IO (Ptr Behaviour)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
behave
    Ptr Actor
actor' <- b -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
actor
    Ptr Behaviour -> Ptr Actor -> IO ()
clutter_behaviour_remove Ptr Behaviour
behave' Ptr Actor
actor'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
behave
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
actor
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

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

foreign import ccall "clutter_behaviour_remove_all" clutter_behaviour_remove_all :: 
    Ptr Behaviour ->                        -- behave : TInterface (Name {namespace = "Clutter", name = "Behaviour"})
    IO ()

{-# DEPRECATED behaviourRemoveAll ["(Since version 1.6)"] #-}
-- | Removes every actor from the list that /@behave@/ holds.
-- 
-- /Since: 0.4/
behaviourRemoveAll ::
    (B.CallStack.HasCallStack, MonadIO m, IsBehaviour a) =>
    a
    -- ^ /@behave@/: a t'GI.Clutter.Objects.Behaviour.Behaviour'
    -> m ()
behaviourRemoveAll :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBehaviour a) =>
a -> m ()
behaviourRemoveAll a
behave = 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 Behaviour
behave' <- a -> IO (Ptr Behaviour)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
behave
    Ptr Behaviour -> IO ()
clutter_behaviour_remove_all Ptr Behaviour
behave'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
behave
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BehaviourRemoveAllMethodInfo
instance (signature ~ (m ()), MonadIO m, IsBehaviour a) => O.OverloadedMethod BehaviourRemoveAllMethodInfo a signature where
    overloadedMethod = behaviourRemoveAll

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


#endif

-- method Behaviour::set_alpha
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "behave"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Behaviour" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterBehaviour"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "alpha"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Alpha" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #ClutterAlpha or %NULL to unset a previously set alpha"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_behaviour_set_alpha" clutter_behaviour_set_alpha :: 
    Ptr Behaviour ->                        -- behave : TInterface (Name {namespace = "Clutter", name = "Behaviour"})
    Ptr Clutter.Alpha.Alpha ->              -- alpha : TInterface (Name {namespace = "Clutter", name = "Alpha"})
    IO ()

{-# DEPRECATED behaviourSetAlpha ["(Since version 1.6)"] #-}
-- | Binds /@alpha@/ to a t'GI.Clutter.Objects.Behaviour.Behaviour'. The t'GI.Clutter.Objects.Alpha.Alpha' object
-- is what makes a behaviour work: for each tick of the timeline
-- used by t'GI.Clutter.Objects.Alpha.Alpha' a new value of the alpha parameter is
-- computed by the alpha function; the value should be used by
-- the t'GI.Clutter.Objects.Behaviour.Behaviour' to update one or more properties of the
-- actors to which the behaviour applies.
-- 
-- If /@alpha@/ is not 'P.Nothing', the t'GI.Clutter.Objects.Behaviour.Behaviour' will take ownership
-- of the t'GI.Clutter.Objects.Alpha.Alpha' instance.
-- 
-- /Since: 0.2/
behaviourSetAlpha ::
    (B.CallStack.HasCallStack, MonadIO m, IsBehaviour a, Clutter.Alpha.IsAlpha b) =>
    a
    -- ^ /@behave@/: a t'GI.Clutter.Objects.Behaviour.Behaviour'
    -> b
    -- ^ /@alpha@/: a t'GI.Clutter.Objects.Alpha.Alpha' or 'P.Nothing' to unset a previously set alpha
    -> m ()
behaviourSetAlpha :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsBehaviour a, IsAlpha b) =>
a -> b -> m ()
behaviourSetAlpha a
behave b
alpha = 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 Behaviour
behave' <- a -> IO (Ptr Behaviour)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
behave
    Ptr Alpha
alpha' <- b -> IO (Ptr Alpha)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
alpha
    Ptr Behaviour -> Ptr Alpha -> IO ()
clutter_behaviour_set_alpha Ptr Behaviour
behave' Ptr Alpha
alpha'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
behave
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
alpha
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BehaviourSetAlphaMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsBehaviour a, Clutter.Alpha.IsAlpha b) => O.OverloadedMethod BehaviourSetAlphaMethodInfo a signature where
    overloadedMethod = behaviourSetAlpha

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


#endif