{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Clutter.Interfaces.Animatable.Animatable' is an opaque structure whose members cannot be directly
-- accessed
-- 
-- /Since: 1.0/

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

module GI.Clutter.Interfaces.Animatable
    ( 

-- * Exported types
    Animatable(..)                          ,
    IsAnimatable                            ,
    toAnimatable                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [animateProperty]("GI.Clutter.Interfaces.Animatable#g:method:animateProperty"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [findProperty]("GI.Clutter.Interfaces.Animatable#g:method:findProperty"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [interpolateValue]("GI.Clutter.Interfaces.Animatable#g:method:interpolateValue"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getInitialState]("GI.Clutter.Interfaces.Animatable#g:method:getInitialState"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setFinalState]("GI.Clutter.Interfaces.Animatable#g:method:setFinalState"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveAnimatableMethod                 ,
#endif

-- ** animateProperty #method:animateProperty#

#if defined(ENABLE_OVERLOADING)
    AnimatableAnimatePropertyMethodInfo     ,
#endif
    animatableAnimateProperty               ,


-- ** findProperty #method:findProperty#

#if defined(ENABLE_OVERLOADING)
    AnimatableFindPropertyMethodInfo        ,
#endif
    animatableFindProperty                  ,


-- ** getInitialState #method:getInitialState#

#if defined(ENABLE_OVERLOADING)
    AnimatableGetInitialStateMethodInfo     ,
#endif
    animatableGetInitialState               ,


-- ** interpolateValue #method:interpolateValue#

#if defined(ENABLE_OVERLOADING)
    AnimatableInterpolateValueMethodInfo    ,
#endif
    animatableInterpolateValue              ,


-- ** setFinalState #method:setFinalState#

#if defined(ENABLE_OVERLOADING)
    AnimatableSetFinalStateMethodInfo       ,
#endif
    animatableSetFinalState                 ,




    ) 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.Objects.Animation as Clutter.Animation
import {-# SOURCE #-} qualified GI.Clutter.Objects.Interval as Clutter.Interval
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "clutter_animatable_get_type"
    c_clutter_animatable_get_type :: IO B.Types.GType

instance B.Types.TypedObject Animatable where
    glibType :: IO GType
glibType = IO GType
c_clutter_animatable_get_type

instance B.Types.GObject Animatable

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

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

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

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Animatable
type instance O.AttributeList Animatable = AnimatableAttributeList
type AnimatableAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveAnimatableMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveAnimatableMethod "animateProperty" o = AnimatableAnimatePropertyMethodInfo
    ResolveAnimatableMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveAnimatableMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveAnimatableMethod "findProperty" o = AnimatableFindPropertyMethodInfo
    ResolveAnimatableMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAnimatableMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAnimatableMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAnimatableMethod "interpolateValue" o = AnimatableInterpolateValueMethodInfo
    ResolveAnimatableMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveAnimatableMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAnimatableMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAnimatableMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveAnimatableMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAnimatableMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAnimatableMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveAnimatableMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveAnimatableMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveAnimatableMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveAnimatableMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAnimatableMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveAnimatableMethod "getInitialState" o = AnimatableGetInitialStateMethodInfo
    ResolveAnimatableMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveAnimatableMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveAnimatableMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAnimatableMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAnimatableMethod "setFinalState" o = AnimatableSetFinalStateMethodInfo
    ResolveAnimatableMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAnimatableMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- method Animatable::animate_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animatable"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animatable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimatable"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "animation"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the animated property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "initial_value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the initial value of the animation interval"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "final_value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the final value of the animation interval"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "progress"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the progress factor"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the animation value"
--                 , 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_animatable_animate_property" clutter_animatable_animate_property :: 
    Ptr Animatable ->                       -- animatable : TInterface (Name {namespace = "Clutter", name = "Animatable"})
    Ptr Clutter.Animation.Animation ->      -- animation : TInterface (Name {namespace = "Clutter", name = "Animation"})
    CString ->                              -- property_name : TBasicType TUTF8
    Ptr GValue ->                           -- initial_value : TGValue
    Ptr GValue ->                           -- final_value : TGValue
    CDouble ->                              -- progress : TBasicType TDouble
    Ptr GValue ->                           -- value : TGValue
    IO CInt

{-# DEPRECATED animatableAnimateProperty ["(Since version 1.8)","Use 'GI.Clutter.Interfaces.Animatable.animatableInterpolateValue'","  instead"] #-}
-- | Calls the @/animate_property()/@ virtual function for /@animatable@/.
-- 
-- The /@initialValue@/ and /@finalValue@/ t'GI.GObject.Structs.Value.Value's must contain
-- the same type; /@value@/ must have been initialized to the same
-- type of /@initialValue@/ and /@finalValue@/.
-- 
-- All implementation of the t'GI.Clutter.Interfaces.Animatable.Animatable' interface must
-- implement this function.
-- 
-- /Since: 1.0/
animatableAnimateProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimatable a, Clutter.Animation.IsAnimation b) =>
    a
    -- ^ /@animatable@/: a t'GI.Clutter.Interfaces.Animatable.Animatable'
    -> b
    -- ^ /@animation@/: a t'GI.Clutter.Objects.Animation.Animation'
    -> T.Text
    -- ^ /@propertyName@/: the name of the animated property
    -> GValue
    -- ^ /@initialValue@/: the initial value of the animation interval
    -> GValue
    -- ^ /@finalValue@/: the final value of the animation interval
    -> Double
    -- ^ /@progress@/: the progress factor
    -> GValue
    -- ^ /@value@/: return location for the animation value
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the value has been validated and can
    --   be applied to the t'GI.Clutter.Interfaces.Animatable.Animatable', and 'P.False' otherwise
animatableAnimateProperty :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAnimatable a, IsAnimation b) =>
a -> b -> Text -> GValue -> GValue -> Double -> GValue -> m Bool
animatableAnimateProperty a
animatable b
animation Text
propertyName GValue
initialValue GValue
finalValue Double
progress GValue
value = 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 Animatable
animatable' <- a -> IO (Ptr Animatable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animatable
    Ptr Animation
animation' <- b -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
animation
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    Ptr GValue
initialValue' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
initialValue
    Ptr GValue
finalValue' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
finalValue
    let progress' :: CDouble
progress' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
progress
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    CInt
result <- Ptr Animatable
-> Ptr Animation
-> CString
-> Ptr GValue
-> Ptr GValue
-> CDouble
-> Ptr GValue
-> IO CInt
clutter_animatable_animate_property Ptr Animatable
animatable' Ptr Animation
animation' CString
propertyName' Ptr GValue
initialValue' Ptr GValue
finalValue' CDouble
progress' Ptr GValue
value'
    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
animatable
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
animation
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
initialValue
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
finalValue
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AnimatableAnimatePropertyMethodInfo
instance (signature ~ (b -> T.Text -> GValue -> GValue -> Double -> GValue -> m Bool), MonadIO m, IsAnimatable a, Clutter.Animation.IsAnimation b) => O.OverloadedMethod AnimatableAnimatePropertyMethodInfo a signature where
    overloadedMethod = animatableAnimateProperty

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


#endif

-- method Animatable::find_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animatable"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animatable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimatable"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the animatable property to find"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TParamSpec
-- throws : False
-- Skip return : False

foreign import ccall "clutter_animatable_find_property" clutter_animatable_find_property :: 
    Ptr Animatable ->                       -- animatable : TInterface (Name {namespace = "Clutter", name = "Animatable"})
    CString ->                              -- property_name : TBasicType TUTF8
    IO (Ptr GParamSpec)

-- | Finds the t'GI.GObject.Objects.ParamSpec.ParamSpec' for /@propertyName@/
-- 
-- /Since: 1.4/
animatableFindProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimatable a) =>
    a
    -- ^ /@animatable@/: a t'GI.Clutter.Interfaces.Animatable.Animatable'
    -> T.Text
    -- ^ /@propertyName@/: the name of the animatable property to find
    -> m GParamSpec
    -- ^ __Returns:__ The t'GI.GObject.Objects.ParamSpec.ParamSpec' for the given property
    --   or 'P.Nothing'
animatableFindProperty :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimatable a) =>
a -> Text -> m GParamSpec
animatableFindProperty a
animatable Text
propertyName = IO GParamSpec -> m GParamSpec
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GParamSpec -> m GParamSpec) -> IO GParamSpec -> m GParamSpec
forall a b. (a -> b) -> a -> b
$ do
    Ptr Animatable
animatable' <- a -> IO (Ptr Animatable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animatable
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    Ptr GParamSpec
result <- Ptr Animatable -> CString -> IO (Ptr GParamSpec)
clutter_animatable_find_property Ptr Animatable
animatable' CString
propertyName'
    Text -> Ptr GParamSpec -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"animatableFindProperty" Ptr GParamSpec
result
    GParamSpec
result' <- Ptr GParamSpec -> IO GParamSpec
B.GParamSpec.newGParamSpecFromPtr Ptr GParamSpec
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animatable
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    GParamSpec -> IO GParamSpec
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GParamSpec
result'

#if defined(ENABLE_OVERLOADING)
data AnimatableFindPropertyMethodInfo
instance (signature ~ (T.Text -> m GParamSpec), MonadIO m, IsAnimatable a) => O.OverloadedMethod AnimatableFindPropertyMethodInfo a signature where
    overloadedMethod = animatableFindProperty

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


#endif

-- method Animatable::get_initial_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animatable"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animatable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimatable"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the name of the animatable property to retrieve"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GValue initialized to the type of the property to retrieve"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_animatable_get_initial_state" clutter_animatable_get_initial_state :: 
    Ptr Animatable ->                       -- animatable : TInterface (Name {namespace = "Clutter", name = "Animatable"})
    CString ->                              -- property_name : TBasicType TUTF8
    Ptr GValue ->                           -- value : TGValue
    IO ()

-- | Retrieves the current state of /@propertyName@/ and sets /@value@/ with it
-- 
-- /Since: 1.4/
animatableGetInitialState ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimatable a) =>
    a
    -- ^ /@animatable@/: a t'GI.Clutter.Interfaces.Animatable.Animatable'
    -> T.Text
    -- ^ /@propertyName@/: the name of the animatable property to retrieve
    -> GValue
    -- ^ /@value@/: a t'GI.GObject.Structs.Value.Value' initialized to the type of the property to retrieve
    -> m ()
