{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A key frame inside a t'GI.Clutter.Objects.Animator.Animator'
-- 
-- /Since: 1.2/

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

module GI.Clutter.Structs.AnimatorKey
    ( 

-- * Exported types
    AnimatorKey(..)                         ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- /None/.
-- 
-- ==== Getters
-- [getMode]("GI.Clutter.Structs.AnimatorKey#g:method:getMode"), [getObject]("GI.Clutter.Structs.AnimatorKey#g:method:getObject"), [getProgress]("GI.Clutter.Structs.AnimatorKey#g:method:getProgress"), [getPropertyName]("GI.Clutter.Structs.AnimatorKey#g:method:getPropertyName"), [getPropertyType]("GI.Clutter.Structs.AnimatorKey#g:method:getPropertyType"), [getValue]("GI.Clutter.Structs.AnimatorKey#g:method:getValue").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveAnimatorKeyMethod                ,
#endif

-- ** getMode #method:getMode#

#if defined(ENABLE_OVERLOADING)
    AnimatorKeyGetModeMethodInfo            ,
#endif
    animatorKeyGetMode                      ,


-- ** getObject #method:getObject#

#if defined(ENABLE_OVERLOADING)
    AnimatorKeyGetObjectMethodInfo          ,
#endif
    animatorKeyGetObject                    ,


-- ** getProgress #method:getProgress#

#if defined(ENABLE_OVERLOADING)
    AnimatorKeyGetProgressMethodInfo        ,
#endif
    animatorKeyGetProgress                  ,


-- ** getPropertyName #method:getPropertyName#

#if defined(ENABLE_OVERLOADING)
    AnimatorKeyGetPropertyNameMethodInfo    ,
#endif
    animatorKeyGetPropertyName              ,


-- ** getPropertyType #method:getPropertyType#

#if defined(ENABLE_OVERLOADING)
    AnimatorKeyGetPropertyTypeMethodInfo    ,
#endif
    animatorKeyGetPropertyType              ,


-- ** getValue #method:getValue#

#if defined(ENABLE_OVERLOADING)
    AnimatorKeyGetValueMethodInfo           ,
#endif
    animatorKeyGetValue                     ,




    ) 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.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "clutter_animator_key_get_type" c_clutter_animator_key_get_type :: 
    IO GType

type instance O.ParentTypes AnimatorKey = '[]
instance O.HasParentTypes AnimatorKey

instance B.Types.TypedObject AnimatorKey where
    glibType :: IO GType
glibType = IO GType
c_clutter_animator_key_get_type

instance B.Types.GBoxed AnimatorKey

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


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList AnimatorKey
type instance O.AttributeList AnimatorKey = AnimatorKeyAttributeList
type AnimatorKeyAttributeList = ('[ ] :: [(Symbol, *)])
#endif

-- method AnimatorKey::get_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "key"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "AnimatorKey" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimatorKey"
--                 , 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_animator_key_get_mode" clutter_animator_key_get_mode :: 
    Ptr AnimatorKey ->                      -- key : TInterface (Name {namespace = "Clutter", name = "AnimatorKey"})
    IO CULong

{-# DEPRECATED animatorKeyGetMode ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' instead"] #-}
-- | Retrieves the mode of a t'GI.Clutter.Objects.Animator.Animator' key, for the first key of a
-- property for an object this represents the whether the animation is
-- open ended and or curved for the remainding keys for the property it
-- represents the easing mode.
-- 
-- /Since: 1.2/
animatorKeyGetMode ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AnimatorKey
    -- ^ /@key@/: a t'GI.Clutter.Structs.AnimatorKey.AnimatorKey'
    -> m CULong
    -- ^ __Returns:__ the mode of a t'GI.Clutter.Structs.AnimatorKey.AnimatorKey'
animatorKeyGetMode :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
AnimatorKey -> m CULong
animatorKeyGetMode AnimatorKey
key = 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 AnimatorKey
key' <- AnimatorKey -> IO (Ptr AnimatorKey)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AnimatorKey
key
    CULong
result <- Ptr AnimatorKey -> IO CULong
clutter_animator_key_get_mode Ptr AnimatorKey
key'
    AnimatorKey -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AnimatorKey
key
    CULong -> IO CULong
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CULong
result

#if defined(ENABLE_OVERLOADING)
data AnimatorKeyGetModeMethodInfo
instance (signature ~ (m CULong), MonadIO m) => O.OverloadedMethod AnimatorKeyGetModeMethodInfo AnimatorKey signature where
    overloadedMethod = animatorKeyGetMode

instance O.OverloadedMethodInfo AnimatorKeyGetModeMethodInfo AnimatorKey where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.AnimatorKey.animatorKeyGetMode",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Structs-AnimatorKey.html#v:animatorKeyGetMode"
        })


#endif

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

foreign import ccall "clutter_animator_key_get_object" clutter_animator_key_get_object :: 
    Ptr AnimatorKey ->                      -- key : TInterface (Name {namespace = "Clutter", name = "AnimatorKey"})
    IO (Ptr GObject.Object.Object)

{-# DEPRECATED animatorKeyGetObject ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' instead"] #-}
-- | Retrieves the object a key applies to.
-- 
-- /Since: 1.2/
animatorKeyGetObject ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AnimatorKey
    -- ^ /@key@/: a t'GI.Clutter.Structs.AnimatorKey.AnimatorKey'
    -> m GObject.Object.Object
    -- ^ __Returns:__ the object an animator_key exist for.
animatorKeyGetObject :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
AnimatorKey -> m Object
animatorKeyGetObject AnimatorKey
key = IO Object -> m Object
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Object -> m Object) -> IO Object -> m Object
forall a b. (a -> b) -> a -> b
$ do
    Ptr AnimatorKey
key' <- AnimatorKey -> IO (Ptr AnimatorKey)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AnimatorKey
key
    Ptr Object
result <- Ptr AnimatorKey -> IO (Ptr Object)
clutter_animator_key_get_object Ptr AnimatorKey
key'
    Text -> Ptr Object -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"animatorKeyGetObject" Ptr Object
result
    Object
result' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Object -> Object
GObject.Object.Object) Ptr Object
result
    AnimatorKey -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AnimatorKey
