{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Clutter.Objects.Alpha.Alpha' combines a t'GI.Clutter.Objects.Timeline.Timeline' and a function.
-- The contents of the t'GI.Clutter.Objects.Alpha.Alpha' structure are private and should
-- only 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.Alpha
    ( 

-- * Exported types
    Alpha(..)                               ,
    IsAlpha                                 ,
    toAlpha                                 ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [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"), [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
-- [getAlpha]("GI.Clutter.Objects.Alpha#g:method:getAlpha"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getId]("GI.Clutter.Interfaces.Scriptable#g:method:getId"), [getMode]("GI.Clutter.Objects.Alpha#g:method:getMode"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getTimeline]("GI.Clutter.Objects.Alpha#g:method:getTimeline").
-- 
-- ==== Setters
-- [setClosure]("GI.Clutter.Objects.Alpha#g:method:setClosure"), [setCustomProperty]("GI.Clutter.Interfaces.Scriptable#g:method:setCustomProperty"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setFunc]("GI.Clutter.Objects.Alpha#g:method:setFunc"), [setId]("GI.Clutter.Interfaces.Scriptable#g:method:setId"), [setMode]("GI.Clutter.Objects.Alpha#g:method:setMode"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setTimeline]("GI.Clutter.Objects.Alpha#g:method:setTimeline").

#if defined(ENABLE_OVERLOADING)
    ResolveAlphaMethod                      ,
#endif

-- ** getAlpha #method:getAlpha#

#if defined(ENABLE_OVERLOADING)
    AlphaGetAlphaMethodInfo                 ,
#endif
    alphaGetAlpha                           ,


-- ** getMode #method:getMode#

#if defined(ENABLE_OVERLOADING)
    AlphaGetModeMethodInfo                  ,
#endif
    alphaGetMode                            ,


-- ** getTimeline #method:getTimeline#

#if defined(ENABLE_OVERLOADING)
    AlphaGetTimelineMethodInfo              ,
#endif
    alphaGetTimeline                        ,


-- ** new #method:new#

    alphaNew                                ,


-- ** newFull #method:newFull#

    alphaNewFull                            ,


-- ** newWithFunc #method:newWithFunc#

    alphaNewWithFunc                        ,


-- ** registerFunc #method:registerFunc#

    alphaRegisterFunc                       ,


-- ** setClosure #method:setClosure#

#if defined(ENABLE_OVERLOADING)
    AlphaSetClosureMethodInfo               ,
#endif
    alphaSetClosure                         ,


-- ** setFunc #method:setFunc#

#if defined(ENABLE_OVERLOADING)
    AlphaSetFuncMethodInfo                  ,
#endif
    alphaSetFunc                            ,


-- ** setMode #method:setMode#

#if defined(ENABLE_OVERLOADING)
    AlphaSetModeMethodInfo                  ,
#endif
    alphaSetMode                            ,


-- ** setTimeline #method:setTimeline#

#if defined(ENABLE_OVERLOADING)
    AlphaSetTimelineMethodInfo              ,
#endif
    alphaSetTimeline                        ,




 -- * Properties


-- ** alpha #attr:alpha#
-- | The alpha value as computed by the alpha function. The linear
-- interval is 0.0 to 1.0, but the Alpha allows overshooting by
-- one unit in each direction, so the valid interval is -1.0 to 2.0.
-- 
-- /Since: 0.2/

#if defined(ENABLE_OVERLOADING)
    AlphaAlphaPropertyInfo                  ,
#endif
#if defined(ENABLE_OVERLOADING)
    alphaAlpha                              ,
#endif
    getAlphaAlpha                           ,


-- ** mode #attr:mode#
-- | The progress function logical id - either a value from the
-- t'GI.Clutter.Enums.AnimationMode' enumeration or a value returned by
-- @/clutter_alpha_register_func()/@.
-- 
-- If 'GI.Clutter.Enums.AnimationModeCustomMode' is used then the function set using
-- 'GI.Clutter.Objects.Alpha.alphaSetClosure' or 'GI.Clutter.Objects.Alpha.alphaSetFunc'
-- will be used.
-- 
-- /Since: 1.0/

#if defined(ENABLE_OVERLOADING)
    AlphaModePropertyInfo                   ,
#endif
#if defined(ENABLE_OVERLOADING)
    alphaMode                               ,
#endif
    constructAlphaMode                      ,
    getAlphaMode                            ,
    setAlphaMode                            ,


-- ** timeline #attr:timeline#
-- | A t'GI.Clutter.Objects.Timeline.Timeline' instance used to drive the alpha function.
-- 
-- /Since: 0.2/

#if defined(ENABLE_OVERLOADING)
    AlphaTimelinePropertyInfo               ,
#endif
#if defined(ENABLE_OVERLOADING)
    alphaTimeline                           ,
#endif
    constructAlphaTimeline                  ,
    getAlphaTimeline                        ,
    setAlphaTimeline                        ,




    ) where

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

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

import qualified GI.Clutter.Callbacks as Clutter.Callbacks
import {-# SOURCE #-} qualified GI.Clutter.Interfaces.Scriptable as Clutter.Scriptable
import {-# SOURCE #-} qualified GI.Clutter.Objects.Timeline as Clutter.Timeline
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "clutter_alpha_get_type"
    c_clutter_alpha_get_type :: IO B.Types.GType

instance B.Types.TypedObject Alpha where
    glibType :: IO GType
glibType = IO GType
c_clutter_alpha_get_type

instance B.Types.GObject Alpha

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveAlphaMethod (t :: Symbol) (o :: *) :: * where
    ResolveAlphaMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveAlphaMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveAlphaMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAlphaMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAlphaMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAlphaMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveAlphaMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAlphaMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAlphaMethod "parseCustomNode" o = Clutter.Scriptable.ScriptableParseCustomNodeMethodInfo
    ResolveAlphaMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveAlphaMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAlphaMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAlphaMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveAlphaMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveAlphaMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveAlphaMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveAlphaMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAlphaMethod "getAlpha" o = AlphaGetAlphaMethodInfo
    ResolveAlphaMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveAlphaMethod "getId" o = Clutter.Scriptable.ScriptableGetIdMethodInfo
    ResolveAlphaMethod "getMode" o = AlphaGetModeMethodInfo
    ResolveAlphaMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveAlphaMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveAlphaMethod "getTimeline" o = AlphaGetTimelineMethodInfo
    ResolveAlphaMethod "setClosure" o = AlphaSetClosureMethodInfo
    ResolveAlphaMethod "setCustomProperty" o = Clutter.Scriptable.ScriptableSetCustomPropertyMethodInfo
    ResolveAlphaMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAlphaMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAlphaMethod "setFunc" o = AlphaSetFuncMethodInfo
    ResolveAlphaMethod "setId" o = Clutter.Scriptable.ScriptableSetIdMethodInfo
    ResolveAlphaMethod "setMode" o = AlphaSetModeMethodInfo
    ResolveAlphaMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAlphaMethod "setTimeline" o = AlphaSetTimelineMethodInfo
    ResolveAlphaMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "alpha"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

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

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

-- VVV Prop "mode"
   -- Type: TBasicType TULong
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

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

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

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

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

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

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

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

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

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Alpha
type instance O.AttributeList Alpha = AlphaAttributeList
type AlphaAttributeList = ('[ '("alpha", AlphaAlphaPropertyInfo), '("mode", AlphaModePropertyInfo), '("timeline", AlphaTimelinePropertyInfo)] :: [(Symbol, *)])
#endif

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

alphaMode :: AttrLabelProxy "mode"
alphaMode = AttrLabelProxy

alphaTimeline :: AttrLabelProxy "timeline"
alphaTimeline = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "clutter_alpha_new" clutter_alpha_new :: 
    IO (Ptr Alpha)

{-# DEPRECATED alphaNew ["(Since version 1.12)","Use t'GI.Clutter.Objects.Timeline.Timeline' instead"] #-}
-- | Creates a new t'GI.Clutter.Objects.Alpha.Alpha' instance.  You must set a function
-- to compute the alpha value using 'GI.Clutter.Objects.Alpha.alphaSetFunc' and
-- bind a t'GI.Clutter.Objects.Timeline.Timeline' object to the t'GI.Clutter.Objects.Alpha.Alpha' instance
-- using 'GI.Clutter.Objects.Alpha.alphaSetTimeline'.
-- 
-- You should use the newly created t'GI.Clutter.Objects.Alpha.Alpha' instance inside
-- a t'GI.Clutter.Objects.Behaviour.Behaviour' object.
-- 
-- /Since: 0.2/
alphaNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Alpha
    -- ^ __Returns:__ the newly created empty t'GI.Clutter.Objects.Alpha.Alpha' instance.
alphaNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Alpha
alphaNew  = IO Alpha -> m Alpha
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Alpha -> m Alpha) -> IO Alpha -> m Alpha
forall a b. (a -> b) -> a -> b
$ do
    Ptr Alpha
result <- IO (Ptr Alpha)
clutter_alpha_new
    Text -> Ptr Alpha -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"alphaNew" Ptr Alpha
result
    Alpha
result' <- ((ManagedPtr Alpha -> Alpha) -> Ptr Alpha -> IO Alpha
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Alpha -> Alpha
Alpha) Ptr Alpha
result
    Alpha -> IO Alpha
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Alpha
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Alpha::new_full
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "timeline"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Timeline" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#ClutterTimeline timeline"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType = TBasicType TULong
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "animation mode" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Alpha" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_alpha_new_full" clutter_alpha_new_full :: 
    Ptr Clutter.Timeline.Timeline ->        -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    CULong ->                               -- mode : TBasicType TULong
    IO (Ptr Alpha)

{-# DEPRECATED alphaNewFull ["(Since version 1.12)","Use t'GI.Clutter.Objects.Timeline.Timeline' instead"] #-}
-- | Creates a new t'GI.Clutter.Objects.Alpha.Alpha' instance and sets the timeline
-- and animation mode.
-- 
-- See also 'GI.Clutter.Objects.Alpha.alphaSetTimeline' and 'GI.Clutter.Objects.Alpha.alphaSetMode'.
-- 
-- /Since: 1.0/
alphaNewFull ::
    (B.CallStack.HasCallStack, MonadIO m, Clutter.Timeline.IsTimeline a) =>
    a
    -- ^ /@timeline@/: t'GI.Clutter.Objects.Timeline.Timeline' timeline
    -> CULong
    -- ^ /@mode@/: animation mode
    -> m Alpha
    -- ^ __Returns:__ the newly created t'GI.Clutter.Objects.Alpha.Alpha'
alphaNewFull :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> CULong -> m Alpha
alphaNewFull a
timeline CULong
mode = IO Alpha -> m Alpha
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Alpha -> m Alpha) -> IO Alpha -> m Alpha
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    Ptr Alpha
result <- Ptr Timeline -> CULong -> IO (Ptr Alpha)
clutter_alpha_new_full Ptr Timeline
timeline' CULong
mode
    Text -> Ptr Alpha -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"alphaNewFull" Ptr Alpha
result
    Alpha
result' <- ((ManagedPtr Alpha -> Alpha) -> Ptr Alpha -> IO Alpha
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Alpha -> Alpha
Alpha) Ptr Alpha
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    Alpha -> IO Alpha
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Alpha
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Alpha::new_with_func
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "timeline"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Timeline" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterTimeline" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "AlphaFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAlphaFunc"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to the function, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destroy"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "function to call when removing the alpha function, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Alpha" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_alpha_new_with_func" clutter_alpha_new_with_func :: 
    Ptr Clutter.Timeline.Timeline ->        -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    FunPtr Clutter.Callbacks.C_AlphaFunc -> -- func : TInterface (Name {namespace = "Clutter", name = "AlphaFunc"})
    Ptr () ->                               -- data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- destroy : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO (Ptr Alpha)

{-# DEPRECATED alphaNewWithFunc ["(Since version 1.12)","Use t'GI.Clutter.Objects.Timeline.Timeline' instead"] #-}
-- | Creates a new t'GI.Clutter.Objects.Alpha.Alpha' instances and sets the timeline
-- and the alpha function.
-- 
-- This function will not register /@func@/ as a global alpha function.
-- 
-- See also 'GI.Clutter.Objects.Alpha.alphaSetTimeline' and 'GI.Clutter.Objects.Alpha.alphaSetFunc'.
-- 
-- /Since: 1.0/
alphaNewWithFunc ::
    (B.CallStack.HasCallStack, MonadIO m, Clutter.Timeline.IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> Clutter.Callbacks.AlphaFunc
    -- ^ /@func@/: a t'GI.Clutter.Callbacks.AlphaFunc'
    -> m Alpha
    -- ^ __Returns:__ the newly created t'GI.Clutter.Objects.Alpha.Alpha'
alphaNewWithFunc :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> AlphaFunc -> m Alpha
alphaNewWithFunc a
timeline AlphaFunc
func = IO Alpha -> m Alpha
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Alpha -> m Alpha) -> IO Alpha -> m Alpha
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    FunPtr C_AlphaFunc
func' <- C_AlphaFunc -> IO (FunPtr C_AlphaFunc)
Clutter.Callbacks.mk_AlphaFunc (Maybe (Ptr (FunPtr C_AlphaFunc))
-> AlphaFunc_WithClosures -> C_AlphaFunc
Clutter.Callbacks.wrap_AlphaFunc Maybe (Ptr (FunPtr C_AlphaFunc))
forall a. Maybe a
Nothing (AlphaFunc -> AlphaFunc_WithClosures
Clutter.Callbacks.drop_closures_AlphaFunc AlphaFunc
func))
    let data_ :: Ptr ()
data_ = FunPtr C_AlphaFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_AlphaFunc
func'
    let destroy :: FunPtr (Ptr a -> IO ())
destroy = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr Alpha
result <- Ptr Timeline
-> FunPtr C_AlphaFunc
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO (Ptr Alpha)
clutter_alpha_new_with_func Ptr Timeline
timeline' FunPtr C_AlphaFunc
func' Ptr ()
data_ FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
destroy
    Text -> Ptr Alpha -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"alphaNewWithFunc" Ptr Alpha
result
    Alpha
result' <- ((ManagedPtr Alpha -> Alpha) -> Ptr Alpha -> IO Alpha
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Alpha -> Alpha
Alpha) Ptr Alpha
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    Alpha -> IO Alpha
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Alpha
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "clutter_alpha_get_alpha" clutter_alpha_get_alpha :: 
    Ptr Alpha ->                            -- alpha : TInterface (Name {namespace = "Clutter", name = "Alpha"})
    IO CDouble

{-# DEPRECATED alphaGetAlpha ["(Since version 1.12)","Use 'GI.Clutter.Objects.Timeline.timelineGetProgress'"] #-}
-- | Query the current alpha value.
-- 
-- /Since: 0.2/
alphaGetAlpha ::
    (B.CallStack.HasCallStack, MonadIO m, IsAlpha a) =>
    a
    -- ^ /@alpha@/: A t'GI.Clutter.Objects.Alpha.Alpha'
    -> m Double
    -- ^ __Returns:__ The current alpha value for the alpha
alphaGetAlpha :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlpha a) =>
a -> m Double
alphaGetAlpha a
alpha = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr Alpha
alpha' <- a -> IO (Ptr Alpha)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
alpha
    CDouble
result <- Ptr Alpha -> IO CDouble
clutter_alpha_get_alpha Ptr Alpha
alpha'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
alpha
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data AlphaGetAlphaMethodInfo
instance (signature ~ (m Double), MonadIO m, IsAlpha a) => O.OverloadedMethod AlphaGetAlphaMethodInfo a signature where
    overloadedMethod = alphaGetAlpha

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


#endif

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

foreign import ccall "clutter_alpha_get_mode" clutter_alpha_get_mode :: 
    Ptr Alpha ->                            -- alpha : TInterface (Name {namespace = "Clutter", name = "Alpha"})
    IO CULong

{-# DEPRECATED alphaGetMode ["(Since version 1.12)","Use t'GI.Clutter.Objects.Timeline.Timeline' instead"] #-}
-- | Retrieves the t'GI.Clutter.Enums.AnimationMode' used by /@alpha@/.
-- 
-- /Since: 1.0/
alphaGetMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsAlpha a) =>
    a
    -- ^ /@alpha@/: a t'GI.Clutter.Objects.Alpha.Alpha'
    -> m CULong
    -- ^ __Returns:__ the animation mode
alphaGetMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlpha a) =>
a -> m CULong
alphaGetMode a
alpha = IO CULong -> m CULong
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CULong -> m CULong) -> IO CULong -> m CULong
forall a b. (a -> b) -> a -> b
$ do
    Ptr Alpha