animatableGetInitialState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimatable a) =>
a -> Text -> GValue -> m ()
animatableGetInitialState a
animatable Text
propertyName GValue
value = 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 Animatable
animatable' <- a -> IO (Ptr Animatable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animatable
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr Animatable -> CString -> Ptr GValue -> IO ()
clutter_animatable_get_initial_state Ptr Animatable
animatable' CString
propertyName' Ptr GValue
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animatable
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnimatableGetInitialStateMethodInfo
instance (signature ~ (T.Text -> GValue -> m ()), MonadIO m, IsAnimatable a) => O.OverloadedMethod AnimatableGetInitialStateMethodInfo a signature where
    overloadedMethod = animatableGetInitialState

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


#endif

-- method Animatable::interpolate_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animatable"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animatable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimatable"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the property to interpolate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interval"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Interval" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInterval with the animation range"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "progress"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the progress to use to interpolate between the\n  initial and final values of the @interval"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for an initialized #GValue\n  using the same type of the @interval"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_animatable_interpolate_value" clutter_animatable_interpolate_value :: 
    Ptr Animatable ->                       -- animatable : TInterface (Name {namespace = "Clutter", name = "Animatable"})
    CString ->                              -- property_name : TBasicType TUTF8
    Ptr Clutter.Interval.Interval ->        -- interval : TInterface (Name {namespace = "Clutter", name = "Interval"})
    CDouble ->                              -- progress : TBasicType TDouble
    Ptr GValue ->                           -- value : TGValue
    IO CInt