key
    Object -> IO Object
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Object
result'

#if defined(ENABLE_OVERLOADING)
data AnimatorKeyGetObjectMethodInfo
instance (signature ~ (m GObject.Object.Object), MonadIO m) => O.OverloadedMethod AnimatorKeyGetObjectMethodInfo AnimatorKey signature where
    overloadedMethod = animatorKeyGetObject

instance O.OverloadedMethodInfo AnimatorKeyGetObjectMethodInfo AnimatorKey where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.AnimatorKey.animatorKeyGetObject",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Structs-AnimatorKey.html#v:animatorKeyGetObject"
        })


#endif

-- method AnimatorKey::get_progress
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "key"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "AnimatorKey" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimatorKey"
--                 , 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_animator_key_get_progress" clutter_animator_key_get_progress :: 
    Ptr AnimatorKey ->                      -- key : TInterface (Name {namespace = "Clutter", name = "AnimatorKey"})
    IO CDouble

{-# DEPRECATED animatorKeyGetProgress ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' instead"] #-}
-- | Retrieves the progress of an clutter_animator_key
-- 
-- /Since: 1.2/
animatorKeyGetProgress ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AnimatorKey
    -- ^ /@key@/: a t'GI.Clutter.Structs.AnimatorKey.AnimatorKey'
    -> m Double
    -- ^ __Returns:__ the progress defined for a t'GI.Clutter.Objects.Animator.Animator' key.
animatorKeyGetProgress :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
AnimatorKey -> m Double
animatorKeyGetProgress AnimatorKey
key = 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 AnimatorKey
key' <- AnimatorKey -> IO (Ptr AnimatorKey)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AnimatorKey
key
    CDouble
result <- Ptr AnimatorKey -> IO CDouble
clutter_animator_key_get_progress Ptr AnimatorKey
key'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    AnimatorKey -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AnimatorKey
key
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data AnimatorKeyGetProgressMethodInfo
instance (signature ~ (m Double), MonadIO m) => O.OverloadedMethod AnimatorKeyGetProgressMethodInfo AnimatorKey signature where
    overloadedMethod = animatorKeyGetProgress

instance O.OverloadedMethodInfo AnimatorKeyGetProgressMethodInfo AnimatorKey where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.AnimatorKey.animatorKeyGetProgress",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Structs-AnimatorKey.html#v:animatorKeyGetProgress"
        })