alpha' <- a -> IO (Ptr Alpha)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
alpha
    CULong
result <- Ptr Alpha -> IO CULong
clutter_alpha_get_mode Ptr Alpha
alpha'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
alpha
    CULong -> IO CULong
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CULong
result

#if defined(ENABLE_OVERLOADING)
data AlphaGetModeMethodInfo
instance (signature ~ (m CULong), MonadIO m, IsAlpha a) => O.OverloadedMethod AlphaGetModeMethodInfo a signature where
    overloadedMethod = alphaGetMode

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


#endif

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

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

{-# DEPRECATED alphaGetTimeline ["(Since version 1.12)","Use t'GI.Clutter.Objects.Timeline.Timeline' directlry"] #-}
-- | Gets the t'GI.Clutter.Objects.Timeline.Timeline' bound to /@alpha@/.
-- 
-- /Since: 0.2/
alphaGetTimeline ::
    (B.CallStack.HasCallStack, MonadIO m, IsAlpha a) =>
    a
    -- ^ /@alpha@/: A t'GI.Clutter.Objects.Alpha.Alpha'
    -> m Clutter.Timeline.Timeline
    -- ^ __Returns:__ a t'GI.Clutter.Objects.Timeline.Timeline' instance
alphaGetTimeline :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlpha a) =>
a -> m Timeline
alphaGetTimeline a
alpha = IO Timeline -> m Timeline
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Timeline -> m Timeline) -> IO Timeline -> m Timeline
forall a b. (a -> b) -> a -> b
$ do
    Ptr Alpha
alpha' <- a -> IO (Ptr Alpha)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
alpha
    Ptr Timeline
result <- Ptr Alpha -> IO (Ptr Timeline)
clutter_alpha_get_timeline Ptr Alpha
alpha'
    Text -> Ptr Timeline -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"alphaGetTimeline" Ptr Timeline
result
    Timeline
result' <- ((ManagedPtr Timeline -> Timeline) -> Ptr Timeline -> IO Timeline
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Timeline -> Timeline
Clutter.Timeline.Timeline) Ptr Timeline
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
alpha
    Timeline -> IO Timeline
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Timeline
result'

#if defined(ENABLE_OVERLOADING)
data AlphaGetTimelineMethodInfo
instance (signature ~ (m Clutter.Timeline.Timeline), MonadIO m, IsAlpha a) => O.OverloadedMethod AlphaGetTimelineMethodInfo a signature where
    overloadedMethod = alphaGetTimeline

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


#endif

-- method Alpha::set_closure
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "alpha"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Alpha" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #ClutterAlpha" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "closure"
--           , argType = TGClosure Nothing
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GClosure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_alpha_set_closure" clutter_alpha_set_closure :: 
    Ptr Alpha ->                            -- alpha : TInterface (Name {namespace = "Clutter", name = "Alpha"})
    Ptr (GClosure ()) ->                    -- closure : TGClosure Nothing
    IO ()

{-# DEPRECATED alphaSetClosure ["(Since version 1.12)","Use 'GI.Clutter.Objects.Timeline.timelineSetProgressFunc'"] #-}
-- | Sets the t'GI.GObject.Structs.Closure.Closure' used to compute the alpha value at each
-- frame of the t'GI.Clutter.Objects.Timeline.Timeline' bound to /@alpha@/.
-- 
-- /Since: 0.8/
alphaSetClosure ::
    (B.CallStack.HasCallStack, MonadIO m, IsAlpha a) =>
    a
    -- ^ /@alpha@/: A t'GI.Clutter.Objects.Alpha.Alpha'
    -> GClosure b
    -- ^ /@closure@/: A t'GI.GObject.Structs.Closure.Closure'
    -> m ()
alphaSetClosure :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAlpha a) =>
a -> GClosure b -> m ()
alphaSetClosure a
alpha GClosure b
closure = 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 Alpha
alpha' <- a -> IO (Ptr Alpha)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
alpha
    Ptr (GClosure ())
closure' <- GClosure b -> IO (Ptr (GClosure ()))
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr GClosure b
closure
    Ptr Alpha -> Ptr (GClosure ()) -> IO ()
clutter_alpha_set_closure Ptr Alpha
alpha' Ptr (GClosure ())
closure'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
alpha
    GClosure b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GClosure b
closure
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AlphaSetClosureMethodInfo
instance (signature ~ (GClosure b -> m ()), MonadIO m, IsAlpha a) => O.OverloadedMethod AlphaSetClosureMethodInfo a signature where
    overloadedMethod = alphaSetClosure

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


#endif

-- method Alpha::set_func
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "alpha"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Alpha" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #ClutterAlpha" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "AlphaFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #ClutterAlphaFunc"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "user data to be passed to the alpha function, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destroy"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "notify function used when disposing the alpha function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_alpha_set_func" clutter_alpha_set_func :: 
    Ptr Alpha ->                            -- alpha : TInterface (Name {namespace = "Clutter", name = "Alpha"})
    FunPtr Clutter.Callbacks.C_AlphaFunc -> -- func : TInterface (Name {namespace = "Clutter", name = "AlphaFunc"})
    Ptr () ->                               -- data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- destroy : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

{-# DEPRECATED alphaSetFunc ["(Since version 1.12)","Use 'GI.Clutter.Objects.Timeline.timelineSetProgressFunc'"] #-}
-- | Sets the t'GI.Clutter.Callbacks.AlphaFunc' function used to compute
-- the alpha value at each frame of the t'GI.Clutter.Objects.Timeline.Timeline'
-- bound to /@alpha@/.
-- 
-- This function will not register /@func@/ as a global alpha function.
-- 
-- /Since: 0.2/
alphaSetFunc ::
    (B.CallStack.HasCallStack, MonadIO m, IsAlpha a) =>
    a
    -- ^ /@alpha@/: A t'GI.Clutter.Objects.Alpha.Alpha'
    -> Clutter.Callbacks.AlphaFunc
    -- ^ /@func@/: A t'GI.Clutter.Callbacks.AlphaFunc'
    -> m ()
alphaSetFunc :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlpha a) =>
a -> AlphaFunc -> m ()
alphaSetFunc a
alpha AlphaFunc
func = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Alpha
alpha' <- a -> IO (Ptr Alpha)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
alpha
    FunPtr C_AlphaFunc
func' <- C_AlphaFunc -> IO (FunPtr C_AlphaFunc)
Clutter.Callbacks.mk_AlphaFunc (Maybe (Ptr (FunPtr C_AlphaFunc))
-> AlphaFunc_WithClosures -> C_AlphaFunc
Clutter.Callbacks.wrap_AlphaFunc Maybe (Ptr (FunPtr C_AlphaFunc))
forall a. Maybe a
Nothing (AlphaFunc -> AlphaFunc_WithClosures
Clutter.Callbacks.drop_closures_AlphaFunc AlphaFunc
func))
    let data_ :: Ptr ()
data_ = FunPtr C_AlphaFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_AlphaFunc
func'
    let destroy :: FunPtr (Ptr a -> IO ())
destroy = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr Alpha
-> FunPtr C_AlphaFunc -> Ptr () -> FunPtr C_DestroyNotify -> IO ()
clutter_alpha_set_func Ptr Alpha
alpha' FunPtr C_AlphaFunc
func' Ptr ()
data_ FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
destroy
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
alpha
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AlphaSetFuncMethodInfo
instance (signature ~ (Clutter.Callbacks.AlphaFunc -> m ()), MonadIO m, IsAlpha a) => O.OverloadedMethod AlphaSetFuncMethodInfo a signature where
    overloadedMethod = alphaSetFunc

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


#endif

-- method Alpha::set_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "alpha"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Alpha" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAlpha" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType = TBasicType TULong
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimationMode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_alpha_set_mode" clutter_alpha_set_mode :: 
    Ptr Alpha ->                            -- alpha : TInterface (Name {namespace = "Clutter", name = "Alpha"})
    CULong ->                               -- mode : TBasicType TULong
    IO ()

{-# DEPRECATED alphaSetMode ["(Since version 1.12)","Use t'GI.Clutter.Objects.Timeline.Timeline' and","  'GI.Clutter.Objects.Timeline.timelineSetProgressMode' instead"] #-}
-- | Sets the progress function of /@alpha@/ using the symbolic value
-- of /@mode@/, as taken by the t'GI.Clutter.Enums.AnimationMode' enumeration or
-- using the value returned by @/clutter_alpha_register_func()/@.
-- 
-- /Since: 1.0/
alphaSetMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsAlpha a) =>
    a
    -- ^ /@alpha@/: a t'GI.Clutter.Objects.Alpha.Alpha'
    -> CULong
    -- ^ /@mode@/: a t'GI.Clutter.Enums.AnimationMode'
    -> m ()
alphaSetMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlpha a) =>
a -> CULong -> m ()
alphaSetMode a
alpha CULong
mode = 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 Alpha
alpha' <- a -> IO (Ptr Alpha)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
alpha
    Ptr Alpha -> CULong -> IO ()
clutter_alpha_set_mode Ptr Alpha
alpha' CULong
mode
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
alpha
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AlphaSetModeMethodInfo
instance (signature ~ (CULong -> m ()), MonadIO m, IsAlpha a) => O.OverloadedMethod AlphaSetModeMethodInfo a signature where
    overloadedMethod = alphaSetMode

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


#endif

-- method Alpha::set_timeline
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "alpha"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Alpha" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #ClutterAlpha" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeline"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Timeline" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #ClutterTimeline" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_alpha_set_timeline" clutter_alpha_set_timeline :: 
    Ptr Alpha ->                            -- alpha : TInterface (Name {namespace = "Clutter", name = "Alpha"})
    Ptr Clutter.Timeline.Timeline ->        -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    IO ()

{-# DEPRECATED alphaSetTimeline ["(Since version 1.12)","Use t'GI.Clutter.Objects.Timeline.Timeline' directly"] #-}
-- | Binds /@alpha@/ to /@timeline@/.
-- 
-- /Since: 0.2/
alphaSetTimeline ::
    (B.CallStack.HasCallStack, MonadIO m, IsAlpha a, Clutter.Timeline.IsTimeline b) =>
    a
    -- ^ /@alpha@/: A t'GI.Clutter.Objects.Alpha.Alpha'
    -> b
    -- ^ /@timeline@/: A t'GI.Clutter.Objects.Timeline.Timeline'
    -> m ()
alphaSetTimeline :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAlpha a, IsTimeline b) =>
a -> b -> m ()
alphaSetTimeline a
alpha b
timeline = 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 Alpha
alpha' <- a -> IO (Ptr Alpha)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
alpha
    Ptr Timeline
timeline' <- b -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
timeline
    Ptr Alpha -> Ptr Timeline -> IO ()
clutter_alpha_set_timeline Ptr Alpha
alpha' Ptr Timeline
timeline'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
alpha
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
timeline
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AlphaSetTimelineMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsAlpha a, Clutter.Timeline.IsTimeline b) => O.OverloadedMethod AlphaSetTimelineMethodInfo a signature where
    overloadedMethod = alphaSetTimeline

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


#endif

-- method Alpha::register_func
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "closure"
--           , argType = TGClosure Nothing
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GClosure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TULong)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_alpha_register_closure" clutter_alpha_register_closure :: 
    Ptr (GClosure ()) ->                    -- closure : TGClosure Nothing
    IO CULong

{-# DEPRECATED alphaRegisterFunc ["(Since version 1.12)","There is no direct replacement for this","  function. Use 'GI.Clutter.Objects.Timeline.timelineSetProgressFunc' on each","  specific t'GI.Clutter.Objects.Timeline.Timeline' instance"] #-}
-- | t'GI.GObject.Structs.Closure.Closure' variant of @/clutter_alpha_register_func()/@.
-- 
-- Registers a global alpha function and returns its logical id
-- to be used by 'GI.Clutter.Objects.Alpha.alphaSetMode' or by t'GI.Clutter.Objects.Animation.Animation'.
-- 
-- The logical id is always greater than 'GI.Clutter.Enums.AnimationModeAnimationLast'.
-- 
-- /Since: 1.0/
alphaRegisterFunc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GClosure a
    -- ^ /@closure@/: a t'GI.GObject.Structs.Closure.Closure'
    -> m CULong
    -- ^ __Returns:__ the logical id of the alpha function
alphaRegisterFunc :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m) =>
GClosure a -> m CULong
alphaRegisterFunc GClosure a
closure = IO CULong -> m CULong
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CULong -> m CULong) -> IO CULong -> m CULong
forall a b. (a -> b) -> a -> b
$ do
    Ptr (GClosure ())
closure' <- GClosure a -> IO (Ptr (GClosure ()))
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr GClosure a
closure
    CULong
result <- Ptr (GClosure ()) -> IO CULong
clutter_alpha_register_closure Ptr (GClosure ())
closure'
    GClosure a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GClosure a
closure
    CULong -> IO CULong
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CULong
result

#if defined(ENABLE_OVERLOADING)
#endif