-- | Asks a t'GI.Clutter.Interfaces.Animatable.Animatable' implementation to interpolate a
-- a named property between the initial and final values of
-- a t'GI.Clutter.Objects.Interval.Interval', using /@progress@/ as the interpolation
-- value, and store the result inside /@value@/.
-- 
-- This function should be used for every property animation
-- involving t'GI.Clutter.Interfaces.Animatable.Animatable's.
-- 
-- This function replaces 'GI.Clutter.Interfaces.Animatable.animatableAnimateProperty'.
-- 
-- /Since: 1.8/
animatableInterpolateValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimatable a, Clutter.Interval.IsInterval b) =>
    a
    -- ^ /@animatable@/: a t'GI.Clutter.Interfaces.Animatable.Animatable'
    -> T.Text
    -- ^ /@propertyName@/: the name of the property to interpolate
    -> b
    -- ^ /@interval@/: a t'GI.Clutter.Objects.Interval.Interval' with the animation range
    -> Double
    -- ^ /@progress@/: the progress to use to interpolate between the
    --   initial and final values of the /@interval@/
    -> m ((Bool, GValue))
    -- ^ __Returns:__ 'P.True' if the interpolation was successful,
    --   and 'P.False' otherwise
animatableInterpolateValue :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAnimatable a, IsInterval b) =>
a -> Text -> b -> Double -> m (Bool, GValue)
animatableInterpolateValue a
animatable Text
propertyName b
interval Double
progress = IO (Bool, GValue) -> m (Bool, GValue)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, GValue) -> m (Bool, GValue))
-> IO (Bool, GValue) -> m (Bool, GValue)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Animatable
animatable' <- a -> IO (Ptr Animatable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animatable
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    Ptr Interval
interval' <- b -> IO (Ptr Interval)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
interval
    let progress' :: CDouble