#endif

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

foreign import ccall "clutter_animator_key_get_property_name" clutter_animator_key_get_property_name :: 
    Ptr AnimatorKey ->                      -- key : TInterface (Name {namespace = "Clutter", name = "AnimatorKey"})
    IO CString

{-# DEPRECATED animatorKeyGetPropertyName ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' instead"] #-}
-- | Retrieves the name of the property a key applies to.
-- 
-- /Since: 1.2/
animatorKeyGetPropertyName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AnimatorKey
    -- ^ /@key@/: a t'GI.Clutter.Structs.AnimatorKey.AnimatorKey'
    -> m T.Text
    -- ^ __Returns:__ the name of the property an animator_key exist for.
animatorKeyGetPropertyName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
AnimatorKey -> m Text
animatorKeyGetPropertyName AnimatorKey
key = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr AnimatorKey
key' <- AnimatorKey -> IO (Ptr AnimatorKey)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AnimatorKey
key
    CString
result <- Ptr AnimatorKey -> IO CString
clutter_animator_key_get_property_name Ptr AnimatorKey
key'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"animatorKeyGetPropertyName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    AnimatorKey -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AnimatorKey
key
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data AnimatorKeyGetPropertyNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod AnimatorKeyGetPropertyNameMethodInfo AnimatorKey signature where
    overloadedMethod = animatorKeyGetPropertyName

instance O.OverloadedMethodInfo AnimatorKeyGetPropertyNameMethodInfo AnimatorKey where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.AnimatorKey.animatorKeyGetPropertyName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Structs-AnimatorKey.html#v:animatorKeyGetPropertyName"
        })


#endif

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

foreign import ccall "clutter_animator_key_get_property_type" clutter_animator_key_get_property_type :: 
    Ptr AnimatorKey ->                      -- key : TInterface (Name {namespace = "Clutter", name = "AnimatorKey"})
    IO CGType

{-# DEPRECATED animatorKeyGetPropertyType ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' instead"] #-}
-- | Retrieves the t'GType' of the property a key applies to
-- 
-- You can use this type to initialize the t'GI.GObject.Structs.Value.Value' to pass to
-- 'GI.Clutter.Structs.AnimatorKey.animatorKeyGetValue'
-- 
-- /Since: 1.2/
animatorKeyGetPropertyType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AnimatorKey
    -- ^ /@key@/: a t'GI.Clutter.Structs.AnimatorKey.AnimatorKey'
    -> m GType
    -- ^ __Returns:__ the t'GType' of the property
animatorKeyGetPropertyType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
AnimatorKey -> m GType
animatorKeyGetPropertyType AnimatorKey
key = IO GType -> m GType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GType -> m GType) -> IO GType -> m GType
forall a b. (a -> b) -> a -> b
$ do
    Ptr AnimatorKey
key' <- AnimatorKey -> IO (Ptr AnimatorKey)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AnimatorKey
key
    CGType
result <- Ptr AnimatorKey -> IO CGType
clutter_animator_key_get_property_type Ptr AnimatorKey
key'
    let result' :: GType
result' = CGType -> GType
GType CGType
result
    AnimatorKey -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AnimatorKey
key
    GType -> IO GType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GType
result'

#if defined(ENABLE_OVERLOADING)
data AnimatorKeyGetPropertyTypeMethodInfo
instance (signature ~ (m GType), MonadIO m) => O.OverloadedMethod AnimatorKeyGetPropertyTypeMethodInfo AnimatorKey signature where
    overloadedMethod = animatorKeyGetPropertyType

instance O.OverloadedMethodInfo AnimatorKeyGetPropertyTypeMethodInfo AnimatorKey where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.AnimatorKey.animatorKeyGetPropertyType",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Structs-AnimatorKey.html#v:animatorKeyGetPropertyType"
        })


#endif

-- method AnimatorKey::get_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "key"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "AnimatorKey" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimatorKey"
--                 , 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 with the correct type for the animator key"
--                 , 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_animator_key_get_value" clutter_animator_key_get_value :: 
    Ptr AnimatorKey ->                      -- key : TInterface (Name {namespace = "Clutter", name = "AnimatorKey"})
    Ptr GValue ->                           -- value : TGValue
    IO CInt

{-# DEPRECATED animatorKeyGetValue ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' instead"] #-}
-- | Retrieves a copy of the value for a t'GI.Clutter.Structs.AnimatorKey.AnimatorKey'.
-- 
-- The passed in t'GI.GObject.Structs.Value.Value' needs to be already initialized for the value
-- type of the key or to a type that allow transformation from the value
-- type of the key.
-- 
-- Use 'GI.GObject.Structs.Value.valueUnset' when done.
-- 
-- /Since: 1.2/
animatorKeyGetValue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AnimatorKey
    -- ^ /@key@/: a t'GI.Clutter.Structs.AnimatorKey.AnimatorKey'
    -> GValue
    -- ^ /@value@/: a t'GI.GObject.Structs.Value.Value' initialized with the correct type for the animator key
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the passed t'GI.GObject.Structs.Value.Value' was successfully set, and
    --   'P.False' otherwise
animatorKeyGetValue :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
AnimatorKey -> GValue -> m Bool
animatorKeyGetValue AnimatorKey
key 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 AnimatorKey
key' <- AnimatorKey -> IO (Ptr AnimatorKey)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AnimatorKey
key
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    CInt
result <- Ptr AnimatorKey -> Ptr GValue -> IO CInt
clutter_animator_key_get_value Ptr AnimatorKey
key' Ptr GValue
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    AnimatorKey -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AnimatorKey
key
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AnimatorKeyGetValueMethodInfo
instance (signature ~ (GValue -> m Bool), MonadIO m) => O.OverloadedMethod AnimatorKeyGetValueMethodInfo AnimatorKey signature where
    overloadedMethod = animatorKeyGetValue

instance O.OverloadedMethodInfo AnimatorKeyGetValueMethodInfo AnimatorKey where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.AnimatorKey.animatorKeyGetValue",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Structs-AnimatorKey.html#v:animatorKeyGetValue"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveAnimatorKeyMethod (t :: Symbol) (o :: *) :: * where
    ResolveAnimatorKeyMethod "getMode" o = AnimatorKeyGetModeMethodInfo
    ResolveAnimatorKeyMethod "getObject" o = AnimatorKeyGetObjectMethodInfo
    ResolveAnimatorKeyMethod "getProgress" o = AnimatorKeyGetProgressMethodInfo
    ResolveAnimatorKeyMethod "getPropertyName" o = AnimatorKeyGetPropertyNameMethodInfo
    ResolveAnimatorKeyMethod "getPropertyType" o = AnimatorKeyGetPropertyTypeMethodInfo
    ResolveAnimatorKeyMethod "getValue" o = AnimatorKeyGetValueMethodInfo
    ResolveAnimatorKeyMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif