{-# 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.BehaviourPath.BehaviourPath' structure contains only private data
-- and should be accessed using the provided API
-- 
-- /Since: 0.2/

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

module GI.Clutter.Objects.BehaviourPath
    ( 

-- * Exported types
    BehaviourPath(..)                       ,
    IsBehaviourPath                         ,
    toBehaviourPath                         ,


 -- * 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"), [getPath]("GI.Clutter.Objects.BehaviourPath#g:method:getPath"), [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"), [setPath]("GI.Clutter.Objects.BehaviourPath#g:method:setPath"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveBehaviourPathMethod              ,
#endif

-- ** getPath #method:getPath#

#if defined(ENABLE_OVERLOADING)
    BehaviourPathGetPathMethodInfo          ,
#endif
    behaviourPathGetPath                    ,


-- ** new #method:new#

    behaviourPathNew                        ,


-- ** newWithDescription #method:newWithDescription#

    behaviourPathNewWithDescription         ,


-- ** newWithKnots #method:newWithKnots#

    behaviourPathNewWithKnots               ,


-- ** setPath #method:setPath#

#if defined(ENABLE_OVERLOADING)
    BehaviourPathSetPathMethodInfo          ,
#endif
    behaviourPathSetPath                    ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    BehaviourPathPathPropertyInfo           ,
#endif
#if defined(ENABLE_OVERLOADING)
    behaviourPathPath                       ,
#endif
    constructBehaviourPathPath              ,
    getBehaviourPathPath                    ,
    setBehaviourPathPath                    ,




 -- * Signals


-- ** knotReached #signal:knotReached#

    BehaviourPathKnotReachedCallback        ,
#if defined(ENABLE_OVERLOADING)
    BehaviourPathKnotReachedSignalInfo      ,
#endif
    afterBehaviourPathKnotReached           ,
    onBehaviourPathKnotReached              ,




    ) 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.Kind as DK
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.Interfaces.Scriptable as Clutter.Scriptable
import {-# SOURCE #-} qualified GI.Clutter.Objects.Alpha as Clutter.Alpha
import {-# SOURCE #-} qualified GI.Clutter.Objects.Behaviour as Clutter.Behaviour
import {-# SOURCE #-} qualified GI.Clutter.Objects.Path as Clutter.Path
import {-# SOURCE #-} qualified GI.Clutter.Structs.Knot as Clutter.Knot
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "clutter_behaviour_path_get_type"
    c_clutter_behaviour_path_get_type :: IO B.Types.GType

instance B.Types.TypedObject BehaviourPath where
    glibType :: IO GType
glibType = IO GType
c_clutter_behaviour_path_get_type

instance B.Types.GObject BehaviourPath

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

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

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

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

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

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

#endif

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

#endif

-- signal BehaviourPath::knot-reached
{-# DEPRECATED BehaviourPathKnotReachedCallback ["(Since version 1.6)"] #-}
-- | This signal is emitted each time a node defined inside the path
-- is reached.
-- 
-- /Since: 0.2/
type BehaviourPathKnotReachedCallback =
    Word32
    -- ^ /@knotNum@/: the index of the t'GI.Clutter.Structs.Knot.Knot' reached
    -> IO ()

type C_BehaviourPathKnotReachedCallback =
    Ptr BehaviourPath ->                    -- object
    Word32 ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_BehaviourPathKnotReachedCallback :: 
    GObject a => (a -> BehaviourPathKnotReachedCallback) ->
    C_BehaviourPathKnotReachedCallback
wrap_BehaviourPathKnotReachedCallback :: forall a.
GObject a =>
(a -> BehaviourPathKnotReachedCallback)
-> C_BehaviourPathKnotReachedCallback
wrap_BehaviourPathKnotReachedCallback a -> BehaviourPathKnotReachedCallback
gi'cb Ptr BehaviourPath
gi'selfPtr Word32
knotNum Ptr ()
_ = do
    Ptr BehaviourPath -> (BehaviourPath -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr BehaviourPath
gi'selfPtr ((BehaviourPath -> IO ()) -> IO ())
-> (BehaviourPath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \BehaviourPath
gi'self -> a -> BehaviourPathKnotReachedCallback
gi'cb (BehaviourPath -> a
forall a b. Coercible a b => a -> b
Coerce.coerce BehaviourPath
gi'self)  Word32
knotNum


-- | Connect a signal handler for the [knotReached](#signal:knotReached) 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' behaviourPath #knotReached callback
-- @
-- 
-- 
onBehaviourPathKnotReached :: (IsBehaviourPath a, MonadIO m) => a -> ((?self :: a) => BehaviourPathKnotReachedCallback) -> m SignalHandlerId
onBehaviourPathKnotReached :: forall a (m :: * -> *).
(IsBehaviourPath a, MonadIO m) =>
a
-> ((?self::a) => BehaviourPathKnotReachedCallback)
-> m SignalHandlerId
onBehaviourPathKnotReached a
obj (?self::a) => BehaviourPathKnotReachedCallback
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 -> BehaviourPathKnotReachedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => BehaviourPathKnotReachedCallback
BehaviourPathKnotReachedCallback
cb
    let wrapped' :: C_BehaviourPathKnotReachedCallback
wrapped' = (a -> BehaviourPathKnotReachedCallback)
-> C_BehaviourPathKnotReachedCallback
forall a.
GObject a =>
(a -> BehaviourPathKnotReachedCallback)
-> C_BehaviourPathKnotReachedCallback
wrap_BehaviourPathKnotReachedCallback a -> BehaviourPathKnotReachedCallback
wrapped
    FunPtr C_BehaviourPathKnotReachedCallback
wrapped'' <- C_BehaviourPathKnotReachedCallback
-> IO (FunPtr C_BehaviourPathKnotReachedCallback)
mk_BehaviourPathKnotReachedCallback C_BehaviourPathKnotReachedCallback
wrapped'
    a
-> Text
-> FunPtr C_BehaviourPathKnotReachedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"knot-reached" FunPtr C_BehaviourPathKnotReachedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [knotReached](#signal:knotReached) 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' behaviourPath #knotReached 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.
-- 
afterBehaviourPathKnotReached :: (IsBehaviourPath a, MonadIO m) => a -> ((?self :: a) => BehaviourPathKnotReachedCallback) -> m SignalHandlerId
afterBehaviourPathKnotReached :: forall a (m :: * -> *).
(IsBehaviourPath a, MonadIO m) =>
a
-> ((?self::a) => BehaviourPathKnotReachedCallback)
-> m SignalHandlerId
afterBehaviourPathKnotReached a
obj (?self::a) => BehaviourPathKnotReachedCallback
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 -> BehaviourPathKnotReachedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => BehaviourPathKnotReachedCallback
BehaviourPathKnotReachedCallback
cb
    let wrapped' :: C_BehaviourPathKnotReachedCallback
wrapped' = (a -> BehaviourPathKnotReachedCallback)
-> C_BehaviourPathKnotReachedCallback
forall a.
GObject a =>
(a -> BehaviourPathKnotReachedCallback)
-> C_BehaviourPathKnotReachedCallback
wrap_BehaviourPathKnotReachedCallback a -> BehaviourPathKnotReachedCallback
wrapped
    FunPtr C_BehaviourPathKnotReachedCallback
wrapped'' <- C_BehaviourPathKnotReachedCallback
-> IO (FunPtr C_BehaviourPathKnotReachedCallback)
mk_BehaviourPathKnotReachedCallback C_BehaviourPathKnotReachedCallback
wrapped'
    a
-> Text
-> FunPtr C_BehaviourPathKnotReachedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"knot-reached" FunPtr C_BehaviourPathKnotReachedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data BehaviourPathKnotReachedSignalInfo
instance SignalInfo BehaviourPathKnotReachedSignalInfo where
    type HaskellCallbackType BehaviourPathKnotReachedSignalInfo = BehaviourPathKnotReachedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_BehaviourPathKnotReachedCallback cb
        cb'' <- mk_BehaviourPathKnotReachedCallback cb'
        connectSignalFunPtr obj "knot-reached" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.BehaviourPath::knot-reached"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-BehaviourPath.html#g:signal:knotReached"})

#endif

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

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

-- | Set the value of the “@path@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' behaviourPath [ #path 'Data.GI.Base.Attributes.:=' value ]
-- @
setBehaviourPathPath :: (MonadIO m, IsBehaviourPath o, Clutter.Path.IsPath a) => o -> a -> m ()
setBehaviourPathPath :: forall (m :: * -> *) o a.
(MonadIO m, IsBehaviourPath o, IsPath a) =>
o -> a -> m ()
setBehaviourPathPath 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
"path" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@path@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructBehaviourPathPath :: (IsBehaviourPath o, MIO.MonadIO m, Clutter.Path.IsPath a) => a -> m (GValueConstruct o)
constructBehaviourPathPath :: forall o (m :: * -> *) a.
(IsBehaviourPath o, MonadIO m, IsPath a) =>
a -> m (GValueConstruct o)
constructBehaviourPathPath 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
"path" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data BehaviourPathPathPropertyInfo
instance AttrInfo BehaviourPathPathPropertyInfo where
    type AttrAllowedOps BehaviourPathPathPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint BehaviourPathPathPropertyInfo = IsBehaviourPath
    type AttrSetTypeConstraint BehaviourPathPathPropertyInfo = Clutter.Path.IsPath
    type AttrTransferTypeConstraint BehaviourPathPathPropertyInfo = Clutter.Path.IsPath
    type AttrTransferType BehaviourPathPathPropertyInfo = Clutter.Path.Path
    type AttrGetType BehaviourPathPathPropertyInfo = Clutter.Path.Path
    type AttrLabel BehaviourPathPathPropertyInfo = "path"
    type AttrOrigin BehaviourPathPathPropertyInfo = BehaviourPath
    attrGet = getBehaviourPathPath
    attrSet = setBehaviourPathPath
    attrTransfer _ v = do
        unsafeCastTo Clutter.Path.Path v
    attrConstruct = constructBehaviourPathPath
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.BehaviourPath.path"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-BehaviourPath.html#g:attr:path"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList BehaviourPath
type instance O.AttributeList BehaviourPath = BehaviourPathAttributeList
type BehaviourPathAttributeList = ('[ '("alpha", Clutter.Behaviour.BehaviourAlphaPropertyInfo), '("path", BehaviourPathPathPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
behaviourPathPath :: AttrLabelProxy "path"
behaviourPathPath = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList BehaviourPath = BehaviourPathSignalList
type BehaviourPathSignalList = ('[ '("applied", Clutter.Behaviour.BehaviourAppliedSignalInfo), '("knotReached", BehaviourPathKnotReachedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("removed", Clutter.Behaviour.BehaviourRemovedSignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method BehaviourPath::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "alpha"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Alpha" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAlpha instance, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPath or %NULL for an empty path"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Clutter" , name = "BehaviourPath" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_behaviour_path_new" clutter_behaviour_path_new :: 
    Ptr Clutter.Alpha.Alpha ->              -- alpha : TInterface (Name {namespace = "Clutter", name = "Alpha"})
    Ptr Clutter.Path.Path ->                -- path : TInterface (Name {namespace = "Clutter", name = "Path"})
    IO (Ptr BehaviourPath)

{-# DEPRECATED behaviourPathNew ["(Since version 1.6)"] #-}
-- | Creates a new path behaviour. You can use this behaviour to drive
-- actors along the nodes of a path, described by /@path@/.
-- 
-- This will claim the floating reference on the t'GI.Clutter.Objects.Path.Path' so you
-- do not need to unref if it.
-- 
-- 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. In the case when /@alpha@/ is 'P.Nothing',
-- it can be set later with 'GI.Clutter.Objects.Behaviour.behaviourSetAlpha'.
-- 
-- /Since: 0.2/
behaviourPathNew ::
    (B.CallStack.HasCallStack, MonadIO m, Clutter.Alpha.IsAlpha a, Clutter.Path.IsPath b) =>
    Maybe (a)
    -- ^ /@alpha@/: a t'GI.Clutter.Objects.Alpha.Alpha' instance, or 'P.Nothing'
    -> b
    -- ^ /@path@/: a t'GI.Clutter.Objects.Path.Path' or 'P.Nothing' for an empty path
    -> m BehaviourPath
    -- ^ __Returns:__ a t'GI.Clutter.Objects.Behaviour.Behaviour'
behaviourPathNew :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAlpha a, IsPath b) =>
Maybe a -> b -> m BehaviourPath
behaviourPathNew Maybe a
alpha b
path = IO BehaviourPath -> m BehaviourPath
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BehaviourPath -> m BehaviourPath)
-> IO BehaviourPath -> m BehaviourPath
forall a b. (a -> b) -> a -> b
$ do
    Ptr Alpha
maybeAlpha <- case Maybe a
alpha of
        Maybe a
Nothing -> Ptr Alpha -> IO (Ptr Alpha)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Alpha
forall a. Ptr a
nullPtr
        Just a
jAlpha -> do
            Ptr Alpha
jAlpha' <- a -> IO (Ptr Alpha)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jAlpha
            Ptr Alpha -> IO (Ptr Alpha)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Alpha
jAlpha'
    Ptr Path
path' <- b -> IO (Ptr Path)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
path
    Ptr BehaviourPath
result <- Ptr Alpha -> Ptr Path -> IO (Ptr BehaviourPath)
clutter_behaviour_path_new Ptr Alpha
maybeAlpha Ptr Path
path'
    Text -> Ptr BehaviourPath -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"behaviourPathNew" Ptr BehaviourPath
result
    BehaviourPath
result' <- ((ManagedPtr BehaviourPath -> BehaviourPath)
-> Ptr BehaviourPath -> IO BehaviourPath
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr BehaviourPath -> BehaviourPath
BehaviourPath) Ptr BehaviourPath
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
alpha a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
path
    BehaviourPath -> IO BehaviourPath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BehaviourPath
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method BehaviourPath::new_with_description
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "alpha"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Alpha" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAlpha instance, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "desc"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string description of the path"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Clutter" , name = "BehaviourPath" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_behaviour_path_new_with_description" clutter_behaviour_path_new_with_description :: 
    Ptr Clutter.Alpha.Alpha ->              -- alpha : TInterface (Name {namespace = "Clutter", name = "Alpha"})
    CString ->                              -- desc : TBasicType TUTF8
    IO (Ptr BehaviourPath)

{-# DEPRECATED behaviourPathNewWithDescription ["(Since version 1.6)"] #-}
-- | Creates a new path behaviour using the path described by /@desc@/. See
-- 'GI.Clutter.Objects.Path.pathAddString' for a description of the format.
-- 
-- 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. In the case when /@alpha@/ is 'P.Nothing',
-- it can be set later with 'GI.Clutter.Objects.Behaviour.behaviourSetAlpha'.
-- 
-- /Since: 1.0/
behaviourPathNewWithDescription ::
    (B.CallStack.HasCallStack, MonadIO m, Clutter.Alpha.IsAlpha a) =>
    Maybe (a)
    -- ^ /@alpha@/: a t'GI.Clutter.Objects.Alpha.Alpha' instance, or 'P.Nothing'
    -> T.Text
    -- ^ /@desc@/: a string description of the path
    -> m BehaviourPath
    -- ^ __Returns:__ a t'GI.Clutter.Objects.Behaviour.Behaviour'
behaviourPathNewWithDescription :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlpha a) =>
Maybe a -> Text -> m BehaviourPath
behaviourPathNewWithDescription Maybe a
alpha Text
desc = IO BehaviourPath -> m BehaviourPath
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BehaviourPath -> m BehaviourPath)
-> IO BehaviourPath -> m BehaviourPath
forall a b. (a -> b) -> a -> b
$ do
    Ptr Alpha
maybeAlpha <- case Maybe a
alpha of
        Maybe a
Nothing -> Ptr Alpha -> IO (Ptr Alpha)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Alpha
forall a. Ptr a
nullPtr
        Just a
jAlpha -> do
            Ptr Alpha
jAlpha' <- a -> IO (Ptr Alpha)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jAlpha
            Ptr Alpha -> IO (Ptr Alpha)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Alpha
jAlpha'
    CString
desc' <- Text -> IO CString
textToCString Text
desc
    Ptr BehaviourPath
result <- Ptr Alpha -> CString -> IO (Ptr BehaviourPath)
clutter_behaviour_path_new_with_description Ptr Alpha
maybeAlpha CString
desc'
    Text -> Ptr BehaviourPath -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"behaviourPathNewWithDescription" Ptr BehaviourPath
result
    BehaviourPath
result' <- ((ManagedPtr BehaviourPath -> BehaviourPath)
-> Ptr BehaviourPath -> IO BehaviourPath
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr BehaviourPath -> BehaviourPath
BehaviourPath) Ptr BehaviourPath
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
alpha a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
desc'
    BehaviourPath -> IO BehaviourPath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BehaviourPath
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method BehaviourPath::new_with_knots
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "alpha"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Alpha" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAlpha instance, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "knots"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 2
--                 (TInterface Name { namespace = "Clutter" , name = "Knot" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an array of #ClutterKnot<!-- -->s"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_knots"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of entries in @knots"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_knots"
--              , argType = TBasicType TUInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "number of entries in @knots"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Clutter" , name = "BehaviourPath" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_behaviour_path_new_with_knots" clutter_behaviour_path_new_with_knots :: 
    Ptr Clutter.Alpha.Alpha ->              -- alpha : TInterface (Name {namespace = "Clutter", name = "Alpha"})
    Ptr Clutter.Knot.Knot ->                -- knots : TCArray False (-1) 2 (TInterface (Name {namespace = "Clutter", name = "Knot"}))
    Word32 ->                               -- n_knots : TBasicType TUInt
    IO (Ptr BehaviourPath)

{-# DEPRECATED behaviourPathNewWithKnots ["(Since version 1.6)"] #-}
-- | Creates a new path behaviour that will make the actors visit all of
-- the given knots in order with straight lines in between.
-- 
-- A path will be created where the first knot is used in a
-- 'GI.Clutter.Enums.PathNodeTypeMoveTo' and the subsequent knots are used in
-- 'GI.Clutter.Enums.PathNodeTypeLineTo's.
-- 
-- 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. In the case when /@alpha@/ is 'P.Nothing',
-- it can be set later with 'GI.Clutter.Objects.Behaviour.behaviourSetAlpha'.
-- 
-- /Since: 1.0/
behaviourPathNewWithKnots ::
    (B.CallStack.HasCallStack, MonadIO m, Clutter.Alpha.IsAlpha a) =>
    Maybe (a)
    -- ^ /@alpha@/: a t'GI.Clutter.Objects.Alpha.Alpha' instance, or 'P.Nothing'
    -> [Clutter.Knot.Knot]
    -- ^ /@knots@/: an array of t'GI.Clutter.Structs.Knot.Knot's
    -> m BehaviourPath
    -- ^ __Returns:__ a t'GI.Clutter.Objects.Behaviour.Behaviour'
behaviourPathNewWithKnots :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlpha a) =>
Maybe a -> [Knot] -> m BehaviourPath
behaviourPathNewWithKnots Maybe a
alpha [Knot]
knots = IO BehaviourPath -> m BehaviourPath
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BehaviourPath -> m BehaviourPath)
-> IO BehaviourPath -> m BehaviourPath
forall a b. (a -> b) -> a -> b
$ do
    let nKnots :: Word32
nKnots = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [Knot] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Knot]
knots
    Ptr Alpha
maybeAlpha <- case Maybe a
alpha of
        Maybe a
Nothing -> Ptr Alpha -> IO (Ptr Alpha)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Alpha
forall a. Ptr a
nullPtr
        Just a
jAlpha -> do
            Ptr Alpha
jAlpha' <- a -> IO (Ptr Alpha)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jAlpha
            Ptr Alpha -> IO (Ptr Alpha)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Alpha
jAlpha'
    [Ptr Knot]
knots' <- (Knot -> IO (Ptr Knot)) -> [Knot] -> IO [Ptr Knot]
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 Knot -> IO (Ptr Knot)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [Knot]
knots
    Ptr Knot
knots'' <- Int -> [Ptr Knot] -> IO (Ptr Knot)
forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
8 [Ptr Knot]
knots'
    Ptr BehaviourPath
result <- Ptr Alpha -> Ptr Knot -> Word32 -> IO (Ptr BehaviourPath)
clutter_behaviour_path_new_with_knots Ptr Alpha
maybeAlpha Ptr Knot
knots'' Word32
nKnots
    Text -> Ptr BehaviourPath -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"behaviourPathNewWithKnots" Ptr BehaviourPath
result
    BehaviourPath
result' <- ((ManagedPtr BehaviourPath -> BehaviourPath)
-> Ptr BehaviourPath -> IO BehaviourPath
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr BehaviourPath -> BehaviourPath
BehaviourPath) Ptr BehaviourPath
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
alpha a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    (Knot -> IO ()) -> [Knot] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Knot -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [Knot]
knots
    Ptr Knot -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Knot
knots''
    BehaviourPath -> IO BehaviourPath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BehaviourPath
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "clutter_behaviour_path_get_path" clutter_behaviour_path_get_path :: 
    Ptr BehaviourPath ->                    -- pathb : TInterface (Name {namespace = "Clutter", name = "BehaviourPath"})
    IO (Ptr Clutter.Path.Path)

{-# DEPRECATED behaviourPathGetPath ["(Since version 1.6)"] #-}
-- | Get the current path of the behaviour
-- 
-- /Since: 1.0/
behaviourPathGetPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsBehaviourPath a) =>
    a
    -- ^ /@pathb@/: a t'GI.Clutter.Objects.BehaviourPath.BehaviourPath' instance
    -> m Clutter.Path.Path
    -- ^ __Returns:__ the path
behaviourPathGetPath :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBehaviourPath a) =>
a -> m Path
behaviourPathGetPath a
pathb = IO Path -> m Path
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Path -> m Path) -> IO Path -> m Path
forall a b. (a -> b) -> a -> b
$ do
    Ptr BehaviourPath
pathb' <- a -> IO (Ptr BehaviourPath)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pathb
    Ptr Path
result <- Ptr BehaviourPath -> IO (Ptr Path)
clutter_behaviour_path_get_path Ptr BehaviourPath
pathb'
    Text -> Ptr Path -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"behaviourPathGetPath" Ptr Path
result
    Path
result' <- ((ManagedPtr Path -> Path) -> Ptr Path -> IO Path
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Path -> Path
Clutter.Path.Path) Ptr Path
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pathb
    Path -> IO Path
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Path
result'

#if defined(ENABLE_OVERLOADING)
data BehaviourPathGetPathMethodInfo
instance (signature ~ (m Clutter.Path.Path), MonadIO m, IsBehaviourPath a) => O.OverloadedMethod BehaviourPathGetPathMethodInfo a signature where
    overloadedMethod = behaviourPathGetPath

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


#endif

-- method BehaviourPath::set_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pathb"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "BehaviourPath" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the path behaviour" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new path to follow"
--                 , 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_path_set_path" clutter_behaviour_path_set_path :: 
    Ptr BehaviourPath ->                    -- pathb : TInterface (Name {namespace = "Clutter", name = "BehaviourPath"})
    Ptr Clutter.Path.Path ->                -- path : TInterface (Name {namespace = "Clutter", name = "Path"})
    IO ()

{-# DEPRECATED behaviourPathSetPath ["(Since version 1.6)"] #-}
-- | Change the path that the actors will follow. This will take the
-- floating reference on the t'GI.Clutter.Objects.Path.Path' so you do not need to unref
-- it.
-- 
-- /Since: 1.0/
behaviourPathSetPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsBehaviourPath a, Clutter.Path.IsPath b) =>
    a
    -- ^ /@pathb@/: the path behaviour
    -> b
    -- ^ /@path@/: the new path to follow
    -> m ()
behaviourPathSetPath :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsBehaviourPath a, IsPath b) =>
a -> b -> m ()
behaviourPathSetPath a
pathb b
path = 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 BehaviourPath
pathb' <- a -> IO (Ptr BehaviourPath)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pathb
    Ptr Path
path' <- b -> IO (Ptr Path)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
path
    Ptr BehaviourPath -> Ptr Path -> IO ()
clutter_behaviour_path_set_path Ptr BehaviourPath
pathb' Ptr Path
path'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pathb
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
path
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BehaviourPathSetPathMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsBehaviourPath a, Clutter.Path.IsPath b) => O.OverloadedMethod BehaviourPathSetPathMethodInfo a signature where
    overloadedMethod = behaviourPathSetPath

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


#endif