progress' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
progress
    Ptr GValue
value <- Int -> IO (Ptr GValue)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
24 :: IO (Ptr GValue)
    CInt
result <- Ptr Animatable
-> CString -> Ptr Interval -> CDouble -> Ptr GValue -> IO CInt
clutter_animatable_interpolate_value Ptr Animatable
animatable' CString
propertyName' Ptr Interval
interval' CDouble
progress' Ptr GValue
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    GValue
value' <- Ptr GValue -> IO GValue
B.GValue.wrapGValuePtr Ptr GValue
value
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animatable
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
interval
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    (Bool, GValue) -> IO (Bool, GValue)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', GValue
value')

#if defined(ENABLE_OVERLOADING)
data AnimatableInterpolateValueMethodInfo
instance (signature ~ (T.Text -> b -> Double -> m ((Bool, GValue))), MonadIO m, IsAnimatable a, Clutter.Interval.IsInterval b) => O.OverloadedMethod AnimatableInterpolateValueMethodInfo a signature where
    overloadedMethod = animatableInterpolateValue

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


#endif

-- method Animatable::set_final_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animatable"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animatable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimatable"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the animatable property to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value of the animatable property to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_animatable_set_final_state" clutter_animatable_set_final_state :: 
    Ptr Animatable ->                       -- animatable : TInterface (Name {namespace = "Clutter", name = "Animatable"})
    CString ->                              -- property_name : TBasicType TUTF8
    Ptr GValue ->                           -- value : TGValue
    IO ()

-- | Sets the current state of /@propertyName@/ to /@value@/
-- 
-- /Since: 1.4/
animatableSetFinalState ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimatable a) =>
    a
    -- ^ /@animatable@/: a t'GI.Clutter.Interfaces.Animatable.Animatable'
    -> T.Text
    -- ^ /@propertyName@/: the name of the animatable property to set
    -> GValue
    -- ^ /@value@/: the value of the animatable property to set
    -> m ()
animatableSetFinalState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimatable a) =>
a -> Text -> GValue -> m ()
animatableSetFinalState a
animatable Text
propertyName GValue
value = 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 Animatable
animatable' <- a -> IO (Ptr Animatable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animatable
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr Animatable -> CString -> Ptr GValue -> IO ()
clutter_animatable_set_final_state Ptr Animatable
animatable' CString
propertyName' Ptr GValue
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animatable
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnimatableSetFinalStateMethodInfo
instance (signature ~ (T.Text -> GValue -> m ()), MonadIO m, IsAnimatable a) => O.OverloadedMethod AnimatableSetFinalStateMethodInfo a signature where
    overloadedMethod = animatableSetFinalState

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


#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Animatable = AnimatableSignalList
type AnimatableSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif